From 94a837fcc8a4dbae6bcda5d165ff6b2766057070 Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Sat, 31 Mar 2012 11:42:57 -0400
Subject: [PATCH] Remove dynamic checks from racket/draw.

Now that this code has contracts, these checks are
redundant. The contracts are at least as precise as the
checks are.
---
 collects/racket/draw/private/bitmap-dc.rkt | 45 ++++++++------------
 collects/racket/draw/private/bitmap.rkt    | 32 +++++----------
 collects/racket/draw/private/brush.rkt     |  3 +-
 collects/racket/draw/private/color.rkt     |  4 +-
 collects/racket/draw/private/dc-path.rkt   | 34 +++++++--------
 collects/racket/draw/private/font.rkt      |  3 +-
 collects/racket/draw/private/gl-config.rkt |  8 ++--
 collects/racket/draw/private/pen.rkt       |  2 +-
 collects/racket/draw/private/point.rkt     |  4 +-
 collects/racket/draw/private/region.rkt    | 48 +++++++---------------
 10 files changed, 67 insertions(+), 116 deletions(-)

diff --git a/collects/racket/draw/private/bitmap-dc.rkt b/collects/racket/draw/private/bitmap-dc.rkt
index a668a4cdb5..08bb51c3c3 100644
--- a/collects/racket/draw/private/bitmap-dc.rkt
+++ b/collects/racket/draw/private/bitmap-dc.rkt
@@ -112,57 +112,44 @@
         (and bm
              (send bm get-bitmap-gl-context))))
 
-    (def/public (set-bitmap [(make-or-false bitmap%) v])
+    (define/public (set-bitmap v)
       (internal-set-bitmap v))
 
     (def/public (get-bitmap)
       (internal-get-bitmap))
     
-    (def/public (set-pixel [real? x][real? y][color% c])
+    (define/public (set-pixel x y c)
       (let ([s (bytes 255 (color-red c) (color-green c) (color-blue c))])
         (set-argb-pixels x y 1 1 s)))
 
-    (def/public (get-pixel [real? x][real? y][color% c])
+    (define/public (get-pixel x y c)
       (let-values ([(w h) (get-size)])
         (let ([b (make-bytes 4)])
           (get-argb-pixels x y 1 1 b)
           (send c set (bytes-ref b 1) (bytes-ref b 2) (bytes-ref b 3))
           (and (<= 0 x w) (<= 0 y h)))))
 
-    (def/public (set-argb-pixels [exact-nonnegative-integer? x]
-                                 [exact-nonnegative-integer? y]
-                                 [exact-nonnegative-integer? w]
-                                 [exact-nonnegative-integer? h]
-                                 [bytes? bstr]
-                                 [any? [set-alpha? #f]]
-                                 [any? [pre-mult? #f]])
+    (define/public (set-argb-pixels x y w h bstr
+                                    [set-alpha? #f]
+                                    [pre-mult? #f])
       (let ([bm (internal-get-bitmap)])
         (when bm
           (send bm set-argb-pixels x y w h bstr set-alpha? pre-mult?))))
 
-    (def/public (get-argb-pixels [exact-nonnegative-integer? x]
-                                 [exact-nonnegative-integer? y]
-                                 [exact-nonnegative-integer? w]
-                                 [exact-nonnegative-integer? h]
-                                 [bytes? bstr]
-                                 [any? [get-alpha? #f]]
-                                 [any? [pre-mult? #f]])
+    (define/public (get-argb-pixels x y w h bstr
+                                    [get-alpha? #f]
+                                    [pre-mult? #f])
       (let ([bm (internal-get-bitmap)])
         (when bm
           (send bm get-argb-pixels x y w h bstr get-alpha? pre-mult?))))
 
-    (def/public (draw-bitmap-section-smooth [bitmap% src]
-                                            [real? dest-x]
-                                            [real? dest-y]
-                                            [nonnegative-real? dest-w]
-                                            [nonnegative-real? dest-h]
-                                            [real? src-x]
-                                            [real? src-y]
-                                            [nonnegative-real? src-w]
-                                            [nonnegative-real? src-h]
-                                            [(symbol-in solid opaque xor) [style 'solid]]
-                                            [(make-or-false color%) [color black]]
-                                            [(make-or-false bitmap%) [mask #f]])
+    (define/public (draw-bitmap-section-smooth src dest-x dest-y
+                                               dest-w dest-h
+                                               src-x src-y
+                                               src-w src-h
+                                               [style 'solid]
+                                               [color black]
+                                               [mask #f])
       (let ([sx (if (zero? src-w) 1.0 (/ dest-w src-w))]
             [sy (if (zero? src-h) 1.0 (/ dest-h src-h))])
         (let ([t (get-transformation)]
diff --git a/collects/racket/draw/private/bitmap.rkt b/collects/racket/draw/private/bitmap.rkt
index f9e71d563c..5a46bc4e88 100644
--- a/collects/racket/draw/private/bitmap.rkt
+++ b/collects/racket/draw/private/bitmap.rkt
@@ -286,10 +286,10 @@
     (define/public (get-bitmap-gl-context)
       #f)
 
-    (def/public (load-file [(make-alts path-string? input-port?) in]
-                           [bitmap-file-kind-symbol? [kind 'unknown]]
-                           [(make-or-false color%) [bg #f]]
-                           [any? [complain-on-failure? #f]])
+    (define/public (load-file in
+                              [kind 'unknown]
+                              [bg #f]
+                              [complain-on-failure? #f])
       (check-alternate 'load-file)
       (release-bitmap-storage)
       (set!-values (s b&w?) (do-load-bitmap in kind bg complain-on-failure?))
@@ -502,9 +502,7 @@
         (proc bm)
         (send bm release-bitmap-storage)))
 
-    (def/public (save-file [(make-alts path-string? output-port?) out]
-                           [bitmap-save-kind-symbol? [kind 'unknown]]
-                           [quality-integer? [quality 75]])
+    (define/public (save-file out [kind 'unknown] [quality 75])
       (and (ok?)
            (begin
              (if alt?
@@ -625,13 +623,9 @@
 
     (define/public (get-handle) s)
 
-    (def/public (get-argb-pixels [exact-nonnegative-integer? x]
-                                 [exact-nonnegative-integer? y]
-                                 [exact-nonnegative-integer? w]
-                                 [exact-nonnegative-integer? h]
-                                 [bytes? bstr]
-                                 [any? [get-alpha? #f]]
-                                 [any? [pre-mult? #f]])
+    (define/public (get-argb-pixels x y w h bstr
+                                    [get-alpha? #f]
+                                    [pre-mult? #f])
       (unless ((bytes-length bstr) . >=  . (* w h 4))
         (raise-mismatch-error (method-name 'bitmap% 'get-argb-pixels)
                               "byte string is too short: "
@@ -701,13 +695,9 @@
               (let ([p (+ (* 4 i) row)])
                 (bytes-set! bstr p 255)))))]))
 
-    (def/public (set-argb-pixels [exact-nonnegative-integer? x]
-                                 [exact-nonnegative-integer? y]
-                                 [exact-nonnegative-integer? w]
-                                 [exact-nonnegative-integer? h]
-                                 [bytes? bstr]
-                                 [any? [set-alpha? #f]]
-                                 [any? [pre-mult? #f]])
+    (define/public (set-argb-pixels x y w h bstr
+                                    [set-alpha? #f]
+                                    [pre-mult? #f])
       (unless ((bytes-length bstr) . >=  . (* w h 4))
         (raise-mismatch-error (method-name 'bitmap% 'set-argb-pixels)
                               "byte string is too short: "
diff --git a/collects/racket/draw/private/brush.rkt b/collects/racket/draw/private/brush.rkt
index 4a9a4e3ea9..f33da0452c 100644
--- a/collects/racket/draw/private/brush.rkt
+++ b/collects/racket/draw/private/brush.rkt
@@ -118,8 +118,7 @@
   (define/public (get-transformation) transformation)
 
   (def/public (get-stipple) stipple)
-  (def/public (set-stipple [(make-or-false bitmap%) s] 
-                           [(make-or-false transformation-vector?) [t #f]])
+  (define/public (set-stipple s [t #f])
     (check-immutable 'set-stipple)
     (set! stipple s)
     (set! transformation (and s t)))
diff --git a/collects/racket/draw/private/color.rkt b/collects/racket/draw/private/color.rkt
index 4380e22e87..cb44086cfc 100644
--- a/collects/racket/draw/private/color.rkt
+++ b/collects/racket/draw/private/color.rkt
@@ -55,7 +55,7 @@
   (def/public (blue) b)
   (def/public (alpha) a)
 
-  (def/public (set [byte? rr] [byte? rg] [byte? rb] [(real-in 0 1) [ra 1.0]])
+  (define/public (set rr rg rb [ra 1.0])
     (if immutable?
         (error (method-name 'color% 'set) "object is immutable")
         (begin
@@ -68,7 +68,7 @@
   (def/public (is-immutable?) immutable?)
   (def/public (set-immutable) (set! immutable? #t))
   
-  (def/public (copy-from [color% c])
+  (define/public (copy-from c)
     (if immutable?
         (error (method-name 'color% 'copy-from) "object is immutable")
         (begin (set (color-red c) (color-green c) (color-blue c) (color-alpha c))
diff --git a/collects/racket/draw/private/dc-path.rkt b/collects/racket/draw/private/dc-path.rkt
index 87ca6ae85d..21a30d8419 100644
--- a/collects/racket/draw/private/dc-path.rkt
+++ b/collects/racket/draw/private/dc-path.rkt
@@ -109,7 +109,7 @@
         (cairo_close_path cr))
       (do-points cr open-points align-x align-y))
 
-    (def/public (append [dc-path% path])
+    (define/public (append path)
       (flatten-closed!)
       (flatten-open!)
       (set! closed-points (s:append closed-points (send path get-closed-points)))
@@ -175,7 +175,7 @@
                                            (max b (vector-ref p 1) (vector-ref p 3)))]))])
               (values l t (- r l) (- b t))))))
     
-    (def/public (move-to [real? x] [real? y])
+    (define/public (move-to x y)
       (when (or (pair? open-points)
                 (pair? rev-open-points))
         (close))
@@ -184,7 +184,7 @@
     (define/private (do-move-to x y)
       (set! rev-open-points (list (cons (exact->inexact x) (exact->inexact y)))))
 
-    (def/public (line-to [real? x] [real? y])
+    (define/public (line-to x y)
       (unless (or (pair? open-points)
                   (pair? rev-open-points))
         (error (method-name 'dc-path% 'line-to) "path not yet open"))
@@ -193,9 +193,7 @@
     (define/private (do-line-to x y)
       (set! rev-open-points (cons (cons (exact->inexact x) (exact->inexact y)) rev-open-points)))
 
-    (def/public (lines [(make-alts (make-list point%) list-of-pair-of-real?) pts]
-                       [real? [x 0.0]]
-                       [real? [y 0.0]])
+    (define/public (lines pts [x 0.0] [y 0.0])
       (unless (or (pair? open-points)
                   (pair? rev-open-points))
         (error (method-name 'dc-path% 'lines) "path not yet open"))
@@ -204,7 +202,7 @@
             (do-line-to (+ x (car p)) (+ y (cdr p)))
             (do-line-to (+ x (point-x p)) (+ y (point-y p))))))
 
-    (def/public (curve-to [real? x1] [real? y1] [real? x2] [real? y2] [real? x3] [real? y3])
+    (define/public (curve-to x1 y1 x2 y2 x3 y3)
       (unless (or (pair? open-points)
                   (pair? rev-open-points))
         (error (method-name 'dc-path% 'curve-to) "path not yet open"))
@@ -219,9 +217,7 @@
                                            (exact->inexact y2))
                                    rev-open-points)))
 
-    (def/public (arc [real? x] [real? y] 
-                     [real? w] [real? h]
-                     [real? start] [real? end] [any? [ccw? #t]])
+    (define/public (arc x y w h start end [ccw? #t])
       (do-arc x y w h start end ccw?))
     
     (define/private (do-arc x y w h start end ccw?)
@@ -306,13 +302,12 @@
                                  (vector-ref v 4) (vector-ref v 5)
                                  (vector-ref v 6) (vector-ref v 7)))))))))
 
-    (def/public (ellipse [real? x] [real? y] 
-                         [nonnegative-real? w] [nonnegative-real? h])
+    (define/public (ellipse x y w h)
       (when (open?) (close))
       (do-arc x y w h 0 2pi #f)
       (close))
 
-    (def/public (text-outline [font% font] [string? str] [real? x] [real? y] [any? [combine? #f]])
+    (define/public (text-outline font str x y [combine? #f])
       (when (open?) (close))
       (let ([p (text-to-path font str x y combine?)])
         (for ([a (in-list p)])
@@ -325,7 +320,7 @@
             [(close) (close)])))
       (close))
 
-    (def/public (scale [real? x][real? y])
+    (define/public (scale x y)
       (unless (and (= x 1.0) (= y 1.0))
         (flatten-open!)
         (flatten-closed!)
@@ -343,7 +338,7 @@
                     (* (vector-ref p 2) x)
                     (* (vector-ref p 3) y)))))
   
-    (def/public (translate [real? x][real? y])
+    (define/public (translate x y)
       (unless (and (zero? x) (zero? y))
         (flatten-open!)
         (flatten-closed!)
@@ -361,7 +356,7 @@
                     (+ (vector-ref p 2) x)
                     (+ (vector-ref p 3) y)))))
 
-    (def/public (rotate [real? th])
+    (define/public (rotate th)
       (flatten-open!)
       (flatten-closed!)
       (set! open-points (rotate-points open-points th))
@@ -383,7 +378,7 @@
              [cx (make-polar (magnitude cx) (+ (angle cx) (- th)))])
         (values (real-part cx) (imag-part cx))))
 
-    (def/public (transform [matrix-vector? m])
+    (define/public (transform m)
       (flatten-open!)
       (flatten-closed!)
       (set! open-points (transform-points open-points m))
@@ -406,7 +401,7 @@
                  (* y (vector-ref m 3))
                  (vector-ref m 5))))
 
-    (def/public (rectangle [real? x] [real? y] [real? w] [real? h])
+    (define/public (rectangle x y w h)
       (when (open?) (close))
       (move-to x y)
       (line-to (+ x w) y)
@@ -414,8 +409,7 @@
       (line-to x (+ y h))
       (close))
 
-    (def/public (rounded-rectangle [real? x] [real? y] [real? w] [real? h]
-                                   [real? [radius -0.25]])
+    (define/public (rounded-rectangle x y w h [radius -0.25])
       (when (open?) (close))
       (let ([dx (min (/ w 2)
                      (if (negative? radius)
diff --git a/collects/racket/draw/private/font.rkt b/collects/racket/draw/private/font.rkt
index 9860a097d2..024fc49f0a 100644
--- a/collects/racket/draw/private/font.rkt
+++ b/collects/racket/draw/private/font.rkt
@@ -201,8 +201,7 @@
   (def/public (get-font-id) id)
   (def/public (get-font-key) key)
 
-  (def/public (screen-glyph-exists? [char? c]
-                                    [any? [for-label? #f]])
+  (define/public (screen-glyph-exists? c [for-label? #f])
     (has-screen-glyph? c this (get-pango) for-label?))
 
   (init-rest args)
diff --git a/collects/racket/draw/private/gl-config.rkt b/collects/racket/draw/private/gl-config.rkt
index 7b3f080bff..4c0ef26d85 100644
--- a/collects/racket/draw/private/gl-config.rkt
+++ b/collects/racket/draw/private/gl-config.rkt
@@ -17,20 +17,20 @@
 
   (define stencil-size 0)
   (define/public (get-stencil-size) stencil-size)
-  (def/public (set-stencil-size [(integer-in 0 256) s])
+  (define/public (set-stencil-size s)
     (set! stencil-size s))
     
   (define accum-size 0)
   (define/public (get-accum-size) accum-size)
-  (def/public (set-accum-size [(integer-in 0 256) s])
+  (define/public (set-accum-size s)
     (set! accum-size s))
 
   (define depth-size 1)
   (define/public (get-depth-size) depth-size)
-  (def/public (set-depth-size [(integer-in 0 256) s])
+  (define/public (set-depth-size s)
     (set! depth-size s))
 
   (define multisample-size 0)
   (define/public (get-multisample-size) multisample-size)
-  (def/public (set-multisample-size [(integer-in 0 256) s])
+  (define/public (set-multisample-size s)
     (set! multisample-size s)))
diff --git a/collects/racket/draw/private/pen.rkt b/collects/racket/draw/private/pen.rkt
index e9fea0cc4d..5a4271bc1d 100644
--- a/collects/racket/draw/private/pen.rkt
+++ b/collects/racket/draw/private/pen.rkt
@@ -125,7 +125,7 @@
 
   (define stipple #f)
   (def/public (get-stipple) stipple)
-  (def/public (set-stipple [(make-or-false bitmap%) s]) 
+  (define/public (set-stipple s)
     (check-immutable 'set-stipple)
     (set! stipple s)))
 
diff --git a/collects/racket/draw/private/point.rkt b/collects/racket/draw/private/point.rkt
index 1d5b95f780..1cf6de2c63 100644
--- a/collects/racket/draw/private/point.rkt
+++ b/collects/racket/draw/private/point.rkt
@@ -11,8 +11,8 @@
                 [y 0.0])
     (define/public (get-x) x)
     (define/public (get-y) y)
-    (def/public (set-x [real? v]) (set! x (exact->inexact v)))
-    (def/public (set-y [real? v]) (set! y (exact->inexact v)))
+    (define/public (set-x v) (set! x (exact->inexact v)))
+    (define/public (set-y v) (set! y (exact->inexact v)))
     (super-new)))
 
 (define point-x (class-field-accessor point% x))
diff --git a/collects/racket/draw/private/region.rkt b/collects/racket/draw/private/region.rkt
index ced36f4cd9..b78f840806 100644
--- a/collects/racket/draw/private/region.rkt
+++ b/collects/racket/draw/private/region.rkt
@@ -188,8 +188,7 @@
              [temp-cr (cairo_destroy cr)]
              [else (set! temp-cr cr)]))))))
     
-    (def/public (in-region? [real? x]
-                            [real? y])
+    (define/public (in-region? x y)
       (with-temp-cr
        (lambda (cr)
         (let-values ([(x y)
@@ -206,12 +205,7 @@
                           (values x y))])
           (install-region cr #t values values (lambda (cr v) (and v (cairo_in_fill cr x y))))))))
 
-    (def/public (set-arc [real? x]
-                         [real? y]
-                         [nonnegative-real? width]
-                         [nonnegative-real? height]
-                         [real? start-radians]
-                         [real? end-radians])
+    (define/public (set-arc x y width height start-radians end-radians)
       (modifying 'set-arc)
       (let ([p (new dc-path%)])
         (send p move-to (+ x (/ width 2)) (+ y (/ height 2)))
@@ -220,20 +214,16 @@
         (when matrix (send p transform matrix))
         (set! paths (list (cons p 'any)))))
 
-    (def/public (set-ellipse [real? x]
-                             [real? y]
-                             [nonnegative-real? width]
-                             [nonnegative-real? height])
+    (define/public (set-ellipse x y width height)
       (modifying 'set-ellipse)
       (let ([p (new dc-path%)])
         (send p ellipse x y width height)
         (when matrix (send p transform matrix))
         (set! paths (list (cons p 'any)))))
 
-    (def/public (set-path [dc-path% path]
-                          [real? [x 0.0]]
-                          [real? [y 0.0]]
-                          [(symbol-in odd-even winding) [fill-style 'odd-even]])
+    (define/public (set-path path
+                             [x 0.0] [y 0.0]
+                             [fill-style 'odd-even])
       (modifying 'set-path)
       (let ([p (new dc-path%)])
         (send p append path)
@@ -241,10 +231,9 @@
         (when matrix (send p transform matrix))
         (set! paths (list (cons p fill-style)))))
 
-    (def/public (set-polygon [(make-alts (make-list point%) list-of-pair-of-real?) pts]
-                             [real? [x 0.0]]
-                             [real? [y 0.0]]
-                             [(symbol-in odd-even winding) [fill-style 'odd-even]])
+    (define/public (set-polygon pts
+                                [x 0.0] [y 0.0]
+                                [fill-style 'odd-even])
       (modifying 'set-polygon)
       (if (null? pts)
           (set! paths null)
@@ -261,21 +250,14 @@
             (when matrix (send p transform matrix))
             (set! paths (list (cons p fill-style))))))
 
-    (def/public (set-rectangle [real? x]
-                               [real? y]
-                               [nonnegative-real? width]
-                               [nonnegative-real? height])
+    (define/public (set-rectangle x y width height)
       (modifying 'set-rectangle)
       (let ([p (new dc-path%)])
         (send p rectangle x y width height)
         (when matrix (send p transform matrix))
         (set! paths (list (cons p 'any)))))
 
-    (def/public (set-rounded-rectangle [real? x]
-                                       [real? y]
-                                       [nonnegative-real? width]
-                                       [nonnegative-real? height]
-                                       [real? [radius -0.25]])
+    (define/public (set-rounded-rectangle x y width height [radius -0.25])
       (modifying 'set-rounded-rectangle)
       (let ([p (new dc-path%)])
         (send p rounded-rectangle x y width height radius)
@@ -288,12 +270,12 @@
                               "different built-in dc for given region: " 
                               r)))
 
-    (def/public (intersect [region% r])
+    (define/public (intersect r)
       (check-compatible r 'union)
       (modifying 'intersect)
       (set! paths (append paths (send r get-paths))))
 
-    (def/public (subtract [region% r])
+    (define/public (subtract r)
       (check-compatible r 'subtract)
       (unless (null? paths)
         (let ([add-paths (send r get-paths)])
@@ -302,10 +284,10 @@
               (do-union 'subtract r  (lambda (p) (rev-paths p)))
               (set! paths (append paths p)))))))
 
-    (def/public (union [region% r])
+    (define/public (union r)
       (do-union 'union r values))
 
-    (def/public (xor [region% r])
+    (define/public (xor r)
       (do-union 'xor r (lambda (p) (rev-paths p))))
 
     (define/private rev-paths