graphics/turtles: fixed up for an 'xor-less world

(and generally brought this code into the current millenium)

collects/graphics/turtle-examples.rkt

@@ -8,27 +8,27 @@
          peano-position-turtle peano fern-size fern1 fern2 gapped-lines)
 
 (define (regular-poly sides radius)
-  (local [(define theta (/ (* 2 pi) sides))
-          (define side-len (* 2 radius (sin (/ theta 2))))
-          (define (draw-sides n)
-            (cond
-              [(zero? n) (void)]
-              [else
-               (draw side-len)
-               (turn/radians theta)
-               (draw-sides (sub1 n))]))]
-    (tprompt (move radius)
-             (turn/radians (/ (+ pi theta) 2))
-             (draw-sides sides))))
+  (define theta (/ (* 2 pi) sides))
+  (define side-len (* 2 radius (sin (/ theta 2))))
+  (define (draw-sides n)
+    (cond
+      [(zero? n) (void)]
+      [else
+       (draw side-len)
+       (turn/radians theta)
+       (draw-sides (sub1 n))]))
+  (tprompt (move radius)
+           (turn/radians (/ (+ pi theta) 2))
+           (draw-sides sides)))
 
 (define (regular-polys sides s)
-  (local [(define (make-polys n)
-            (cond
-              [(zero? n) (void)]
-              [else
-               (regular-poly sides (* n 5))
-               (make-polys (sub1 n))]))]
-    (make-polys sides)))
+  (define (make-polys n)
+    (cond
+      [(zero? n) (void)]
+      [else
+       (regular-poly sides (* n 5))
+       (make-polys (sub1 n))]))
+  (make-polys sides))
 
 (define (radial-turtles n)
   (cond
@@ -55,180 +55,178 @@
   (regular-poly 3 100))
 
 (define (neato)
-  (local [(define (spiral d t)
-            (cond
-              [(<= 1 d)
-               (draw d)
-               (turn/radians t)
-               (spiral (- d 1) t)]
-              [else (void)]))]
-    (radial-turtles 4)
-    (spiral 30 (/ pi 12))))
+  (define (spiral d t)
+    (cond
+      [(<= 1 d)
+       (draw d)
+       (turn/radians t)
+       (spiral (- d 1) t)]
+      [else (void)]))
+  (radial-turtles 4)
+  (spiral 30 (/ pi 12)))
 
 (define (graphics-bexam)
-  (local [(define (gb d)
-            (cond
-              [(<= d 3)
-               (draw d)]
-              [else
-               (local [(define new-d (/ d 3))]
-                 (gb new-d)
-                 (turn/radians (- (/ pi 2)))
-                 (gb new-d)
-                 (turn/radians (/ pi 2))
-                 (gb new-d)
-                 (turn/radians (/ pi 2))
-                 (gb new-d)
-                 (turn/radians (- (/ pi 2)))
-                 (gb new-d))]))
-          (define square-size (expt 3 5))]
-    (split (turn/radians (/ pi 2))
-           (move square-size)
-           (turn/radians (- (/ pi 2)))
-           (move square-size)
-           (turn/radians pi))
-    (split (move square-size)
-           (turn/radians (/ pi 2)))
-    (gb square-size)))
+  (define (gb d)
+    (cond
+      [(<= d 3)
+       (draw d)]
+      [else
+       (define new-d (/ d 3))
+       (gb new-d)
+       (turn/radians (- (/ pi 2)))
+       (gb new-d)
+       (turn/radians (/ pi 2))
+       (gb new-d)
+       (turn/radians (/ pi 2))
+       (gb new-d)
+       (turn/radians (- (/ pi 2)))
+       (gb new-d)]))
+  (define square-size (expt 3 5))
+  (split (turn/radians (/ pi 2))
+         (move square-size)
+         (turn/radians (- (/ pi 2)))
+         (move square-size)
+         (turn/radians pi))
+  (split (move square-size)
+         (turn/radians (/ pi 2)))
+  (gb square-size))
 
 (define serp-size 120)
 
 (define (serp distance)
-  (local [(define sqrt3 (sqrt 3))
-          (define -2pi/3 (- 0 (/ (* 2 pi) 3)))
-          (define pi/6 (/ pi 6))
-          (define -5pi/6 (- 0 (/ (* 5 pi) 6)))
-          (define pi/2 (/ pi 2))
-          (define (engine distance)
-            (cond
-              [(< distance 1) (void)]
-              [else
-               (local [(define side-half (* distance sqrt3))
-                       (define side (* 2 side-half))]
-                 (turn/radians -2pi/3)
-                 (move distance)
-                 (split (move distance)
-                        (turn/radians -5pi/6)
-                        (draw side)
-                        (turn/radians -5pi/6)
-                        (move distance)
-                        (turn/radians pi)
-                        (split (turn/radians -5pi/6)
-                               (move side-half)
-                               (turn/radians pi/6)))
-                 (engine (/ distance 2)))]))]
-    (move (* 2 distance))
-    (turn/radians (/ (* 5 pi) 6))
-    (draw (* distance 2 (sqrt 3)))
-    (turn/radians (/ (* 2 pi) 3))
-    (move (* distance 2 (sqrt 3)))
-    (turn/radians (/ (* 2 pi) 3))
-    (draw (* distance 2 (sqrt 3)))
-    (turn/radians (/ (* 2 pi) 3))
-    (turn/radians (/ pi 6))
-    (move (* 2 distance))
-    (turn/radians pi)
-    (engine distance)))
+  (define sqrt3 (sqrt 3))
+  (define -2pi/3 (- 0 (/ (* 2 pi) 3)))
+  (define pi/6 (/ pi 6))
+  (define -5pi/6 (- 0 (/ (* 5 pi) 6)))
+  (define pi/2 (/ pi 2))
+  (define (engine distance)
+    (unless (< distance 1)
+      (define side-half (* distance sqrt3))
+      (define side (* 2 side-half))
+      (turn/radians -2pi/3)
+      (move distance)
+      (split (move distance)
+             (turn/radians -5pi/6)
+             (draw side)
+             (turn/radians -5pi/6)
+             (move distance)
+             (turn/radians pi)
+             (split (turn/radians -5pi/6)
+                    (move side-half)
+                    (turn/radians pi/6)))
+      (engine (/ distance 2))))
+  (move (* 2 distance))
+  (turn/radians (/ (* 5 pi) 6))
+  (draw (* distance 2 (sqrt 3)))
+  (turn/radians (/ (* 2 pi) 3))
+  (move (* distance 2 (sqrt 3)))
+  (turn/radians (/ (* 2 pi) 3))
+  (draw (* distance 2 (sqrt 3)))
+  (turn/radians (/ (* 2 pi) 3))
+  (turn/radians (/ pi 6))
+  (move (* 2 distance))
+  (turn/radians pi)
+  (engine distance))
 
 (define (serp-nosplit distance)
-  (local [(define sqrt3 (sqrt 3))
-          (define -2pi/3 (- 0 (/ (* 2 pi) 3)))
-          (define pi/6 (/ pi 6))
-          (define -5pi/6 (- 0 (/ (* 5 pi) 6)))
-          (define pi/2 (/ pi 2))
-          (define (engine distance)
-            (cond
-              [(< distance 1) (void)]
-              [else
-               (local [(define side-half (* distance sqrt3))
-                       (define side (* 2 side-half))]
-                 (turn/radians -2pi/3)
-                 (move distance)
-                 (engine (/ distance 2))
-                 (move distance)
-                 (turn/radians -5pi/6)
-                 (draw side)
-                 (turn/radians -5pi/6)
-                 (move distance)
-                 (turn/radians pi)
-                 (engine (/ distance 2))
-                 (turn/radians -5pi/6)
-                 (move side-half)
-                 (turn/radians pi/6)
-                 (engine (/ distance 2))
-                 (move (- distance)))]))]
-    (move (* 2 distance))
-    (turn/radians (/ (* 5 pi) 6))
-    (draw (* distance 2 (sqrt 3)))
-    (turn/radians (/ (* 2 pi) 3))
-    (move (* distance 2 (sqrt 3)))
-    (turn/radians (/ (* 2 pi) 3))
-    (draw (* distance 2 (sqrt 3)))
-    (turn/radians (/ (* 2 pi) 3))
-    (turn/radians (/ pi 6))
-    (move (* 2 distance))
-    (turn/radians pi)
-    (engine distance)))
+  (define sqrt3 (sqrt 3))
+  (define -2pi/3 (- 0 (/ (* 2 pi) 3)))
+  (define pi/6 (/ pi 6))
+  (define -5pi/6 (- 0 (/ (* 5 pi) 6)))
+  (define pi/2 (/ pi 2))
+  (define (engine distance)
+    (unless (< distance 1)
+      (define side-half (* distance sqrt3))
+      (define side (* 2 side-half))
+      (turn/radians -2pi/3)
+      (move distance)
+      (engine (/ distance 2))
+      (move distance)
+      (turn/radians -5pi/6)
+      (draw side)
+      (turn/radians -5pi/6)
+      (move distance)
+      (turn/radians pi)
+      (engine (/ distance 2))
+      (turn/radians -5pi/6)
+      (move side-half)
+      (turn/radians pi/6)
+      (engine (/ distance 2))
+      (move (- distance))))
+  (move (* 2 distance))
+  (turn/radians (/ (* 5 pi) 6))
+  (draw (* distance 2 (sqrt 3)))
+  (turn/radians (/ (* 2 pi) 3))
+  (move (* distance 2 (sqrt 3)))
+  (turn/radians (/ (* 2 pi) 3))
+  (draw (* distance 2 (sqrt 3)))
+  (turn/radians (/ (* 2 pi) 3))
+  (turn/radians (/ pi 6))
+  (move (* 2 distance))
+  (turn/radians pi)
+  (engine distance))
 
 (define koch-size (expt 3 5))
 
 (define (koch-split koch-size)
-  (local [(define (build-up-turtles n)
-            (cond
-              [(<= n 3) 'built]
-              [else (local [(define third (/ n 3))]
-                      (split* 'stay-put
-                              (move (* 2 third))
-                              (begin (move third)
-                                     (turn/radians (- (/ pi 3))))
-                              (begin (move third)
-                                     (turn/radians (- (/ pi 3)))
-                                     (move third)
-                                     (turn/radians (* 2 (/ pi 3)))))
-                      (build-up-turtles third))]))]
-    (split* 'stay-put
-            (begin (move koch-size)
-                   (turn/radians (/ (* 2 pi) 3)))
-            (begin (turn/radians (/ pi 3))
-                   (move koch-size)
-                   (turn/radians pi)))
-    (build-up-turtles koch-size)
-    (draw 3)))
+  (define (build-up-turtles n)
+    (cond
+      [(<= n 3) 'built]
+      [else 
+       (define third (/ n 3))
+       (split* 'stay-put
+               (move (* 2 third))
+               (begin (move third)
+                      (turn/radians (- (/ pi 3))))
+               (begin (move third)
+                      (turn/radians (- (/ pi 3)))
+                      (move third)
+                      (turn/radians (* 2 (/ pi 3)))))
+       (build-up-turtles third)]))
+  (split* 'stay-put
+          (begin (move koch-size)
+                 (turn/radians (/ (* 2 pi) 3)))
+          (begin (turn/radians (/ pi 3))
+                 (move koch-size)
+                 (turn/radians pi)))
+  (build-up-turtles koch-size)
+  (draw 3))
 
 (define (koch-draw koch-size)
-  (local [(define (side n)
-            (cond
-              [(<= n 3) (draw n)]
-              [else (local [(define third (/ n 3))]
-                      (side third)
-                      (turn/radians (- (/ pi 3)))
-                      (side third)
-                      (turn/radians (* 2 (/ pi 3)))
-                      (side third)
-                      (turn/radians (- (/ pi 3)))
-                      (side third))]))]
-    (split* 'stay-put
-            (begin (move koch-size)
-                   (turn/radians (/ (* 2 pi) 3)))
-            (begin (turn/radians (/ pi 3))
-                   (move koch-size)
-                   (turn/radians pi)))
-    (side koch-size)))
+  (define (side n)
+    (cond
+      [(<= n 3) (draw n)]
+      [else 
+       (define third (/ n 3))
+       (side third)
+       (turn/radians (- (/ pi 3)))
+       (side third)
+       (turn/radians (* 2 (/ pi 3)))
+       (side third)
+       (turn/radians (- (/ pi 3)))
+       (side third)]))
+  (split* 'stay-put
+          (begin (move koch-size)
+                 (turn/radians (/ (* 2 pi) 3)))
+          (begin (turn/radians (/ pi 3))
+                 (move koch-size)
+                 (turn/radians pi)))
+  (side koch-size))
 
 (define (lorenz a b c)
-  (local [(define (loop x y z)
-            (local [(define delta 0.01)
-                    (define dx (* delta (* a (- y x))))
-                    (define dy (* delta (- (* x b) y (* x z))))
-                    (define dz (* delta (- (* x y) (* c z))))]
-              (draw-offset dx dz)
-              (sleep 0.05)
-              (erase-offset (- dx) (- dz))
-              (move-offset dx dz)
-              (loop (+ x dx)
-                    (+ y dy)
-                    (+ z dz))))]
-    (loop 1 1 1)))
+  (define (loop x y z)
+    (define delta 0.01)
+    (define dx (* delta (* a (- y x))))
+    (define dy (* delta (- (* x b) y (* x z))))
+    (define dz (* delta (- (* x y) (* c z))))
+    (draw-offset dx dz)
+    (sleep 0.05)
+    (erase-offset (- dx) (- dz))
+    (move-offset dx dz)
+    (loop (+ x dx)
+          (+ y dy)
+          (+ z dz)))
+  (loop 1 1 1))
 
 (define (lorenz1) (lorenz 50 60 11))
 
@@ -245,24 +243,24 @@
     [(<= l 3)
      (draw l)]
     [else
-     (local [(define new-l (/ l 3))]
-       (peano new-l)
-       (tprompt (peano new-l)
-                (split* (turn/radians (/ pi 2))
-                        (turn/radians (- (/ pi 2))))
-                (peano new-l))
-       (tprompt (split* (turn/radians (/ pi 2))
-                        (turn/radians (- (/ pi 2))))
-                (peano new-l))
-       (tprompt (split* (move new-l)
-                        (begin (turn/radians (/ pi 2))
-                               (move new-l)
-                               (turn/radians (- (/ pi 2))))
-                        (begin (turn/radians (- (/ pi 2)))
-                               (move new-l)
-                               (turn/radians (/ pi 2))))
-                (peano l))
-       (move (* 2 new-l)))]))
+     (define new-l (/ l 3))
+     (peano new-l)
+     (tprompt (peano new-l)
+              (split* (turn/radians (/ pi 2))
+                      (turn/radians (- (/ pi 2))))
+              (peano new-l))
+     (tprompt (split* (turn/radians (/ pi 2))
+                      (turn/radians (- (/ pi 2))))
+              (peano new-l))
+     (tprompt (split* (move new-l)
+                      (begin (turn/radians (/ pi 2))
+                             (move new-l)
+                             (turn/radians (- (/ pi 2))))
+                      (begin (turn/radians (- (/ pi 2)))
+                             (move new-l)
+                             (turn/radians (/ pi 2))))
+              (peano l))
+     (move (* 2 new-l))]))
 
 (define fern-size 30)
 
@@ -281,30 +279,30 @@
 
 ;; need to backup a little for this one.
 (define (fern2 n)
-  (local [(define d 0.04)
-          (define (fernd n sign)
-            (cond
-              [(< 1 n)
-               (draw (/ n 2))
-               (tprompt (turn/radians (/ pi 3))
-                        (fernd (/ n 2) -))
-               (tprompt (turn/radians (- (/ pi 3)))
-                        (fernd (/ n 2) +))
-               (draw (/ n 2))
-               (turn/radians (sign d))
-               (fernd (- n 1) sign)]
-              [else (void)]))]
-    (fernd n +)))
+  (define d 0.04)
+  (define (fernd n sign)
+    (cond
+      [(< 1 n)
+       (draw (/ n 2))
+       (tprompt (turn/radians (/ pi 3))
+                (fernd (/ n 2) -))
+       (tprompt (turn/radians (- (/ pi 3)))
+                (fernd (/ n 2) +))
+       (draw (/ n 2))
+       (turn/radians (sign d))
+       (fernd (- n 1) sign)]
+      [else (void)]))
+  (fernd n +))
 
 (define (gapped-lines)
-  (local [(define gaps 5)
-          (define lines 3)]
-    (tprompt
-     (turn/radians (/ pi 2))
-     (spaced-turtles lines)
-     (turn/radians (- (/ pi 2)))
-     (draw (* 4 (expt 2 gaps))))
-    (tprompt
-     (spaced-turtles gaps)
-     (turn/radians (/ pi 2))
-     (erase (* 4 (expt 2 lines))))))
+  (define gaps 5)
+  (define lines 3)
+  (tprompt
+   (turn/radians (/ pi 2))
+   (spaced-turtles lines)
+   (turn/radians (- (/ pi 2)))
+   (draw (* 4 (expt 2 gaps))))
+  (tprompt
+   (spaced-turtles gaps)
+   (turn/radians (/ pi 2))
+   (erase (* 4 (expt 2 lines)))))

collects/graphics/turtles.rkt

@@ -2,10 +2,7 @@
 
 (require racket/gui/base
          (for-syntax racket/base)
-         mzlib/class
-         mzlib/class100
-         mzlib/list
-         mzlib/etc)
+         racket/class)
 
 (provide turtles
          clear home
@@ -38,125 +35,114 @@
 (define turtle-style 'triangle)
 
 (define plot-window%
-  (class100 frame% (name width height)
+  (class frame% 
+    (init-field name width height)
     
-    (private-field
-     [bitmap (make-bitmap width height)])      
+    (define bitmap (make-bitmap width height))      
     
     (inherit show)
-    (private-field
-     [memory-dc (make-object bitmap-dc%)]
-     [pl (make-object point% 0 0)]
-     [pr (make-object point% 0 0)]
-     [ph (make-object point% 0 0)]
-     [points (list pl pr ph)])
-    (public
-      [get-canvas
-       (lambda ()
-         canvas)]
-      [flip-icons
-       (lambda ()
-         (case turtle-style
-           [(triangle line)
-            (flatten (lambda (x) x))
-            (let* ([dc (send canvas get-dc)]
-                   [proc
-                    (if (eq? turtle-style 'line)
-                        (lambda (turtle)
-                          (let ([x (turtle-x turtle)]
-                                [y (turtle-y turtle)]
-                                [theta (turtle-angle turtle)]
-                                [size 2])
-                            (send dc draw-line
-                                  x y
-                                  (+ x (* size (cos theta)))
-                                  (+ y (* size (sin theta))))))
-                        (lambda (turtle)
-                          (let* ([x (turtle-x turtle)]
-                                 [y (turtle-y turtle)]
-                                 [theta (turtle-angle turtle)]
-                                 [long-size 20]
-                                 [short-size 7]
-                                 [l-theta (+ theta pi/2)]
-                                 [r-theta (- theta pi/2)])
-                            (send ph set-x (+ x (* long-size (cos theta))))
-                            (send ph set-y (+ y (* long-size (sin theta))))
-                            (send pl set-x (+ x (* short-size (cos l-theta))))
-                            (send pl set-y (+ y (* short-size (sin l-theta))))
-                            (send pr set-x (+ x (* short-size (cos r-theta))))
-                            (send pr set-y (+ y (* short-size (sin r-theta))))
-                            (send dc draw-polygon points))))])
-              (if (eq? turtle-style 'line)
-                  (send dc set-pen icon-pen)
-                  (begin
-                    (send dc set-pen blank-pen)
-                    (send dc set-brush icon-brush)))
-              (for-each proc turtles-state)
-              (send dc set-pen b-pen))]
-           [else
-            (void)]))]
-      [clear
-       (lambda () 
-         (send memory-dc clear)
-         (send canvas on-paint))])
-    (sequence
-      (send memory-dc set-bitmap bitmap)
+    (define memory-dc (new bitmap-dc%))
+    (define pl (make-object point% 0 0))
+    (define pr (make-object point% 0 0))
+    (define ph (make-object point% 0 0))
+    (define points (list pl pr ph))
+    
+    (define/public (get-canvas) canvas)
+    (define/private (draw-turtle-icons)
+      (case turtle-style
+        [(triangle line)
+         (flatten (lambda (x) x))
+         (let* ([dc (send canvas get-dc)]
+                [proc
+                 (if (eq? turtle-style 'line)
+                     (lambda (turtle)
+                       (let ([x (turtle-x turtle)]
+                             [y (turtle-y turtle)]
+                             [theta (turtle-angle turtle)]
+                             [size 2])
+                         (send dc draw-line
+                               x y
+                               (+ x (* size (cos theta)))
+                               (+ y (* size (sin theta))))))
+                     (lambda (turtle)
+                       (let* ([x (turtle-x turtle)]
+                              [y (turtle-y turtle)]
+                              [theta (turtle-angle turtle)]
+                              [long-size 20]
+                              [short-size 7]
+                              [l-theta (+ theta pi/2)]
+                              [r-theta (- theta pi/2)])
+                         (send ph set-x (+ x (* long-size (cos theta))))
+                         (send ph set-y (+ y (* long-size (sin theta))))
+                         (send pl set-x (+ x (* short-size (cos l-theta))))
+                         (send pl set-y (+ y (* short-size (sin l-theta))))
+                         (send pr set-x (+ x (* short-size (cos r-theta))))
+                         (send pr set-y (+ y (* short-size (sin r-theta))))
+                         (send dc draw-polygon points))))])
+           (if (eq? turtle-style 'line)
+               (send dc set-pen icon-pen)
+               (begin
+                 (send dc set-pen blank-pen)
+                 (send dc set-brush icon-brush)))
+           (for-each proc turtles-state)
+           (send dc set-pen b-pen))]
+        [else
+         (void)]))
+    
+    (define/public (clear)
       (send memory-dc clear)
-      (send memory-dc set-smoothing 'aligned)
-      (super-init name #f width height))
+      (send canvas refresh))
     
-    (public
-      [on-menu-command (lambda (op) (turtles #f))])
-    (private-field
-     [menu-bar (make-object menu-bar% this)]
-     [file-menu (make-object menu% "File" menu-bar)])
-    (sequence 
-      (make-object menu-item%
-                   "Print"
-                   file-menu
-                   (lambda (_1 _2)
-                     (print)))
-      (make-object menu-item%
-                   "Close"
-                   file-menu
-                   (lambda (_1 _2)
-                     (turtles #f))))
+    (send memory-dc set-bitmap bitmap)
+    (send memory-dc clear)
+    (send memory-dc set-smoothing 'smoothed)
+    (super-new [label name] [width width] [height height])
+  
+    (define/public (on-menu-command op) (turtles #f))
     
-    (public
-      [save-turtle-bitmap
-       (lambda (fn type)
-         (send bitmap save-file fn type))])
+    (define menu-bar (make-object menu-bar% this))
+    (define file-menu (make-object menu% "&File" menu-bar))
+    (new menu-item%
+         [label "&Print"]
+         [parent file-menu]
+         [callback (lambda (_1 _2) (print))]
+         [shortcut #\p])
+    (new menu-item%
+         [label "&Close"]
+         [parent file-menu]
+         [callback (lambda (_1 _2) (turtles #f))]
+         [shortcut #\w])
     
-    (private-field
-     [t-canvas% 
-      (class100 canvas% args
+    (define/public (save-turtle-bitmap fn type)
+      (send bitmap save-file fn type))
+    
+    (define t-canvas% 
+      (class canvas%
         (inherit get-dc)
-        (override
-          [on-paint
-           (lambda ()
-             (let ([dc (get-dc)])
-               (send dc clear)
-               (send dc draw-bitmap (send memory-dc get-bitmap) 0 0)
-               (flip-icons)))])
-        (sequence (apply super-init args)))]
-     [canvas (make-object t-canvas% this)]
-     [dc (send canvas get-dc)])
+        (define/override (on-paint)
+          (define dc (get-dc))
+          (send dc set-smoothing 'aligned)
+          (send dc clear)
+          (send dc draw-bitmap (send memory-dc get-bitmap) 0 0)
+          (draw-turtle-icons))
+        (super-new)))
+    (define canvas (make-object t-canvas% this))
+    (define dc (send canvas get-dc))
     
-    (public
-      [wipe-line (lambda (a b c d)
-                   (send memory-dc set-pen w-pen)
-                   (send dc set-pen w-pen)
-                   (send memory-dc draw-line a b c d)
-                   (send dc draw-line a b c d)
-                   (send memory-dc set-pen b-pen)
-                   (send dc set-pen b-pen))]
-      [draw-line (lambda (a b c d)
-                   (send memory-dc draw-line a b c d)
-                   (send dc draw-line a b c d))])
-    (sequence
-      (send canvas min-width width)
-      (send canvas min-height height)
-      (send this clear))))
+    (define/public (wipe-line a b c d)
+      (send memory-dc set-pen w-pen)
+      (send dc set-pen w-pen)
+      (send memory-dc draw-line a b c d)
+      (send dc draw-line a b c d)
+      (send memory-dc set-pen b-pen)
+      (send dc set-pen b-pen))
+    (define/public (draw-line a b c d)
+      (send memory-dc draw-line a b c d)
+      (send dc draw-line a b c d))
+    
+    (send canvas min-width width)
+    (send canvas min-height height)
+    (send this clear)))
 
 (define turtle-window-size
   (let-values ([(w h) (get-display-size)]
@@ -195,7 +181,6 @@
 (define inner-line init-error)
 (define inner-wipe-line init-error)
 (define inner-clear-window init-error)
-(define inner-flip-icons init-error)
 (define inner-save-turtle-bitmap init-error)
 
 (define line
@@ -206,43 +191,35 @@
   (lambda (a b c d)
     (set! lines-in-drawing (cons (make-wipe-line a b c d) lines-in-drawing))
     (inner-wipe-line a b c d)))
-(define (flip-icons) (inner-flip-icons))
 
 (define clear-window (lambda () (inner-clear-window)))
 (define save-turtle-bitmap (lambda (x y) (inner-save-turtle-bitmap x y)))
 
-(define turtles
-  (case-lambda
-   [() (turtles #t)]
-   [(x)
-    (set! turtles:shown? x)
-    (unless turtles:window
-      (set! turtles:window
-            (make-object plot-window%
-                         "Turtles"
-                         turtle-window-size
-                         turtle-window-size))
-      (set! inner-line (lambda x (send turtles:window draw-line . x)))
-      (set! inner-wipe-line (lambda x (send turtles:window wipe-line . x)))
-      (set! inner-clear-window (lambda x (send turtles:window clear . x)))
-      (set! inner-save-turtle-bitmap (lambda x (send turtles:window save-turtle-bitmap . x)))
-      (set! flip-icons (lambda x (send turtles:window flip-icons . x))))
-    (send turtles:window show x)
-    (send turtles:window get-canvas)]))
+(define (turtles [x #t])
+  (set! turtles:shown? x)
+  (unless turtles:window
+    (set! turtles:window
+          (make-object plot-window%
+            "Turtles"
+            turtle-window-size
+            turtle-window-size))
+    (set! inner-line (lambda x (send turtles:window draw-line . x)))
+    (set! inner-wipe-line (lambda x (send turtles:window wipe-line . x)))
+    (set! inner-clear-window (lambda x (send turtles:window clear . x)))
+    (set! inner-save-turtle-bitmap (lambda x (send turtles:window save-turtle-bitmap . x))))
+  (send turtles:window show x)
+  (send turtles:window get-canvas)
+  (void))
 
-(define clear 
-  (lambda ()
-    (set! turtles-cache empty-cache)
-    (set! turtles-state (list clear-turtle))
-    (set! lines-in-drawing null)
-    (clear-window)))
+(define (clear) 
+  (set! turtles-cache empty-cache)
+  (set! turtles-state (list clear-turtle))
+  (set! lines-in-drawing null)
+  (clear-window))
 
-(define home
-  (lambda ()
-    (flip-icons)
-    (set! turtles-cache empty-cache)
-    (set! turtles-state (list clear-turtle))
-    (flip-icons)))
+(define (home)
+  (set! turtles-cache empty-cache)
+  (set! turtles-state (list clear-turtle)))
 
 ;; cache elements:
 (define-struct c-forward (distance))
@@ -253,31 +230,30 @@
 ;; combines a cache-element and a turtle-offset.
 ;; turtle-offsets are represented as turtles, 
 ;; however they are deltas, not absolutes.
-(define combine
-  (lambda (entry cache)
-    (cond 
-     [(c-forward? entry)
-      (let* ([n (c-forward-distance entry)]
-             [angle (turtle-angle cache)]
-             [x (turtle-x cache)]
-             [y (turtle-y cache)]
-             [newx (+ x (* n (cos angle)))]
-             [newy (+ y (* n (sin angle)))])
-        (make-turtle newx newy angle))]
-     [(c-offset? entry)
-      (let* ([tx (turtle-x cache)]
-             [ty (turtle-y cache)]
-             [newx (+ tx (c-offset-x entry))]
-             [newy (+ ty (c-offset-y entry))])
-        (make-turtle newx newy 
-                     (turtle-angle cache)))]
-     [(c-turn? entry)
-      (make-turtle (turtle-x cache)
-                   (turtle-y cache)
-                   (- (turtle-angle cache)
-                      (c-turn-angle entry)))]
-     [else
-      (error 'turtles-cache "illegal entry in cache: ~a" entry)])))
+(define (combine entry cache)
+  (cond 
+    [(c-forward? entry)
+     (let* ([n (c-forward-distance entry)]
+            [angle (turtle-angle cache)]
+            [x (turtle-x cache)]
+            [y (turtle-y cache)]
+            [newx (+ x (* n (cos angle)))]
+            [newy (+ y (* n (sin angle)))])
+       (make-turtle newx newy angle))]
+    [(c-offset? entry)
+     (let* ([tx (turtle-x cache)]
+            [ty (turtle-y cache)]
+            [newx (+ tx (c-offset-x entry))]
+            [newy (+ ty (c-offset-y entry))])
+       (make-turtle newx newy 
+                    (turtle-angle cache)))]
+    [(c-turn? entry)
+     (make-turtle (turtle-x cache)
+                  (turtle-y cache)
+                  (- (turtle-angle cache)
+                     (c-turn-angle entry)))]
+    [else
+     (error 'turtles-cache "illegal entry in cache: ~a" entry)]))
 
 ;; this applies an offset to a turtle.
 ;; an offset is a turtle, representing what would happen 
@@ -320,7 +296,6 @@
 (define draw/erase
   (lambda (doit)
     (lambda (n)
-      (flip-icons)
       (flatten
        (lambda (turtle)
          (let* ([x (turtle-x turtle)]
@@ -336,23 +311,18 @@
                 [newy (+ y (* n s))])
            (unless (zero? n)
              (doit x y drawx drawy))
-           (make-turtle newx newy angle))))
-      (flip-icons))))
+           (make-turtle newx newy angle)))))))
 
 (define draw (draw/erase (lambda (a b c d) (line a b c d))))
 (define erase (draw/erase (lambda (a b c d) (do-wipe-line a b c d))))
 
 (define move
   (lambda (n)
-    (flip-icons)
-    (set! turtles-cache (combine (make-c-forward n) turtles-cache))
-    (flip-icons)))
+    (set! turtles-cache (combine (make-c-forward n) turtles-cache))))
 
 (define turn/radians
   (lambda (d)
-    (flip-icons)
-    (set! turtles-cache (combine (make-c-turn d) turtles-cache))
-    (flip-icons)))
+    (set! turtles-cache (combine (make-c-turn d) turtles-cache))))
 
 (define turn
   (lambda (c)
@@ -360,14 +330,11 @@
 
 (define move-offset
   (lambda (x y)
-    (flip-icons)
-    (set! turtles-cache (combine (make-c-offset x y) turtles-cache))
-    (flip-icons)))
+    (set! turtles-cache (combine (make-c-offset x y) turtles-cache))))
 
 (define erase/draw-offset
   (lambda (doit)
     (lambda (x y)
-      (flip-icons)
       (flatten
        (lambda (turtle)
          (let* ([tx (turtle-x turtle)]
@@ -375,8 +342,7 @@
                 [newx (+ tx x)]
                 [newy (+ ty y)])
            (doit tx ty newx newy)
-           (make-turtle newx newy (turtle-angle turtle)))))
-      (flip-icons))))
+           (make-turtle newx newy (turtle-angle turtle))))))))
 
 (define erase-offset (erase/draw-offset (lambda (a b c d) (do-wipe-line a b c d))))
 (define draw-offset (erase/draw-offset (lambda (a b c d) (line a b c d))))
@@ -386,12 +352,10 @@
     (let ([t turtles-state]
           [c turtles-cache])
       (e)
-      (flip-icons)
       (set! turtles-state
             (make-tree (list (make-cached turtles-state turtles-cache)
                              (make-cached t c))))
-      (set! turtles-cache empty-cache)
-      (flip-icons))))
+      (set! turtles-cache empty-cache))))
 
 (define split*fn
   (lambda (es)
@@ -401,15 +365,11 @@
       (for-each (lambda (x)
                   (x)
                   (set! l (cons (make-cached turtles-state turtles-cache) l))
-                  (flip-icons)
                   (set! turtles-state t)
-                  (set! turtles-cache c)
-                  (flip-icons))
+                  (set! turtles-cache c))
                 es)
-      (flip-icons)
       (set! turtles-cache empty-cache)
-      (set! turtles-state (make-tree l))
-      (flip-icons))))
+      (set! turtles-state (make-tree l)))))
 
 
 (define tpromptfn
@@ -423,10 +383,8 @@
           (lambda ()
             (thunk))
           (lambda ()
-            (flip-icons)
             (set! turtles-cache save-turtles-cache)
-            (set! turtles-state save-turtles-state)
-            (flip-icons))))))
+            (set! turtles-state save-turtles-state))))))
 
 
 (define-struct drawing-line (x1 y1 x2 y2))
@@ -435,28 +393,25 @@
 (define lines-in-drawing null)
 
 (define (draw-lines-into-dc dc)
-  (for-each (lambda (line)
-              (cond
-               [(wipe-line? line) (send dc set-pen w-pen)]
-               [(draw-line? line) (send dc set-pen b-pen)])
-              (send dc draw-line
-                    (drawing-line-x1 line)
-                    (drawing-line-y1 line)
-                    (drawing-line-x2 line)
-                    (drawing-line-y2 line)))
-            lines-in-drawing))
+  (for ([line (in-list lines-in-drawing)])
+    (cond
+      [(wipe-line? line) (send dc set-pen w-pen)]
+      [(draw-line? line) (send dc set-pen b-pen)])
+    (send dc draw-line
+          (drawing-line-x1 line)
+          (drawing-line-y1 line)
+          (drawing-line-x2 line)
+          (drawing-line-y2 line))))
 
 ;; used to test printing
 (define (display-lines-in-drawing)
   (let* ([lines-in-drawing-canvas%
-          (class100 canvas% (frame)
+          (class canvas% 
+            (init-field frame)
             (inherit get-dc)
-            (override
-              [on-paint
-               (lambda ()
-                 (draw-lines-into-dc (get-dc)))])
-            (sequence
-              (super-init frame)))]
+            (define/override (on-paint)
+              (draw-lines-into-dc (get-dc)))
+            (super-new [parent frame]))]
          [frame (make-object frame% "Lines in Drawing")]
          [canvas (make-object lines-in-drawing-canvas% frame)])
     (send frame show #t)))