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.
This commit is contained in:
Asumu Takikawa 2012-03-31 11:42:57 -04:00
parent c758f65a0b
commit 94a837fcc8
10 changed files with 67 additions and 116 deletions

View File

@ -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)]

View File

@ -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: "

View File

@ -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)))

View File

@ -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))

View File

@ -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)

View File

@ -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)

View File

@ -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)))

View File

@ -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)))

View File

@ -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))

View File

@ -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