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

more fixes for weird draw-bitmap mask and mode combinations

Browse Source
This commit is contained in:
Matthew Flatt 2010-12-17 05:51:23 -07:00
parent 98f6415c59
commit 4195cf3297
2 changed files with 13 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/racket/draw/private/dc.rkt
View File

@ -1480,7 +1480,8 @@
(do-draw-bitmap-section tmp-bm dest-x dest-y 0 0 src-w src-h 0 0 'solid #f #t tmp-mask (do-draw-bitmap-section tmp-bm dest-x dest-y 0 0 src-w src-h 0 0 'solid #f #t tmp-mask
clip-mask CAIRO_OPERATOR_SOURCE))] clip-mask CAIRO_OPERATOR_SOURCE))]
[(and mask [(and mask
(or (and (not black?) (not (send src is-color?))) (or (and (or (not black?) (eq? style 'opaque))
(not (send src is-color?)))
(alpha . < . 1.0))) (alpha . < . 1.0)))
;; mask plus color or alpha with a color bitmap ;; mask plus color or alpha with a color bitmap
(let ([tmp-bm (bitmap-to-argb-bitmap src src-x src-y src-w src-h 0 0 style color alpha #f)]) (let ([tmp-bm (bitmap-to-argb-bitmap src src-x src-y src-w src-h 0 0 style color alpha #f)])

18
collects/tests/gracket/draw.rkt
View File

@ -660,7 +660,9 @@
; Bitmap copying: ; Bitmap copying:
(when (and (not no-bitmaps?) last?) (when (and (not no-bitmaps?) last?)
(let ([x 5] [y 165]) (let ([x 5] [y 165])
(let ([mred-icon (get-icon)]) (let ([bg (send dc get-background)]
[mred-icon (get-icon)])
(send dc set-background "YELLOW")
(case mask-ex-mode (case mask-ex-mode
[(plt plt-mask plt^plt mred^plt) [(plt plt-mask plt^plt mred^plt)
(let* ([plt (get-plt)] (let* ([plt (get-plt)]
@ -711,19 +713,20 @@
mred-icon)] mred-icon)]
[(mred~) [(mred~)
(send dc draw-bitmap (get-rotated) x y 'opaque)] (send dc draw-bitmap (get-rotated) x y 'opaque)]
[(mred^mred~ opaque-mred^mred~ red-mred^mred~) [(mred^mred~ opaque-mred^mred~ red-mred^mred~ opaque-red-mred^mred~)
(send dc draw-bitmap mred-icon x y (send dc draw-bitmap mred-icon x y
(if (eq? mask-ex-mode 'opaque-mred^mred~) (if (memq mask-ex-mode '(opaque-mred^mred~ opaque-red-mred^mred~))
'opaque 'opaque
'solid) 'solid)
(send the-color-database find-color (send the-color-database find-color
(if (eq? mask-ex-mode 'red-mred^mred~) (if (memq mask-ex-mode '(red-mred^mred~ opaque-red-mred^mred~))
"RED" "RED"
"BLACK")) "BLACK"))
(get-rotated))] (get-rotated))]
[else [else
;; simple draw ;; simple draw
(send dc draw-bitmap mred-icon x y 'xor)])) (send dc draw-bitmap mred-icon x y 'xor)])
(send dc set-background bg))
(set! x (+ x (send (get-icon) get-width))) (set! x (+ x (send (get-icon) get-width)))
(let ([black (send the-color-database find-color "BLACK")] (let ([black (send the-color-database find-color "BLACK")]
[red (send the-color-database find-color "RED")] [red (send the-color-database find-color "RED")]
@ -1191,13 +1194,14 @@
(make-object button% "Clock" hp2.5 (lambda (b e) (do-clock #f))) (make-object button% "Clock" hp2.5 (lambda (b e) (do-clock #f)))
(make-object choice% #f (make-object choice% #f
'("MrEd XOR" "PLT Middle" "PLT ^ MrEd" "MrEd ^ PLT" "MrEd ^ MrEd" '("MrEd XOR" "PLT Middle" "PLT ^ MrEd" "MrEd ^ PLT" "MrEd ^ MrEd"
"MrEd~" "MrEd ^ MrEd~" "M^M~ Opaque" "M^M~ Red" "MrEd~ Opaque" "MrEd ^ MrEd~" "M^M~ Opaque" "M^M~ Red" "M^M~ Rd Opq"
"PLT^PLT") "PLT^PLT")
hp2.5 hp2.5
(lambda (self event) (lambda (self event)
(send canvas set-mask-ex-mode (send canvas set-mask-ex-mode
(list-ref '(mred plt plt-mask mred^plt mred^mred (list-ref '(mred plt plt-mask mred^plt mred^mred
mred~ mred^mred~ opaque-mred^mred~ red-mred^mred~ mred~ mred^mred~ opaque-mred^mred~
red-mred^mred~ opaque-red-mred^mred~
plt^plt) plt^plt)
(send self get-selection))))) (send self get-selection)))))
(make-object check-box% "Kern" hp2.5 (make-object check-box% "Kern" hp2.5