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

added un/cache-image, a function that enables/disables the drawing cache in 2htdp/image images

Browse Source
This commit is contained in:
Robby Findler 2011-01-06 12:32:09 -06:00
parent b77847904e
commit 670d58d134
2 changed files with 34 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -78,7 +78,13 @@ has been moved out).
(is-a? p image-snip%) (is-a? p image-snip%)
(is-a? p bitmap%))) (is-a? p bitmap%)))
(define (un/cache-image img bitmap-cache?)
(unless (image? img)
(error 'un/cache-image "expected an image as the first argument, got ~e" img))
(define res (send img copy))
(send res set-use-bitmap-cache?! (and bitmap-cache? #t))
res)
;; a shape is either: ;; a shape is either:
;; ;;
;; - (make-overlay shape shape) ;; - (make-overlay shape shape)
@ -226,7 +232,9 @@ has been moved out).
(begin0 (begin0
(send bdc get-bitmap) (send bdc get-bitmap)
(send bdc set-bitmap #f)))) (send bdc set-bitmap #f))))
(define-local-member-name set-use-bitmap-cache?!)
(define image% (define image%
(class* snip% (png-convertible<%> image<%>) (class* snip% (png-convertible<%> image<%>)
(init-field shape bb normalized? pinhole) (init-field shape bb normalized? pinhole)
@ -315,20 +323,29 @@ has been moved out).
(define/override (copy) (make-image shape bb normalized? pinhole)) (define/override (copy) (make-image shape bb normalized? pinhole))
(define cached-bitmap #f) (define cached-bitmap #f)
(define use-cached-bitmap? #t)
(define/public (set-use-bitmap-cache?! u-b-c?)
(set! use-cached-bitmap? u-b-c?)
(unless use-cached-bitmap?
(set! 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 (when use-cached-bitmap?
(set! cached-bitmap (make-bitmap (+ (inexact->exact (round (bb-right bb))) 1) (unless cached-bitmap
(+ (inexact->exact (round (bb-bottom bb))) 1))) (set! cached-bitmap (make-bitmap (+ (inexact->exact (round (bb-right bb))) 1)
(define bdc (make-object bitmap-dc% cached-bitmap)) (+ (inexact->exact (round (bb-bottom bb))) 1)))
(send bdc erase) (define bdc (make-object bitmap-dc% cached-bitmap))
(render-image this bdc 0 0) (send bdc erase)
(send bdc set-bitmap #f)) (render-image this bdc 0 0)
(send bdc set-bitmap #f)))
(let ([alpha (send dc get-alpha)]) (let ([alpha (send dc get-alpha)])
(when (pair? draw-caret) (when (pair? draw-caret)
(send dc set-alpha (* alpha .5))) (send dc set-alpha (* alpha .5)))
(send dc draw-bitmap cached-bitmap x y) (if use-cached-bitmap?
(send dc draw-bitmap cached-bitmap x y)
(render-image this dc 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])
@ -1164,6 +1181,8 @@ the mask bitmap and the original bitmap are all together in a single bytes!
(provide make-image image-shape image-bb image-normalized? image% (provide make-image image-shape image-bb image-normalized? image%
un/cache-image
(struct-out bb) (struct-out bb)
(struct-out point) (struct-out point)

5
collects/mrlib/scribblings/image-core.scrbl
View File

@ -21,4 +21,9 @@ up an image.
@defproc[(image? [v any/c]) boolean?]{ @defproc[(image? [v any/c]) boolean?]{
Recognizes the images that library handles. Recognizes the images that library handles.
}
@defproc[(un/cache-image [image image?] [b any/c]) image?]{
Returns an image that either caches its drawing in the
snip @method[snip% draw] method or doesn't, depending on @racket[b].
} }