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

slideshow: consistent rounding for clickbacks

Browse Source
This commit is contained in:
Matthew Flatt 2010-10-29 15:11:48 -06:00
parent f74c0de6ad
commit aa958f8986
1 changed files with 17 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
collects/slideshow/viewer.rkt
View File

@ -676,23 +676,23 @@
[y (click-region-top clicking)] [y (click-region-top clicking)]
[w (- (click-region-right clicking) (click-region-left clicking))] [w (- (click-region-right clicking) (click-region-left clicking))]
[h (- (click-region-bottom clicking) (click-region-top clicking))]) [h (- (click-region-bottom clicking) (click-region-top clicking))])
(if (or on? (let ([x (floor x)]
(not config:use-offscreen?) [y (floor y)]
(not offscreen)) [w (- (floor (+ x w)) (floor x))]
(let* ([b (send dc get-brush)] [h (- (floor (+ y h)) (floor y))])
[p (send dc get-pen)]) (if (or on?
(send dc set-pen (send the-pen-list find-or-create-pen "white" 1 'transparent)) (not config:use-offscreen?)
(send dc set-brush (send the-brush-list find-or-create-brush "black" (not offscreen))
(if config:use-offscreen? (let* ([b (send dc get-brush)]
'hilite [p (send dc get-pen)])
'xor))) (send dc set-pen (send the-pen-list find-or-create-pen "white" 1 'transparent))
(send dc draw-rectangle x y w h) (send dc set-brush (send the-brush-list find-or-create-brush "black"
(send dc set-pen p) (if config:use-offscreen?
(send dc set-brush b)) 'hilite
(let ([x (floor x)] 'xor)))
[y (floor y)] (send dc draw-rectangle x y w h)
[w (- (floor (+ x w)) (floor x))] (send dc set-pen p)
[h (- (floor (+ y h)) (floor y))]) (send dc set-brush b))
(send dc draw-bitmap-section (send dc draw-bitmap-section
(send offscreen get-bitmap) (send offscreen get-bitmap)
x y x y x y x y