#lang scheme/gui

;; another quick improvised approach to frame-based animation
;; this time with critters that cycle through several different appearances
;; Lee Spector, lspector@hampshire.edu, 20091105

;; definitions from better-draw.ss
(define width 500)
(define height 500)

(define frame (new frame% (label "Drawing Window")
                   (width width)
                   (height height)))

(define bm (make-object bitmap% width height))

(define canvas
  (new canvas% [parent frame]
       [paint-callback (lambda (canvas dc)
                         (send dc draw-bitmap bm 0 0))]))

(define dc (make-object bitmap-dc% bm))
(send dc clear)
(send dc set-pen (make-object pen% "BLACK" 1 'transparent)) ;; No pen
(send dc set-smoothing 'smoothed)

(define show-window
  (lambda ()
    (send frame show #t)))

(define ellipse
  (lambda (x y width height r g b a)
    (send dc set-brush (make-object brush% (make-object color% r g b) 'solid))
    (send dc set-alpha a)
    (send dc draw-ellipse x y width height)
    (send canvas refresh)))

(define rectangle
  (lambda (x y width height r g b a)
    (send dc set-brush (make-object brush% (make-object color% r g b) 'opaque))
    (send dc set-alpha a)
    (send dc draw-rectangle x y width height)
    (send canvas refresh)))

(define line
  (lambda (x1 y1 x2 y2 width r g b a)
    (let ((pen (make-object pen% "BLACK" width 'solid)))
      (send pen set-color r g b)
      (send dc set-pen pen)
      (send dc set-alpha a)
      (send dc draw-line x1 y1 x2 y2)
      (send canvas refresh))
    (send dc set-pen (make-object pen% "BLACK" 1 'transparent))))

(define clear
  (lambda ()
    (rectangle 0 0 width height 255 255 255 1.0)))

;; New stuff

;; each critter is a list of (x y delta-x delta-y stage)

(define critters '((200 200 0 0 0) ;; this one should stay still
                   (100 100 5 5 1)(300 200 -2 -3 0) (350 50 -4 6 2)))

(define draw-critter
  (lambda (c)
    (cond ((= (fifth c) 0)
           (ellipse (first c) (second c) 100 100 100 0 0 1.0))
          ((= (fifth c) 1)
           (ellipse (- (first c) 5) (+ (second c) 5) 110 90 100 50 0 1.0))
          ((= (fifth c) 2)
           (ellipse (first c) (second c) 100 100 100 100 0 1.0))
          (else
           (ellipse (+ (first c) 5) (- (second c) 5) 90 110 100 50 0 1.0)))))

(define draw-all
  (lambda ()
    (for-each draw-critter critters)))

(define move-all
  (lambda ()
    (set! critters (map (lambda (c) (list (+ (first c) (third c))
                                          (+ (second c) (fourth c))
                                          (third c)
                                          (fourth c)
                                          (modulo (+ 1 (fifth c)) 4)))
                        critters))))

(define animate
  (lambda (howmanytimes)
    (for ((i (in-range howmanytimes)))
      (clear)
      (draw-all)
      (move-all)
      (sleep/yield 0.1))))


(show-window)

(animate 100)