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

slideshow: fix letterbox clipping by avoiding offscreen mode

Browse Source
This commit is contained in:
Matthew Flatt 2013-10-08 16:08:56 -06:00
parent 8df734048c
commit 16552e9a67
1 changed files with 11 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
pkgs/slideshow-pkgs/slideshow-lib/slideshow/viewer.rkt
View File

@ -906,7 +906,7 @@
[(equal? prefetched-page current-page) [(equal? prefetched-page current-page)
(paint-prefetch offscreen)] (paint-prefetch offscreen)]
[else [else
(paint-slide this offscreen)]) (paint-slide this offscreen #f)])
(let ([bm (send offscreen get-bitmap)]) (let ([bm (send offscreen get-bitmap)])
(send (get-dc) draw-bitmap bm 0 0))] (send (get-dc) draw-bitmap bm 0 0))]
[(equal? prefetched-page current-page) [(equal? prefetched-page current-page)
@ -1001,7 +1001,7 @@
(send dc set-brush b)))]) (send dc set-brush b)))])
(send dc set-scale 1 1))] (send dc set-scale 1 1))]
[else [else
(paint-slide this dc current-page 2/3 1 cw ch cw ch #f) (paint-slide this dc #t current-page 2/3 1 cw ch cw ch #f)
(let ([pen (send dc get-pen)] (let ([pen (send dc get-pen)]
[brush (send dc get-brush)]) [brush (send dc get-brush)])
(send dc set-pen "black" 1 'solid) (send dc set-pen "black" 1 'solid)
@ -1023,6 +1023,7 @@
(send dc draw-rectangle (* cw 2/3) 0 (* cw 1/3) ch) (send dc draw-rectangle (* cw 2/3) 0 (* cw 1/3) ch)
(paint-slide this (paint-slide this
dc dc
#t
(+ current-page 1) (+ current-page 1)
1/3 1/2 1/3 1/2
cw ch cw ch cw ch cw ch
@ -1066,11 +1067,12 @@
(define paint-slide (define paint-slide
(case-lambda (case-lambda
[(canvas dc) (paint-slide canvas dc current-page)] [(canvas dc) (paint-slide canvas dc #t current-page)]
[(canvas dc page) [(canvas dc clip?) (paint-slide canvas dc clip? current-page)]
[(canvas dc clip? page)
(let-values ([(cw ch) (send dc get-size)]) (let-values ([(cw ch) (send dc get-size)])
(paint-slide canvas dc page 1 1 cw ch config:use-screen-w config:use-screen-h #t))] (paint-slide canvas dc clip? page 1 1 cw ch config:use-screen-w config:use-screen-h #t))]
[(canvas dc page extra-scale-x extra-scale-y cw ch usw ush to-main?) [(canvas dc clip? page extra-scale-x extra-scale-y cw ch usw ush to-main?)
(let* ([slide (if (sliderec? page) (let* ([slide (if (sliderec? page)
page page
(talk-list-ref page))] (talk-list-ref page))]
@ -1085,7 +1087,7 @@
[sy (/ ush config:screen-h)] [sy (/ ush config:screen-h)]
[mx (/ (- cw usw) 2)] [mx (/ (- cw usw) 2)]
[my (/ (- ch ush) 2)]) [my (/ (- ch ush) 2)])
(define clip-rgn (paint-letterbox dc cw ch usw ush #t)) (define clip-rgn (paint-letterbox dc cw ch usw ush clip?))
(when config:smoothing? (when config:smoothing?
(send dc set-smoothing 'aligned)) (send dc set-smoothing 'aligned))
@ -1159,7 +1161,7 @@
(set! click-regions null) (set! click-regions null)
(set! interactives #hash()) (set! interactives #hash())
(set! adjust-cursor void) (set! adjust-cursor void)
(paint-slide canvas prefetch-dc n) (paint-slide canvas prefetch-dc #f n)
(set! prefetched-click-regions click-regions) (set! prefetched-click-regions click-regions)
(set! prefetched-interactives interactives) (set! prefetched-interactives interactives)
(set! click-regions old-click-regions) (set! click-regions old-click-regions)