more fixes for weird draw-bitmap mask and mode combinations

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

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
clip-mask CAIRO_OPERATOR_SOURCE))]
[(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)))
;; 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)])

View File

@ -660,7 +660,9 @@
; Bitmap copying:
(when (and (not no-bitmaps?) last?)
(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
[(plt plt-mask plt^plt mred^plt)
(let* ([plt (get-plt)]
@ -711,19 +713,20 @@
mred-icon)]
[(mred~)
(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
(if (eq? mask-ex-mode 'opaque-mred^mred~)
(if (memq mask-ex-mode '(opaque-mred^mred~ opaque-red-mred^mred~))
'opaque
'solid)
(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"
"BLACK"))
(get-rotated))]
[else
;; 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)))
(let ([black (send the-color-database find-color "BLACK")]
[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 choice% #f
'("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")
hp2.5
(lambda (self event)
(send canvas set-mask-ex-mode
(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)
(send self get-selection)))))
(make-object check-box% "Kern" hp2.5