Refactor plot-screen to take title as an optional keyword arg. You of…

…ten don't care about this parameter, so making it optional is good.
noelwelsh · Sep 3, 2009 · 9a06001 · 9a06001
1 parent 50ee12d
commit 9a06001
Show file tree

Hide file tree

Showing 3 changed files with 10 additions and 13 deletions.
diff --git a/bonfire/main.ss b/bonfire/main.ss
@@ -3,7 +3,7 @@
 (require
  "point.ss"
  "frame.ss"
- "screen.ss"))
+ "screen.ss")
 
 (provide
  (all-from-out "point.ss"

diff --git a/bonfire/plot-screen-test.ss b/bonfire/plot-screen-test.ss
@@ -4,33 +4,30 @@
 ;;
 ;; Run these tests from MrEd
 
-(require "plot.ss"
-         "screen.ss"
-         "frame.ss"
-         "point.ss")
+(require "main.ss")
 
 
 ;; Four circles arranged in a square. This tests mark
 ;; constructors and frame coordinates
 (define (four-circles)
-  (plot-screen "Four Circles"
-               (circles
+  (plot-screen (circles
                 (list (point 0 0 3)
                       (point 0 12 3)
                       (point 12 12 3)
-                      (point 12 0 3)))))
+                      (point 12 0 3)))
+               #:title "Four Circles"))
 
 ;; A square!  Tests lines
 (define (square)
-  (plot-screen "Square"
+  (plot-screen #:title "Square"
                (lines (list (cons (point 2 0) (point 3 2))
                             (cons (point 3 2) (point 1 3))
                             (cons (point 1 3) (point 0 1))
                             (cons (point 0 1) (point 2 0))))))
 
 ;; Tests crosses and colours
 (define (colourful-crosses)
-  (plot-screen "Colourful Crosses"
+  (plot-screen #:title "Colourful Crosses"
                (overlay
                 (colour (crosses (list (point 0 0) (point 10 0) (point 0 10) (point 10 10)))
                         (point 255 0 0 1))

diff --git a/bonfire/screen.ss b/bonfire/screen.ss
@@ -7,9 +7,9 @@
 (define height 300)
 (define padding 20)
 
-(define (plot-screen label box)
+(define (plot-screen frame #:title [title "Bonfire"])
   (define f (new frame%
-               [label label]
+               [label title]
                [width (inexact->exact (ceiling (+ (* 2 padding) height)))]
                [height (inexact->exact (ceiling (+ (* 2 padding) width)))]))
   (define c (new (class canvas%
@@ -18,7 +18,7 @@
                      (when (send evt button-down?)
                        (printf "[~a ~a]\n" (send evt get-x) (send evt get-y)))))
                  [parent f]
-                 [paint-callback (make-plotter box)]))
+                 [paint-callback (make-plotter frame)]))
   (send f show #t)
   f)