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

fix shrink clipping

Browse Source 
svn: r6125
This commit is contained in:
Matthew Flatt 2007-05-03 07:08:35 +00:00
parent d9cc602520
commit 94480ee157
1 changed files with 6 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/htdp/image.ss
View File

@ -270,8 +270,12 @@ plt/collects/tests/mzscheme/image-test.ss
[px left]
[py up]
[dc-proc (lambda (dc dx dy)
(let ([clip (send dc get-clipping-region)])
(send dc set-clipping-rect dx dy width height)
(let ([clip (send dc get-clipping-region)]
[rgn (make-object region% dc)])
(send rgn set-rectangle dx dy width height)
(when clip
(send rgn intersect clip))
(send dc set-clipping-region rgn)
(dc-proc dc (- dx delta-w) (- dy delta-h))
(send dc set-clipping-region clip)))]
[argb-proc (lambda (argb dx dy) (argb-proc argb (- dx delta-w) (- dy delta-h)))]