canvas.rkt

#lang racket/gui

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

(define W 1200)
(define H 1200)

(define all-colors (send the-color-database get-names))

(define no-pen (new pen% [style 'transparent]))
(define brush (new brush%))

(define-struct particle (x y dx dy b))

(define (move p)
  (match-define (particle x y dx dy b) p)
  (define new-x (+ x dx))
  (define new-y (+ y dy))

  (particle
   new-x new-y
   (if
     (or (> 0 new-x)
         (< W new-x)) (- dx) dx)
   (if
     (or (> 0 new-y)
         (< H new-y)) (- dy) dy)

   b))

(define start-state
  (build-list 500
              (lambda (_)
                (particle
                 (random W) (random H)
                 (- (random 10) 5) (- (random 10) 5)
                 (new brush% [color (car (shuffle all-colors))])
                 ))))

(define (tick-world world) (map move world))

(define (draw-world canvas world)
  (let [(dc (send canvas get-dc))]
    (send dc set-pen no-pen)
  (for ([p world])
    (match-define (particle x y dx dy b) p)
    (send dc set-brush b)
    (send dc draw-ellipse x y 10 10)))
  (send canvas swap-bitmaps))


; Gui ------------------------------

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

(define canvas (instantiate animated-canvas% (frame)
                 (style '(border))
                 (min-width W) (min-height H)))

(send frame show #t)

(define (loop w)
  (let ((t (current-milliseconds)))
    (draw-world canvas w)
    (sleep/yield (max 0.0 (/ (- 10.0 (- (current-milliseconds) t)) 1000.0)))
    (loop (tick-world w))))

(loop start-state)