From ab94122c81a9d684b3a8dbf935b679ecea43c526 Mon Sep 17 00:00:00 2001
From: Patrick Mahoney <paddy.mahoney@gmail.com>
Date: Tue, 21 Aug 2012 14:56:23 -0400
Subject: [PATCH] Remove opt-lambda uses, unused imports

---
 collects/frtime/animation.rkt | 775 +++++++++++++++++-----------------
 1 file changed, 387 insertions(+), 388 deletions(-)

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