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

cache drawing in 2htdp/image snip's draw method

Browse Source
This commit is contained in:
Robby Findler 2011-01-03 15:06:41 -06:00
parent d886df2acc
commit ac52a63d4a
1 changed files with 12 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/mrlib/image-core.rkt
View File

@ -313,11 +313,22 @@ has been moved out).
(inexact->exact (ceiling (/ y scroll-step)))) (inexact->exact (ceiling (/ y scroll-step))))
(define/override (copy) (make-image shape bb normalized? pinhole)) (define/override (copy) (make-image shape bb normalized? pinhole))
(define cached-bitmap #f)
(define/override (draw dc x y left top right bottom dx dy draw-caret?) (define/override (draw dc x y left top right bottom dx dy draw-caret?)
(unless cached-bitmap
(set! cached-bitmap (make-bitmap (+ (round (bb-bottom bb)) 1)
(+ (round (bb-right bb)) 1)))
(define bdc (make-object bitmap-dc% cached-bitmap))
(send bdc erase)
(render-image this bdc 0 0)
(send bdc set-bitmap #f))
(let ([alpha (send dc get-alpha)]) (let ([alpha (send dc get-alpha)])
(when draw-caret? (when draw-caret?
(send dc set-alpha (* alpha .5))) (send dc set-alpha (* alpha .5)))
(render-image this dc x y) (send dc draw-bitmap cached-bitmap x y)
(send dc set-alpha alpha))) (send dc set-alpha alpha)))
(define/override (get-extent dc x y [w #f] [h #f] [descent #f] [space #f] [lspace #f] [rspace #f]) (define/override (get-extent dc x y [w #f] [h #f] [descent #f] [space #f] [lspace #f] [rspace #f])