Animated Canvas

M. Douglas Williams <m.douglas.williams@gmail.com>

This library provides an animated-canvas% class that specializes the GRacket canvas% class to provide a simple double-buffered animation capability. Two simple demonstration programs are also provided.

Everything in this library is exported by a single module:

(require (planet williams/animated-canvas/animated-canvas))

1 Theory of Operation

This section assumes you are familiar with the canvas% class.

An animated canvas uses two bitmaps to provide a double-buffered animation capability. This is implemented by a new class animated-canvas% that specializes the canvas% class. At any specific time, one bitmap, the background bitmap, is being used for all drawing operations and the other bitmap, the foreground bitmap, is being used to paint the canvas.

The swap-bitmaps method is used to swap the background and foreground bitmaps. When the bitmaps are swapped, the contents of the new foreground bitmap – the old background bitmap – is displayed on the canvas. The new background bitmap – the old foreground bitmap – is automatically cleared unless specifically prevented by the 'no-autoclear style option.

The device context returned by the animated canvases’s get-dc method is the device context of the background bitmap. This value is not valid across calls to swap-bitmaps. Therefore, it is important to re-retrieve, via get-dc, the device context across bitmap swaps.

The animated canvas also supports resizing on the canvas, which automatically resizes the background buffer after the bitmaps are swapped.

2 Interface

3 Example Animation – Lines

This section contains an example animated graphics program that uses the animated-canvas% class to draw moving lines – similar to the Mystify screen saver in Windows XP or the Qix video game.

#lang racket/gui

;  Lines animated canvas example.

;  Draws moving line similar to those in the Qix video game.

(require (planet williams/animated-canvas/animated-canvas))

(define-struct qix-segment

(x1 y1 x2 y2))

(define-struct qix

(x1 y1 x-dot1 y-dot1 x2 y2 x-dot2 y-dot2 color segments)

#:mutable)

(define (random-color)

(make-object color% (random 256) (random 256) (random 256)))

(define max-segments 12)

(define (draw-qix the-qix)

(define (draw-segment dc x1 y1 x2 y2 color)

(send dc set-pen color 0 'solid)

(send dc draw-line x1 y1 x2 y2))

(let ((dc (send canvas get-dc)))

(for-each

(lambda (qix)

(for-each

(lambda (segment)

(draw-segment dc

(qix-segment-x1 segment) (qix-segment-y1 segment)

(qix-segment-x2 segment) (qix-segment-y2 segment)

(qix-color qix)))

(qix-segments qix)))

the-qix)

(send canvas swap-bitmaps)))

(define (move-qix the-qix)

(define (update-position-x x x-dot)

(set! x (+ x x-dot))

(cond ((< x 0)

(set! x (- x))

(set! x-dot (- x-dot)))

((> x (send canvas get-width))

(set! x (- (* 2 (send canvas get-width)) x))

(set! x-dot (- x-dot))))

(values x x-dot))

(define (update-position-y y y-dot)

(set! y (+ y y-dot))

(cond ((< y 0)

(set! y (- y))

(set! y-dot (- y-dot)))

((> y (send canvas get-height))

(set! y (- (* 2 (send canvas get-height)) y))

(set! y-dot (- y-dot))))

(values y y-dot))

(for-each

(lambda (qix)

;  Update the qix position

(let-values (((x x-dot)(update-position-x (qix-x1 qix) (qix-x-dot1 qix))))

(set-qix-x1! qix x)

(set-qix-x-dot1! qix x-dot))

(let-values (((y y-dot)(update-position-y (qix-y1 qix) (qix-y-dot1 qix))))

(set-qix-y1! qix y)

(set-qix-y-dot1! qix y-dot))

(let-values (((x x-dot)(update-position-x (qix-x2 qix) (qix-x-dot2 qix))))

(set-qix-x2! qix x)

(set-qix-x-dot2! qix x-dot))

(let-values (((y y-dot)(update-position-y (qix-y2 qix) (qix-y-dot2 qix))))

(set-qix-y2! qix y)

(set-qix-y-dot2! qix y-dot))

;  Add a new segment to the segment list

(set-qix-segments! qix (append (qix-segments qix)

(list (make-qix-segment

(qix-x1 qix) (qix-y1 qix)

(qix-x2 qix) (qix-y2 qix)))))

;  Remove old segments

(when (> (length (qix-segments qix)) max-segments)

(set-qix-segments! qix (cdr (qix-segments qix)))))

the-qix))

(define break? #f)

(define (main n-qix)

(begin-busy-cursor)

(send run-button enable #f)

(set! break? #f)

(let ((the-qix

(let-values (((w h) (send canvas get-client-size)))

(build-list

n-qix

(lambda (i)

(make-qix (random w) (random h) (- (random 20) 10) (- (random 20) 10)

(random w) (random h) (- (random 20) 10) (- (random 20) 10)

(random-color) '()))))))

(let loop ()

(let ((t (current-milliseconds)))

(draw-qix the-qix)

(move-qix the-qix)

(sleep/yield (max 0.0 (/ (- 10.0 (- (current-milliseconds) t)) 1000.0)))

(unless break? (loop)))))

(send run-button enable #t)

(end-busy-cursor))

;  GUI elements

(define frame

(instantiate frame% ("Animated Canvas Demo")))

(define panel

(instantiate horizontal-panel% (frame)

(alignment '(right center))

(stretchable-height #f)))

(define run-button

(instantiate button%

("Run" panel)

(horiz-margin 4)

(callback (lambda (b e)

(main (send slider get-value))))))

(define stop

(instantiate button%

("Stop" panel)

(horiz-margin 4)

(callback (lambda (b e)

(set! break? #t)))))

(define slider

(instantiate slider%

("Number of qix" 1 100 frame)

(init-value 10)

(style '(horizontal))))

(define canvas (instantiate animated-canvas% (frame)

(style '(border))

(min-width 800) (min-height 600)))

(send frame show #t)

The following is a screen shot of the lines example.

4 Example Animation – Histograms

This section contains an example animated graphics program that uses the animated-canvas% class to draw animated histograms.

#lang racket/gui

(require (planet williams/animated-canvas/animated-canvas)

(planet williams/science/histogram))

(provide (all-defined-out))

(define histogram-widget%

(class vertical-panel%

;  Init parameters

(init-field label)

(init-field n)

(init-field min-range)

(init-field max-range)

(init parent)

(init (font normal-control-font))

;  Instantiate superclass

(super-instantiate (parent))

;  Create graphical subelements

(define message

(instantiate message%

(label this)))

(define canvas

(instantiate animated-canvas%

(this)

(style '(border))))

;  Recompute sizes and positions

(send this reflow-container)

;  Create histogram vector

(define histogram

(make-histogram-with-ranges-uniform n min-range max-range))

;  Draw histogram

(define (draw-histogram (scale 1))

(let* ((dc (send canvas get-dc))

(width (exact->inexact (send canvas get-width)))

(height (exact->inexact (send canvas get-height)))

(bin-width (/ width n))

(bin-delta (/ (exact->inexact (- max-range min-range)) n))

(half-bin-delta (/ bin-delta 2))

(max-value (histogram-max histogram))

(sum-value (histogram-sum histogram))

(mean (histogram-mean histogram))

(sigma (histogram-sigma histogram))

(cum-value 0))

(when (> sum-value 0.0)

(send dc set-pen "White" 1 'solid)

(for ((i (in-range n)))

(let ((bin-center (+ min-range (* i bin-delta) half-bin-delta))

(bin-value (histogram-get histogram i)))

(set! cum-value (+ cum-value bin-value))

(unless (= bin-value 0)

(let ((x1 (* i bin-width))

(bin-height (* scale (/  bin-value max-value) height))

(color

(cond ((<= bin-center (- mean (* 2.0 sigma))) "Red")

((<= bin-center (- mean sigma)) "Yellow")

((< bin-center (+ mean sigma)) "Green")

((< bin-center (+ mean (* 2.0 sigma))) "Yellow")

(else "Red"))))

(send dc set-brush color 'solid)

(send dc draw-rectangle

x1 (- height bin-height)

bin-width height)))))

(send dc set-pen "Blue" 1 'solid)

(let ((x (* (/ (- mean min-range) (- max-range min-range)) width)))

(send dc draw-line x 0.0 x height)))

(send canvas swap-bitmaps)))

;  Reset method

(define/public (reset)

(set! histogram

(make-histogram-with-ranges-uniform n min-range max-range))

(draw-histogram))

;  Set value method

(define/public (set-value value)

(histogram-increment! histogram value)

(draw-histogram))))

The main program, histogram-test.rkt, displays two animated histograms, one showing a unit Gaussian distribution and the other a triangular distribution.

#lang racket/gui

(require (planet williams/science/random-distributions)

"histogram-widget.rkt")

(define (main n)

(random-source-randomize! (current-random-source))

(for ((i (in-range n)))

(let ((gaussian (random-unit-gaussian))

(tri (random-triangular 0.0 10.0 4.0)))

(send histogram-1 set-value gaussian)

(send histogram-2 set-value tri)

(yield))))

(define frame

(instantiate frame% ("Test Histogram Widget")))

(define histogram-1

(instantiate histogram-widget%

("Unit Gaussian" 40 -4.0 4.0 frame)

(min-width 400)

(min-height 200)))

(define histogram-2

(instantiate histogram-widget%

("Triangular" 40 0.0 10.0 frame)

(min-width 400)

(min-height 200)))

(send frame show #t)

(main 10000)

The following is a screen shot of the histograms example.

5 Issues and To Do

TBD