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

,

Browse Source 
svn: r620
This commit is contained in:
Robby Findler 2005-08-19 20:31:05 +00:00
parent c3e325f51f
commit fd7790118c
2 changed files with 65 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/lang/private/imageeq.ss
View File

@ -48,11 +48,15 @@
(= (vector-ref v1 (- i 1)) (vector-ref v2 (- i 1))))) (= (vector-ref v1 (- i 1)) (vector-ref v2 (- i 1)))))
(loop (- i 4))))))) (loop (- i 4)))))))
(define image-snip-cache (make-hash-table 'weak))
;; coerce-to-cache-image-snip : image -> (is-a?/c cache-image-snip%) ;; coerce-to-cache-image-snip : image -> (is-a?/c cache-image-snip%)
(define (coerce-to-cache-image-snip snp) (define (coerce-to-cache-image-snip snp)
(cond (cond
[(hash-table-get image-snip-cache snp (λ () #f)) => values]
[(is-a? snp image-snip%) [(is-a? snp image-snip%)
(let ([bmp (send snp get-bitmap)]) (let* ([bmp (send snp get-bitmap)]
[cis
(if bmp (if bmp
(let ([bmp-mask (or (send bmp get-loaded-mask) (let ([bmp-mask (or (send bmp get-loaded-mask)
(send snp get-bitmap-mask) (send snp get-bitmap-mask)
@ -71,7 +75,9 @@
(bitmaps->cache-image-snip bmp (bitmaps->cache-image-snip bmp
(bitmap->mask bmp) (bitmap->mask bmp)
(floor (/ w 2)) (floor (/ w 2))
(floor (/ h 2)))))))] (floor (/ h 2))))))])
(hash-table-put! image-snip-cache snp cis)
cis)]
[else snp])) [else snp]))
;; copy-bitmap : bitmap -> bitmap ;; copy-bitmap : bitmap -> bitmap