#lang scheme/gui ;; code from class, CS 153: Code Immersion ;; this is a quick improvized approach to frame-based animation ;; Lee Spector, lspector@hampshire.edu, 20091103 ;; 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))) ;; Following is the improvized code from class, demonstrating ;; a basic approach to frame-based animation. An initial improvement ;; that you might want to make is to store all of the positions in ;; a single global list -- this will make it simpler to add additional ;; critters. (define critter1-position (list 100 100)) (define draw-critter1 (lambda () (ellipse (car critter1-position) (cadr critter1-position) 100 100 100 0 0 1.0))) (define critter2-position (list 100 100)) (define draw-critter2 (lambda () (ellipse (car critter2-position) (cadr critter2-position) 70 120 150 100 0 1.0))) (show-window) (define draw-all (lambda () (draw-critter1) (draw-critter2))) (define move-all (lambda () (move-critter1) (move-critter2))) (define animate (lambda (howmanytimes) (for ((i (in-range howmanytimes))) (clear) (draw-all) (move-all) (sleep/yield 0.01)))) (define move-critter1 (lambda () (set! critter1-position (list (modulo (+ 5 (car critter1-position)) width) (cadr critter1-position))))) (define move-critter2 (lambda () (set! critter2-position (list (car critter2-position) (+ 3 (cadr critter2-position)))))) (animate 250)