removed unused argument to normalize-image
original commit: 4941aec6177f0059c3a3c09e76e391b732b8e7cc
This commit is contained in:
parent
c333bc022e
commit
984005b3a1
|
@ -413,12 +413,11 @@ has been moved out).
|
||||||
(boolean? (flip-flipped? shape))
|
(boolean? (flip-flipped? shape))
|
||||||
(bitmap? (flip-shape shape)))))
|
(bitmap? (flip-shape shape)))))
|
||||||
|
|
||||||
;; normalize-shape : shape (atomic-shape -> atomic-shape) -> normalized-shape
|
;; normalize-shape : shape -> normalized-shape
|
||||||
;; normalizes 'shape', calling 'f' on each atomic shape in the normalized shape.
|
;; normalizes 'shape', calling 'f' on each atomic shape in the normalized shape.
|
||||||
(define/contract (normalize-shape shape [f values])
|
(define/contract (normalize-shape shape)
|
||||||
(->* (any/c) ;; should be shape?
|
(-> any/c ;; should be shape?
|
||||||
((-> any/c any/c))
|
normalized-shape?)
|
||||||
normalized-shape?)
|
|
||||||
(let loop ([shape shape]
|
(let loop ([shape shape]
|
||||||
[dx 0]
|
[dx 0]
|
||||||
[dy 0]
|
[dy 0]
|
||||||
|
@ -465,16 +464,16 @@ has been moved out).
|
||||||
(polygon-mode shape)
|
(polygon-mode shape)
|
||||||
(scale-color (polygon-color shape) x-scale y-scale))])
|
(scale-color (polygon-color shape) x-scale y-scale))])
|
||||||
(if bottom
|
(if bottom
|
||||||
(make-overlay bottom (f this-one))
|
(make-overlay bottom this-one)
|
||||||
(f this-one)))]
|
this-one))]
|
||||||
[(line-segment? shape)
|
[(line-segment? shape)
|
||||||
(let ([this-one
|
(let ([this-one
|
||||||
(make-line-segment (scale-point (line-segment-start shape))
|
(make-line-segment (scale-point (line-segment-start shape))
|
||||||
(scale-point (line-segment-end shape))
|
(scale-point (line-segment-end shape))
|
||||||
(scale-color (line-segment-color shape) x-scale y-scale))])
|
(scale-color (line-segment-color shape) x-scale y-scale))])
|
||||||
(if bottom
|
(if bottom
|
||||||
(make-overlay bottom (f this-one))
|
(make-overlay bottom this-one)
|
||||||
(f this-one)))]
|
this-one))]
|
||||||
[(curve-segment? shape)
|
[(curve-segment? shape)
|
||||||
;; the pull is multiplied by the distance
|
;; the pull is multiplied by the distance
|
||||||
;; between the two points when it is drawn,
|
;; between the two points when it is drawn,
|
||||||
|
@ -488,8 +487,8 @@ has been moved out).
|
||||||
(curve-segment-e-pull shape)
|
(curve-segment-e-pull shape)
|
||||||
(scale-color (curve-segment-color shape) x-scale y-scale))])
|
(scale-color (curve-segment-color shape) x-scale y-scale))])
|
||||||
(if bottom
|
(if bottom
|
||||||
(make-overlay bottom (f this-one))
|
(make-overlay bottom this-one)
|
||||||
(f this-one)))]
|
this-one))]
|
||||||
[(or (bitmap? shape) (np-atomic-shape? shape))
|
[(or (bitmap? shape) (np-atomic-shape? shape))
|
||||||
(let ([shape (if (bitmap? shape)
|
(let ([shape (if (bitmap? shape)
|
||||||
(make-flip #f shape)
|
(make-flip #f shape)
|
||||||
|
@ -497,8 +496,8 @@ has been moved out).
|
||||||
(let ([this-one
|
(let ([this-one
|
||||||
(make-translate dx dy (scale-np-atomic x-scale y-scale shape))])
|
(make-translate dx dy (scale-np-atomic x-scale y-scale shape))])
|
||||||
(if bottom
|
(if bottom
|
||||||
(make-overlay bottom (f this-one))
|
(make-overlay bottom this-one)
|
||||||
(f this-one))))]
|
this-one)))]
|
||||||
[else
|
[else
|
||||||
(error 'normalize-shape "unknown shape ~s\n" shape)])))
|
(error 'normalize-shape "unknown shape ~s\n" shape)])))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user