suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

slideshow/pict: fix clipping problem with `standard-fish'

Browse Source
This commit is contained in:
Matthew Flatt 2012-05-22 06:43:01 -04:00
parent 7156b0391b
commit e334632ffc
1 changed files with 6 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/texpict/utils.rkt
View File

@ -785,7 +785,7 @@
(if (eq? direction 'left) (if (eq? direction 'left)
x0 x0
(+ x (- w (- x0 x) w0))))] (+ x (- w (- x0 x) w0))))]
[set-rgn (lambda (rgn flip?) [set-rgn (lambda (rgn flip? old-rgn)
(let ([dy (if flip? (/ h 2) 0)] (let ([dy (if flip? (/ h 2) 0)]
[wf (λ (x) (* (if (eq? 'left direction) x (+ 1 (* x -1))) w))]) [wf (λ (x) (* (if (eq? 'left direction) x (+ 1 (* x -1))) w))])
(if mouth-open? (if mouth-open?
@ -801,7 +801,9 @@
x (+ y dy)) x (+ y dy))
(send rgn set-rectangle (send rgn set-rectangle
x (+ y dy) x (+ y dy)
w (/ h 2)))))]) w (/ h 2))))
(when old-rgn
(send rgn intersect old-rgn)))])
(send dc set-pen no-pen) (send dc set-pen no-pen)
(color-series (color-series
dc 4 1 dc 4 1
@ -822,7 +824,7 @@
x y)) x y))
#f #t) #f #t)
(set-rgn rgn #f) (set-rgn rgn #f old-rgn)
(send dc set-clipping-region rgn) (send dc set-clipping-region rgn)
(color-series (color-series
dc 4 1 dc 4 1
@ -833,7 +835,7 @@
#f #t) #f #t)
(send dc set-clipping-region old-rgn) (send dc set-clipping-region old-rgn)
(set-rgn rgn #t) (set-rgn rgn #t old-rgn)
(send dc set-clipping-region rgn) (send dc set-clipping-region rgn)
(color-series (color-series
dc 4 1 dc 4 1