make un/cache-image accept everything that image? accepts
I'm not sure if the precise details of how this function behaves (specifically that it copies snips that aren't cacheable) is important, but I suspect the implementation is more authoritative that the docs in this case, so document what it really does. closes PR 13956 original commit: fb91397d24551dbef0db7c40a9d12042e6c7326b
This commit is contained in:
parent
813309eb5e
commit
be8caf7ad8
|
@ -26,6 +26,11 @@ up an image.
|
|||
@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].
|
||||
|
||||
Not all @racket[image?] values have special caching capabilities;
|
||||
in those cases, this returns a copy of the value if it is a
|
||||
@racket[snip%]; otherwise it returns the value itself (if it
|
||||
isn't a @racket[snip%]).
|
||||
}
|
||||
|
||||
@defproc[(compute-image-cache [image image?]) void?]{
|
||||
|
|
|
@ -84,10 +84,17 @@ has been moved out).
|
|||
|
||||
(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)
|
||||
(raise-argument-error 'un/cache-image
|
||||
"image?"
|
||||
0
|
||||
img bitmap-cache?))
|
||||
(cond
|
||||
[(is-a? img snip%)
|
||||
(define res (send img copy))
|
||||
(when (is-a? res image%)
|
||||
(send res set-use-bitmap-cache?! (and bitmap-cache? #t)))
|
||||
res]
|
||||
[else img]))
|
||||
|
||||
(define (compute-image-cache img)
|
||||
(unless (image? img)
|
||||
|
|
10
pkgs/gui-pkgs/gui-test/mrlib/tests/image-core.rkt
Normal file
10
pkgs/gui-pkgs/gui-test/mrlib/tests/image-core.rkt
Normal file
|
@ -0,0 +1,10 @@
|
|||
#lang racket/base
|
||||
|
||||
(require rackunit
|
||||
mrlib/image-core
|
||||
(only-in racket/gui/base make-bitmap))
|
||||
|
||||
;; just check there is no error
|
||||
(check-equal? (begin (un/cache-image (make-bitmap 1 1) #t)
|
||||
(void))
|
||||
(void))
|
Loading…
Reference in New Issue
Block a user