suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Remove opt-lambda uses, unused imports

Browse Source
This commit is contained in:
Patrick Mahoney 2012-08-21 14:56:23 -04:00 committed by Gregory Cooper
parent a02d53130e
commit 5fd7e2fc1a
1 changed files with 387 additions and 388 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

775
collects/frtime/animation.rkt
View File

@ -1,388 +1,387 @@
(module animation frtime (module animation frtime
(require (except-in frtime/animation/graphics (require (except-in frtime/animation/graphics
make-posn posn-x posn-y make-rgb) make-posn posn-x posn-y make-rgb)
(for-syntax racket/base (only-in racket/function identity)) (for-syntax racket/base (only-in racket/function identity))
(lifted (only-in frtime/animation/graphics posn-x) (lifted (only-in frtime/animation/graphics posn-x)
posn-x) posn-x)
(lifted (only-in frtime/animation/graphics posn-y) (lifted (only-in frtime/animation/graphics posn-y)
posn-y) posn-y)
(lifted (only-in frtime/animation/graphics make-posn) (lifted (only-in frtime/animation/graphics make-posn)
make-posn) make-posn)
(lifted (only-in frtime/animation/graphics make-rgb) make-rgb) (lifted (only-in frtime/animation/graphics make-rgb) make-rgb)
racket/match racket/match
(as-is:unchecked frtime/lang-ext lift) (as-is:unchecked frtime/lang-ext lift)
racket/class racket/class
frtime/frlibs/list frtime/frlibs/list
frtime/frlibs/etc frtime/frlibs/etc
frtime/frlibs/math frtime/frlibs/math)
#;(rename-in racket [define-struct mz:define-struct]))
(require (for-syntax (only-in racket/base build-list)
(require (for-syntax (only-in racket/base build-list) (only-in racket/function identity)))
(only-in racket/function identity)))
(open-graphics)
(open-graphics)
(define fresh-anim
(define fresh-anim (let ([first #t])
(let ([first #t]) (lambda ([x 400] [y 400] [title "Animation - DrRacket"])
(opt-lambda ([x 400] [y 400] [title "Animation - DrRacket"]) (if first
(if first (set! first #f)
(set! first #f) (begin
(begin (set! window
(set! window (open-viewport title x y))
(open-viewport title x y))
(set! pixmap
(set! pixmap (open-pixmap "" x y))
(open-pixmap "" x y))
(set! mouse-pos
(set! mouse-pos (hold ((viewport-mouse-events window)
(hold ((viewport-mouse-events window) . ==> .
. ==> . (lambda (ev) (make-posn
(lambda (ev) (make-posn (send ev get-x)
(send ev get-x) (send ev get-y))))
(send ev get-y)))) (query-mouse-posn window)))
(query-mouse-posn window)))
(set! key-strokes ((viewport-key-events window) . ==> . sixkey-value))
(set! key-strokes ((viewport-key-events window) . ==> . sixkey-value))
(set! left-clicks ((viewport-mouse-events window) . =#> . (lambda (ev) (send ev button-down? 'left))))
(set! left-clicks ((viewport-mouse-events window) . =#> . (lambda (ev) (send ev button-down? 'left)))) (set! middle-clicks ((viewport-mouse-events window) . =#> . (lambda (ev) (send ev button-down? 'middle))))
(set! middle-clicks ((viewport-mouse-events window) . =#> . (lambda (ev) (send ev button-down? 'middle)))) (set! right-clicks ((viewport-mouse-events window) . =#> . (lambda (ev) (send ev button-down? 'right)))))))))
(set! right-clicks ((viewport-mouse-events window) . =#> . (lambda (ev) (send ev button-down? 'right)))))))))
(define window
(define window (open-viewport "Animation - DrRacket" 400 400))
(open-viewport "Animation - DrRacket" 400 400))
(define pixmap
(define pixmap (open-pixmap "" 400 400))
(open-pixmap "" 400 400))
(define mouse-pos
(define mouse-pos (hold ((viewport-mouse-events window)
(hold ((viewport-mouse-events window) . =#=> .
. =#=> . (lambda (ev) (if (send ev moving?)
(lambda (ev) (if (send ev moving?) (make-posn
(make-posn (send ev get-x)
(send ev get-x) (send ev get-y))
(send ev get-y)) nothing)))
nothing))) (query-mouse-posn window)))
(query-mouse-posn window)))
(define filtered-keys (viewport-key-events window))
(define filtered-keys (viewport-key-events window)) (define shift-down (hold (filtered-keys . ==> . sixkey-shift)))
(define shift-down (hold (filtered-keys . ==> . sixkey-shift))) (define control-down (hold (filtered-keys . ==> . sixkey-control)))
(define control-down (hold (filtered-keys . ==> . sixkey-control))) (define meta-down (hold (filtered-keys . ==> . sixkey-meta)))
(define meta-down (hold (filtered-keys . ==> . sixkey-meta))) (define alt-down (hold (filtered-keys . ==> . sixkey-alt)))
(define alt-down (hold (filtered-keys . ==> . sixkey-alt))) (define key-strokes ((viewport-key-events window) . ==> . sixkey-value))
(define key-strokes ((viewport-key-events window) . ==> . sixkey-value)) (define left-clicks ((viewport-mouse-events window) . =#> . (lambda (ev) (send ev button-down? 'left))))
(define left-clicks ((viewport-mouse-events window) . =#> . (lambda (ev) (send ev button-down? 'left)))) (define middle-clicks ((viewport-mouse-events window) . =#> . (lambda (ev) (send ev button-down? 'middle))))
(define middle-clicks ((viewport-mouse-events window) . =#> . (lambda (ev) (send ev button-down? 'middle)))) (define right-clicks ((viewport-mouse-events window) . =#> . (lambda (ev) (send ev button-down? 'right))))
(define right-clicks ((viewport-mouse-events window) . =#> . (lambda (ev) (send ev button-down? 'right)))) (define left-releases ((viewport-mouse-events window) . =#> . (lambda (ev) (send ev button-up? 'left))))
(define left-releases ((viewport-mouse-events window) . =#> . (lambda (ev) (send ev button-up? 'left)))) (define middle-releases ((viewport-mouse-events window) . =#> . (lambda (ev) (send ev button-up? 'middle))))
(define middle-releases ((viewport-mouse-events window) . =#> . (lambda (ev) (send ev button-up? 'middle)))) (define right-releases ((viewport-mouse-events window) . =#> . (lambda (ev) (send ev button-up? 'right))))
(define right-releases ((viewport-mouse-events window) . =#> . (lambda (ev) (send ev button-up? 'right))))
(define-syntax (define-shape-struct stx)
(define-syntax (define-shape-struct stx) (syntax-case stx ()
(syntax-case stx () [(_ name (field ...))
[(_ name (field ...)) (with-syntax
(with-syntax ([ctor-name (datum->syntax stx (string->symbol (format "make-~a" (syntax-e #'name))))]
([ctor-name (datum->syntax stx (string->symbol (format "make-~a" (syntax-e #'name))))] [(accessor-name ...)
[(accessor-name ...) (map (lambda (fd)
(map (lambda (fd) (string->symbol (format "~a-~a" (syntax-e #'name) (syntax-e fd))))
(string->symbol (format "~a-~a" (syntax-e #'name) (syntax-e fd)))) (syntax-e #'(field ...)))]
(syntax-e #'(field ...)))] [(index ...)
[(index ...) (build-list (length (syntax-e #'(field ...))) identity)])
(build-list (length (syntax-e #'(field ...))) identity)]) #'(begin
#'(begin (define (ctor-name field ...)
(define (ctor-name field ...) (vector 'name field ...))
(vector 'name field ...)) (define (accessor-name obj)
(define (accessor-name obj) (vector-ref obj index))
(vector-ref obj index)) ...))]))
...))]))
(define-struct ring (center radius color))
(define-struct ring (center radius color)) (define-struct solid-ellipse (ul w h color))
(define-struct solid-ellipse (ul w h color)) (define-struct graph-string (pos text color))
(define-struct graph-string (pos text color)) (define-struct line (p1 p2 color))
(define-struct line (p1 p2 color)) (define-struct rect (ul w h color))
(define-struct rect (ul w h color)) (define-struct rrect (ur w h color))
(define-struct rrect (ur w h color)) (define-struct curve (xmin xmax ymin ymax fn))
(define-struct curve (xmin xmax ymin ymax fn)) (define-struct polygon (posn-list posn color))
(define-struct polygon (posn-list posn color)) (define-struct solid-polygon (posn-list posn color))
(define-struct solid-polygon (posn-list posn color)) (define-struct arc (pos width height start-radians end-radians color))
(define-struct arc (pos width height start-radians end-radians color)) (define-struct solid-arc (pos width height start-radians end-radians color))
(define-struct solid-arc (pos width height start-radians end-radians color)) (define-struct image (pos renderer))
(define-struct image (pos renderer))
(define (prep-image file)
(define (prep-image file) (draw-pixmap-posn file))
(draw-pixmap-posn file))
(define (make-circle center r color)
(define (make-circle center r color) (make-solid-ellipse (make-posn (- (posn-x center) r)
(make-solid-ellipse (make-posn (- (posn-x center) r) (- (posn-y center) r))
(- (posn-y center) r)) (* 2 r) (* 2 r) color))
(* 2 r) (* 2 r) color))
(define l (new-cell empty))
(define l (new-cell empty))
(define (display-shapes x)
(define (display-shapes x) (set-cell! l x))
(set-cell! l x))
(define (top-level-draw-list a-los)
(define (top-level-draw-list a-los) (compound-lift
(compound-lift (lambda (vn)
(lambda (vn) ((clear-viewport pixmap))
((clear-viewport pixmap)) (draw-list a-los vn)
(draw-list a-los vn) (copy-viewport pixmap window))))
(copy-viewport pixmap window))))
(define (my-for-each proc lst v-n)
(define (my-for-each proc lst v-n) (let ([lst (v-n lst)])
(let ([lst (v-n lst)]) (if (empty? lst)
(if (empty? lst) (void)
(void) (begin
(begin (proc (v-n (first lst)))
(proc (v-n (first lst))) (my-for-each proc (rest lst) v-n)))))
(my-for-each proc (rest lst) v-n)))))
(define (draw-list a-los v-n)
(define (draw-list a-los v-n) (let loop ([a-los a-los])
(let loop ([a-los a-los]) (my-for-each
(my-for-each (lambda (v)
(lambda (v) (match (v-n v)
(match (v-n v) [(? undefined?) (void)]
[(? undefined?) (void)] [(ring center radius color)
[(ring center radius color) (let ([center (v-n center)]
(let ([center (v-n center)] [radius (v-n radius)]
[radius (v-n radius)] [color (v-n color)])
[color (v-n color)]) (unless (or (undefined? center)
(unless (or (undefined? center) (undefined? radius))
(undefined? radius)) ((draw-ellipse pixmap)
((draw-ellipse pixmap) (make-posn (- (v-n (posn-x center)) radius)
(make-posn (- (v-n (posn-x center)) radius) (- (v-n (posn-y center)) radius))
(- (v-n (posn-y center)) radius)) (* 2 radius)
(* 2 radius) (* 2 radius)
(* 2 radius) (if (undefined? color) "black" color))))]
(if (undefined? color) "black" color))))] [(arc pos width height start-radians end-radians color)
[(arc pos width height start-radians end-radians color) (let ([pos (v-n pos)]
(let ([pos (v-n pos)] [width (v-n width)]
[width (v-n width)] [height (v-n height)]
[height (v-n height)] [start-radians (v-n start-radians)]
[start-radians (v-n start-radians)] [end-radians (v-n end-radians)])
[end-radians (v-n end-radians)]) ((draw-arc pixmap) pos width height start-radians end-radians color))]
((draw-arc pixmap) pos width height start-radians end-radians color))] [(solid-arc pos width height start-radians end-radians color)
[(solid-arc pos width height start-radians end-radians color) (let ([pos (v-n pos)]
(let ([pos (v-n pos)] [width (v-n width)]
[width (v-n width)] [height (v-n height)]
[height (v-n height)] [start-radians (v-n start-radians)]
[start-radians (v-n start-radians)] [end-radians (v-n end-radians)])
[end-radians (v-n end-radians)]) ((draw-solid-arc pixmap) pos width height start-radians end-radians color))]
((draw-solid-arc pixmap) pos width height start-radians end-radians color))] [(image pos renderer)
[(image pos renderer) (let ([renderer (v-n renderer)]
(let ([renderer (v-n renderer)] [pos (v-n pos)])
[pos (v-n pos)]) ((renderer pixmap) pos))]
((renderer pixmap) pos))] [(solid-ellipse ul w h color)
[(solid-ellipse ul w h color) (let ([ul (v-n ul)]
(let ([ul (v-n ul)] [w (v-n w)]
[w (v-n w)] [h (v-n h)]
[h (v-n h)] [color (v-n color)])
[color (v-n color)]) (unless (or (undefined? ul)
(unless (or (undefined? ul) (undefined? w)
(undefined? w) (undefined? h))
(undefined? h)) ((draw-solid-ellipse pixmap) ul w h (if (undefined? color) "black" color))))]
((draw-solid-ellipse pixmap) ul w h (if (undefined? color) "black" color))))] [(graph-string pos text color) ((draw-string pixmap) (v-n pos) (v-n text) (v-n color))]
[(graph-string pos text color) ((draw-string pixmap) (v-n pos) (v-n text) (v-n color))] [(line p1 p2 color)
[(line p1 p2 color) (let ([p1 (v-n p1)]
(let ([p1 (v-n p1)] [p2 (v-n p2)]
[p2 (v-n p2)] [color (v-n color)])
[color (v-n color)]) (unless (or (undefined? p1)
(unless (or (undefined? p1) (undefined? p2))
(undefined? p2)) ((draw-line pixmap) p1 p2 (if (undefined? color) "black" color))))]
((draw-line pixmap) p1 p2 (if (undefined? color) "black" color))))] [(rect ul w h color)
[(rect ul w h color) (let ([ul (v-n ul)]
(let ([ul (v-n ul)] [w (v-n w)]
[w (v-n w)] [h (v-n h)]
[h (v-n h)] [color (v-n color)])
[color (v-n color)]) (cond
(cond [(and (>= w 0) (>= h 0)) ((draw-solid-rectangle pixmap) ul w h color)]
[(and (>= w 0) (>= h 0)) ((draw-solid-rectangle pixmap) ul w h color)] [(>= h 0) ((draw-solid-rectangle pixmap) (make-posn (+ (posn-x ul) w) (posn-y ul)) (- w) h color)]
[(>= h 0) ((draw-solid-rectangle pixmap) (make-posn (+ (posn-x ul) w) (posn-y ul)) (- w) h color)] [(>= w 0) ((draw-solid-rectangle pixmap) (make-posn (posn-x ul) (+ (posn-y ul) h)) w (- h) color)]
[(>= w 0) ((draw-solid-rectangle pixmap) (make-posn (posn-x ul) (+ (posn-y ul) h)) w (- h) color)] [else ((draw-solid-rectangle pixmap) (make-posn (+ (posn-x ul) w) (+ (posn-y ul) h)) (- w) (- h) color)]))]
[else ((draw-solid-rectangle pixmap) (make-posn (+ (posn-x ul) w) (+ (posn-y ul) h)) (- w) (- h) color)]))] [(polygon pts offset color) ((draw-polygon pixmap) pts offset color)]
[(polygon pts offset color) ((draw-polygon pixmap) pts offset color)] [(solid-polygon pts offset color) ((draw-solid-polygon pixmap) pts offset color)]
[(solid-polygon pts offset color) ((draw-solid-polygon pixmap) pts offset color)] [(? list? x) (loop (v-n x))]
[(? list? x) (loop (v-n x))] [(? void?) (void)]))
[(? void?) (void)])) a-los v-n)))
a-los v-n)))
(define d (top-level-draw-list l))
(define d (top-level-draw-list l))
(define-struct graph-color (fn xmin xmax ymin ymax))
(define-struct graph-color (fn xmin xmax ymin ymax))
(define (draw-graph-color pm gc)
(define (draw-graph-color pm gc) (let ([dp (draw-pixel pm)])
(let ([dp (draw-pixel pm)]) (match gc
(match gc [(graph-color fn xmin xmax ymin ymax)
[(graph-color fn xmin xmax ymin ymax) (let ([xincr (/ (- xmax xmin) 300)]
(let ([xincr (/ (- xmax xmin) 300)] [yincr (/ (- ymax ymin) 300)])
[yincr (/ (- ymax ymin) 300)]) (let loop ([i 50] [y ymin])
(let loop ([i 50] [y ymin]) (let loop ([j 50] [x xmin])
(let loop ([j 50] [x xmin]) (dp (make-posn j i) (fn x y))
(dp (make-posn j i) (fn x y)) (when (< j 350)
(when (< j 350) (loop (add1 j) (+ x xincr))))
(loop (add1 j) (+ x xincr)))) (when (< i 350)
(when (< i 350) (loop (add1 i) (+ y yincr)))))])))
(loop (add1 i) (+ y yincr)))))])))
(define (valid-posn? v)
(define (valid-posn? v) (and (posn? v) (number? (posn-x v)) (number? (posn-y v))))
(and (posn? v) (number? (posn-x v)) (number? (posn-y v))))
(define (key sym)
(define (key sym) (key-strokes
(key-strokes . =#> .
. =#> . (lambda (x) (eq? x (value-now sym)))))
(lambda (x) (eq? x (value-now sym)))))
(define (draw vp pm posl)
(define (draw vp pm posl) ((clear-viewport pm))
((clear-viewport pm)) (for-each (lambda (elt)
(for-each (lambda (elt) (cond
(cond [(graph-color? elt) (draw-graph-color pm elt)]
[(graph-color? elt) (draw-graph-color pm elt)] [(string? elt) ((draw-string pm) (make-posn 8 20) elt)]
[(string? elt) ((draw-string pm) (make-posn 8 20) elt)] [(valid-posn? elt) ((draw-solid-ellipse pm)
[(valid-posn? elt) ((draw-solid-ellipse pm) (make-posn (- (posn-x elt) 10)
(make-posn (- (posn-x elt) 10) (- (posn-y elt) 10))
(- (posn-y elt) 10)) 20 20
20 20 (make-rgb 0 .6 .6))]
(make-rgb 0 .6 .6))] [(and (cons? elt)
[(and (cons? elt) (valid-posn? (first elt))
(valid-posn? (first elt)) (valid-posn? (rest elt))) ((draw-line pm)
(valid-posn? (rest elt))) ((draw-line pm) (first elt)
(first elt) (rest elt)
(rest elt) "black")]
"black")] [else (void)])) posl)
[else (void)])) posl) (copy-viewport pm vp))
(copy-viewport pm vp))
#|
#| (define foldl
(define foldl (case-lambda
(case-lambda [(f i l) (if (cons? l)
[(f i l) (if (cons? l) (foldl f (f (first l) i) (rest l))
(foldl f (f (first l) i) (rest l)) i)]))
i)])) |#
|#
(define (drop n l)
(define (drop n l) (if (empty? l)
(if (empty? l) empty
empty (if (<= n 0)
(if (<= n 0) l
l (drop (sub1 n) (rest l)))))
(drop (sub1 n) (rest l)))))
(define (inc-max n)
(define (inc-max n) (lambda (x) (if (>= x n)
(lambda (x) (if (>= x n) n
n (add1 x))))
(add1 x))))
(define (dec-min n)
(define (dec-min n) (lambda (x) (if (<= x n)
(lambda (x) (if (<= x n) n
n (sub1 x))))
(sub1 x))))
(define (fix-rgb r g b)
(define (fix-rgb r g b) (let ([fix (lambda (n) (min 1 (max 0 n)))])
(let ([fix (lambda (n) (min 1 (max 0 n)))]) (apply make-rgb (map fix (list r g b)))))
(apply make-rgb (map fix (list r g b)))))
(define range-control
(define range-control (lambda (up down limit [init 0])
(opt-lambda (up down limit [init 0]) (accum-b
(accum-b (merge-e (up . -=> . (inc-max limit))
(merge-e (up . -=> . (inc-max limit)) (down . -=> . (dec-min 0)))
(down . -=> . (dec-min 0))) init)))
init)))
(define (keyboard-control up down limit)
(define (keyboard-control up down limit) (accum-b
(accum-b (key-strokes
(key-strokes . =#=> .
. =#=> . (match-lambda
(match-lambda [(? (lambda (x) (eq? x up))) (inc-max limit)]
[(? (lambda (x) (eq? x up))) (inc-max limit)] [(? (lambda (x) (eq? x down))) (dec-min 0)]
[(? (lambda (x) (eq? x down))) (dec-min 0)] [_ nothing]))
[_ nothing])) 0))
0))
(define-struct wave-state (hz offset))
(define-struct wave-state (hz offset))
(define (wave hz)
(define (wave hz) (let* ([state (collect-b
(let* ([state (collect-b (snapshot-e (changes hz) milliseconds)
(snapshot-e (changes hz) milliseconds) (make-wave-state (value-now hz) 0)
(make-wave-state (value-now hz) 0) (lambda (new-freq+time old-state)
(lambda (new-freq+time old-state) (match new-freq+time
(match new-freq+time [(list h1 t)
[(list h1 t) (match old-state
(match old-state [(wave-state h0 o0)
[(wave-state h0 o0) (make-wave-state
(make-wave-state h1
h1 (+ o0 (* .002 pi t (- h0 h1))))])])))])
(+ o0 (* .002 pi t (- h0 h1))))])])))]) (+ (lift #f wave-state-offset state)
(+ (lift #f wave-state-offset state) (* milliseconds pi (lift #f wave-state-hz state) .002))))
(* milliseconds pi (lift #f wave-state-hz state) .002))))
(define (current-and-last-value signal)
(define (current-and-last-value signal) (let ([init (value-now signal)])
(let ([init (value-now signal)]) (collect-b (changes signal)
(collect-b (changes signal) (list init init)
(list init init) (lambda (new-value previous-two)
(lambda (new-value previous-two) (list new-value (first previous-two))))))
(list new-value (first previous-two))))))
(define (last-value signal)
(define (last-value signal) (second (current-and-last-value signal)))
(second (current-and-last-value signal)))
; (define (last-value signal)
; (define (last-value signal) ; (let ([init (value-now signal)])
; (let ([init (value-now signal)]) ; (rest
; (rest ; (collect-b (changes signal)
; (collect-b (changes signal) ; (cons init init)
; (cons init init) ; (lambda (new old-pair)
; (lambda (new old-pair) ; (cons new (first old-pair)))))))
; (cons new (first old-pair)))))))
(define (posn+ . args)
(define (posn+ . args) (make-posn (apply + (map posn-x args))
(make-posn (apply + (map posn-x args)) (apply + (map posn-y args))))
(apply + (map posn-y args))))
(define (posn- . args)
(define (posn- . args) (make-posn (apply - (map posn-x args))
(make-posn (apply - (map posn-x args)) (apply - (map posn-y args))))
(apply - (map posn-y args))))
(define (posn/ p s)
(define (posn/ p s) (make-posn (/ (posn-x p) s)
(make-posn (/ (posn-x p) s) (/ (posn-y p) s)))
(/ (posn-y p) s)))
(define (posn* p s)
(define (posn* p s) (make-posn (* (posn-x p) s)
(make-posn (* (posn-x p) s) (* (posn-y p) s)))
(* (posn-y p) s)))
(define (posn-dot p1 p2)
(define (posn-dot p1 p2) (+ (* (posn-x p1) (posn-x p2))
(+ (* (posn-x p1) (posn-x p2)) (* (posn-y p1) (posn-y p2))))
(* (posn-y p1) (posn-y p2))))
(define (posn-len p)
(define (posn-len p) (sqrt (+ (sqr (posn-x p)) (sqr (posn-y p)))))
(sqrt (+ (sqr (posn-x p)) (sqr (posn-y p)))))
(define (normalize p)
(define (normalize p) (posn/ p (posn-len p)))
(posn/ p (posn-len p)))
(define (current-mouse-pos)
(define (current-mouse-pos) (value-now mouse-pos))
(value-now mouse-pos))
(define (clip x lo hi)
(define (clip x lo hi) (if (< x lo)
(if (< x lo) lo
lo (if (> x hi)
(if (> x hi) hi
hi x)))
x)))
(define (posn-diff p1 p2)
(define (posn-diff p1 p2) (sqrt (+ (sqr (- (posn-x p1) (posn-x p2)))
(sqrt (+ (sqr (- (posn-x p1) (posn-x p2))) (sqr (- (posn-y p1) (posn-y p2))))))
(sqr (- (posn-y p1) (posn-y p2))))))
(define (posn-derivative p)
(define (posn-derivative p) (make-posn (derivative (posn-x p)) (derivative (posn-y p))))
(make-posn (derivative (posn-x p)) (derivative (posn-y p))))
(define (posn-integral p)
(define (posn-integral p) (make-posn (integral (posn-x p)) (integral (posn-y p))))
(make-posn (integral (posn-x p)) (integral (posn-y p))))
(provide
(provide (except-out (all-defined-out) pixmap window draw-list l d
(except-out (all-defined-out) pixmap window draw-list l d make-wave-state wave-state-hz wave-state-offset)
make-wave-state wave-state-hz wave-state-offset) (all-from-out frtime/animation/graphics)))
(all-from-out frtime/animation/graphics)))