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

racket/draw: add a backing-scale argument to bitmap constructors

Browse Source 
Generalizes backing-scale support created for `make-platform-bitmap`
and Mac OS X in Retina mode so that any bitmap can be created with
a backing scale (except monochrome bitmaps or bitmaps with masks).

original commit: 5e903441a4ab76305d4768ae96b9fef827bac860
This commit is contained in:
Matthew Flatt 2014-01-02 15:03:11 -07:00
parent 7a256444f2
commit 9b2b38d74d
3 changed files with 69 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/gui-pkgs/gui-lib/mred/private/wx/gtk/dc.rkt
View File

@ -45,7 +45,7 @@
(define x11-bitmap%
(class bitmap%
(init w h gdk-win)
(super-make-object (make-alternate-bitmap-kind w h))
(super-make-object (make-alternate-bitmap-kind w h 1.0))
(define pixmap (gdk_pixmap_new gdk-win
(min (max 1 w) 32000)

60
pkgs/gui-pkgs/gui-test/tests/gracket/dc.rktl
View File

@ -751,6 +751,66 @@
(test #t 'get-path-bounding-box (test-square-bounding-boxes))
;; -----------------------------------------------------------
;; Check pixel operations on a bitmap with a x2 backing scale
(let ([bm (make-bitmap 10 11 #:backing-scale 2)])
(test 2.0 'scale (send bm get-backing-scale))
(test 10 'width (send bm get-width))
(test 11 'height (send bm get-height))
(define dc (send bm make-dc))
(send dc set-pen "black" 0 'transparent)
(send dc set-brush (make-color 100 100 200) 'solid)
(send dc draw-rectangle 0 0 3 3)
(let ([s (make-bytes 4)])
(send bm get-argb-pixels 2 2 1 1 s)
(test (list 255 100 100 200) 'scaled (bytes->list s))
(send bm get-argb-pixels 4 4 1 1 s)
(test 0 'scaled (bytes-ref s 0))
(send bm get-argb-pixels 2 2 1 1 s #:unscaled? #t)
(test (list 255 100 100 200) 'unscaled (bytes->list s))
(send bm set-argb-pixels 0 0 2 1 #"\xff\x0\x0\x0\xff\x0\x0\x0"
#:unscaled? #t)
(send bm get-argb-pixels 0 0 1 1 s #:unscaled? #t)
(test (list 255 0 0 0) 'unscaled (bytes->list s))
;; scaled is average of black and blue:
(send bm get-argb-pixels 0 0 1 1 s)
(test (list 255 50 50 100) 'scaled (bytes->list s))
(send bm set-argb-pixels 0 0 2 1 #"\xff\x0\x0\x0\xff\x0\x0\x0")
(send bm get-argb-pixels 0 0 1 1 s)
(test (list 255 0 0 0) 'scaled (bytes->list s))))
(let ([p (collection-file-path "sk.jpg" "icons")])
(let ([bm1 (read-bitmap p)]
[bm2 (read-bitmap p #:backing-scale 2)])
(test 2.0 'scale (send bm2 get-backing-scale))
(test (ceiling (* 1/2 (send bm1 get-width))) 'read-width (send bm2 get-width))
(test (ceiling (* 1/2 (send bm1 get-height))) 'read-height (send bm2 get-height))))
(let ([p (collection-file-path "very-small-planet.png" "icons")])
(define-syntax-rule (test-fail rx body)
(test #t
'error
(with-handlers ([exn? (lambda (e)
(regexp-match? rx (exn-message e)))])
body
#f)))
(test-fail "mask.*backing scale" (read-bitmap p
'png/mask
#:backing-scale 2))
(test-fail "can only install a mask.*backing scale"
(send (read-bitmap p #:backing-scale 2)
set-loaded-mask
(read-bitmap p)))
(test-fail "can only load a file.*backing scale"
(send (read-bitmap p #:backing-scale 2)
load-file
p)))
;; ----------------------------------------
(report-errs)

12
pkgs/gui-pkgs/gui-test/tests/gracket/draw.rkt
View File

@ -225,6 +225,7 @@
[use-bitmap? #f]
[platform-bitmap? #f]
[compat-bitmap? #f]
[scaled-bitmap? #f]
[use-record? #f]
[serialize-record? #f]
[use-bad? #f]
@ -309,6 +310,8 @@
(make-platform-bitmap w h)]
[compat-bitmap?
(send this make-bitmap w h)]
[scaled-bitmap?
(make-bitmap w h #:backing-scale 3.0)]
[else
(make-object bitmap% w h depth-one? c-gray?)])))
#f)]
@ -1310,15 +1313,16 @@
(super-new [parent parent][style '(hscroll vscroll)])
(init-auto-scrollbars (* 2 DRAW-WIDTH) (* 2 DRAW-HEIGHT) 0 0))
vp)])
(make-object choice% #f '("Canvas" "Pixmap" "Bitmap" "Platform" "Compatible" "Record" "Serialize" "Bad") hp0
(make-object choice% #f '("Canvas" "Pixmap" "Bitmap" "Platform" "Compatible" "Backing x3" "Record" "Serialize" "Bad") hp0
(lambda (self event)
(set! use-bitmap? (< 0 (send self get-selection)))
(set! depth-one? (= 2 (send self get-selection)))
(set! platform-bitmap? (= 3 (send self get-selection)))
(set! compat-bitmap? (= 4 (send self get-selection)))
(set! use-record? (<= 5 (send self get-selection) 6))
(set! serialize-record? (= 6 (send self get-selection)))
(set! use-bad? (< 7 (send self get-selection)))
(set! scaled-bitmap? (= 5 (send self get-selection)))
(set! use-record? (<= 6 (send self get-selection) 6))
(set! serialize-record? (= 7 (send self get-selection)))
(set! use-bad? (< 8 (send self get-selection)))
(send canvas refresh)))
(make-object button% "PS" hp
(lambda (self event)