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

another fix to drawing a color bitmap to a monochrome target

Browse Source
This commit is contained in:
Matthew Flatt 2010-12-17 05:29:50 -07:00
parent d2fb0b8f7d
commit 98f6415c59
2 changed files with 71 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -713,6 +713,7 @@
(put (send (bitmap-to-b&w-bitmap (put (send (bitmap-to-b&w-bitmap
st 0 0 st 0 0
(send st get-width) (send st get-height) mode col (send st get-width) (send st get-height) mode col
#f
#f) #f)
get-cairo-surface))] get-cairo-surface))]
[(and (send st is-color?) [(and (send st is-color?)
@ -1475,21 +1476,23 @@
(or (send src is-color?) (or (send src is-color?)
mask)) mask))
;; Need to ensure that the result is still B&W ;; Need to ensure that the result is still B&W
(let* ([tmp-bm (bitmap-to-b&w-bitmap src src-x src-y src-w src-h style color mask)]) (let-values ([(tmp-bm tmp-mask) (bitmap-to-b&w-bitmap src src-x src-y src-w src-h style color mask #t)])
(do-draw-bitmap-section tmp-bm dest-x dest-y 0 0 src-w src-h 0 0 'solid #f #t tmp-bm clip-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))]
[(and mask [(and mask
(or (and (not black?) (not (send src is-color?))) (or (and (not black?) (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)])
(do-draw-bitmap-section tmp-bm dest-x dest-y 0 0 src-w src-h msrc-x msrc-y 'solid #f #t mask clip-mask))] (do-draw-bitmap-section tmp-bm dest-x dest-y 0 0 src-w src-h msrc-x msrc-y 'solid #f #t mask
clip-mask #f))]
[else [else
;; Normal combination... ;; Normal combination...
(do-draw-bitmap-section src dest-x dest-y src-x src-y src-w src-h msrc-x msrc-y (do-draw-bitmap-section src dest-x dest-y src-x src-y src-w src-h msrc-x msrc-y
style color black? mask clip-mask)])))) style color black? mask clip-mask #f)]))))
(define/public (do-draw-bitmap-section src dest-x dest-y src-x src-y src-w src-h msrc-x msrc-y (define/public (do-draw-bitmap-section src dest-x dest-y src-x src-y src-w src-h msrc-x msrc-y
style color black? mask clip-mask) style color black? mask clip-mask op)
(with-cr (with-cr
(void) (void)
cr cr
@ -1532,6 +1535,7 @@
(cairo_pattern_set_matrix p m) (cairo_pattern_set_matrix p m)
;; clip to the section that we're supposed to draw: ;; clip to the section that we're supposed to draw:
(cairo_save cr) (cairo_save cr)
(when op (cairo_set_operator cr op))
(cairo_new_path cr) (cairo_new_path cr)
(cairo_rectangle cr a-dest-x a-dest-y a-dest-w a-dest-h) (cairo_rectangle cr a-dest-x a-dest-y a-dest-w a-dest-h)
(cairo_clip cr) (cairo_clip cr)
@ -1572,15 +1576,20 @@
(flush-cr))) (flush-cr)))
#t) #t)
(define/private (bitmap-to-b&w-bitmap src src-x src-y src-w src-h style color mask) (define/private (bitmap-to-b&w-bitmap src src-x src-y src-w src-h style color mask result-mask?)
(let* ([bm-w (inexact->exact (ceiling src-w))] (let* ([bm-w (inexact->exact (ceiling src-w))]
[bm-h (inexact->exact (ceiling src-h))] [bm-h (inexact->exact (ceiling src-h))]
[tmp-bm (make-object bitmap% bm-w bm-h #f #t)] [tmp-bm (make-object bitmap% bm-w bm-h #f #t)]
[tmp-mask (and result-mask?
(make-object bitmap% bm-w bm-h #f #t))]
[tmp-dc (make-object -bitmap-dc% tmp-bm)]) [tmp-dc (make-object -bitmap-dc% tmp-bm)])
(send tmp-dc set-background bg) (send tmp-dc set-background bg)
(send tmp-dc draw-bitmap-section src 0 0 src-x src-y src-w src-h style color mask) (send tmp-dc draw-bitmap-section src 0 0 src-x src-y src-w src-h style color mask)
(send tmp-dc set-bitmap #f) (send tmp-dc set-bitmap #f)
(let ([bstr (make-bytes (* bm-w bm-h 4))]) (let* ([bstr (make-bytes (* bm-w bm-h 4))]
[mask-bstr (if result-mask?
(make-bytes (* bm-w bm-h 4))
bstr)])
(send tmp-bm get-argb-pixels 0 0 bm-w bm-h bstr) (send tmp-bm get-argb-pixels 0 0 bm-w bm-h bstr)
(for ([i (in-range 0 (bytes-length bstr) 4)]) (for ([i (in-range 0 (bytes-length bstr) 4)])
(let ([v (if (= (bytes-ref bstr i) 255) (let ([v (if (= (bytes-ref bstr i) 255)
@ -1590,12 +1599,20 @@
255 255
0) 0)
255)]) 255)])
(bytes-set! bstr i (- 255 v)) (let ([old-v (bytes-ref bstr i)])
(bytes-set! bstr i (- 255 v))
(bytes-set! mask-bstr i (if (= old-v 255)
255
0)))
(bytes-set! bstr (+ i 1) v) (bytes-set! bstr (+ i 1) v)
(bytes-set! bstr (+ i 2) v) (bytes-set! bstr (+ i 2) v)
(bytes-set! bstr (+ i 3) v))) (bytes-set! bstr (+ i 3) v)))
(send tmp-bm set-argb-pixels 0 0 bm-w bm-h bstr) (send tmp-bm set-argb-pixels 0 0 bm-w bm-h bstr)
tmp-bm))) (when result-mask?
(send tmp-mask set-argb-pixels 0 0 bm-w bm-h mask-bstr))
(if result-mask?
(values tmp-bm tmp-mask)
tmp-bm))))
(define/private (bitmap-to-argb-bitmap src src-x src-y src-w src-h msrc-x msrc-y (define/private (bitmap-to-argb-bitmap src src-x src-y src-w src-h msrc-x msrc-y
style color alpha mask) style color alpha mask)

72
collects/tests/gracket/dc.rktl
View File

@ -228,59 +228,77 @@
(bytes 255 100 0 0 (bytes 255 100 0 0
255 0 0 0 255 0 0 0
255 100 0 0 255 100 0 0
255 0 0 0)) 255 255 255 255))
(send mu set-argb-pixels 0 0 2 2 (send mu set-argb-pixels 0 0 2 2
(bytes 255 0 0 0 (bytes 255 0 0 0
255 255 255 255 255 255 255 255
255 0 0 0 255 0 0 0
255 255 255 255)) 255 255 255 255))
(send u set-loaded-mask mu) (send u set-loaded-mask mu)
(define (try-draw nonce-color b&w? changed?) (define (try-draw nonce-color mode expect
(let* ((bm (make-object bitmap% 2 2 b&w?)) #:bottom? [bottom? #f])
(let* ((b&w? (not (eq? mode 'color)))
(bm (make-object bitmap% 2 2 b&w?))
(dc (make-object bitmap-dc% bm))) (dc (make-object bitmap-dc% bm)))
(send dc clear) (send dc clear)
(when (eq? mode 'black)
(send dc set-brush "black" 'solid)
(send dc draw-rectangle 0 0 2 2))
;; Check that draw-bitmap-section really uses the ;; Check that draw-bitmap-section really uses the
;; section, even in combination with a mask. ;; section, even in combination with a mask.
(send dc draw-bitmap-section u 0 0 0 0 2 1 (send dc draw-bitmap-section u
0 (if bottom? 1 0)
0 (if bottom? 1 0) 2 1
'solid nonce-color (send u get-loaded-mask)) 'solid nonce-color (send u get-loaded-mask))
(send dc set-bitmap #f) (send dc set-bitmap #f)
(let ([s (make-bytes (* 2 2 4))]) (let ([s (make-bytes (* 2 2 4))])
(send bm get-argb-pixels 0 0 2 2 s) (send bm get-argb-pixels 0 0 2 2 s)
(when b&w? (send bm get-argb-pixels 0 0 2 2 s #t)) (when b&w? (send bm get-argb-pixels 0 0 2 2 s #t))
(test (if b&w? (test expect 'masked-draw s))))
;; For b&w destination, check that the (define usual-expect (bytes 255 100 0 0
;; alpha is consistent with the drawn pixels 255 255 255 255
(bytes 255 0 0 0 255 255 255 255
0 255 255 255 255 255 255 255))
0 255 255 255 (try-draw (make-object color% "green") 'color usual-expect)
0 255 255 255) (try-draw (make-object color%) 'color usual-expect)
(if changed? (try-draw (make-object color%) 'white
(bytes 255 255 255 255 ;; For b&w destination, check that the
255 0 0 0 ;; alpha is consistent with the drawn pixels
255 255 255 255 (bytes 255 0 0 0
255 255 255 255) 0 255 255 255
(bytes 255 100 0 0 0 255 255 255
255 255 255 255 0 255 255 255))
255 255 255 255 (send mu set-argb-pixels 0 0 2 2
255 255 255 255))) (bytes 255 255 255 255
'masked-draw 255 255 255 255
s)))) 255 0 0 0
(try-draw (make-object color% "green") #f #f) 255 0 0 0))
(try-draw (make-object color%) #f #f) (try-draw (make-object color%) 'black
(try-draw (make-object color%) #t #f) #:bottom? #t
;; Another b&w destination test, this time
;; with a mask that forces black pixels to
;; white:
(bytes 255 0 0 0
255 0 0 0
255 0 0 0
0 255 255 255))
(send mu set-argb-pixels 0 0 2 2 (send mu set-argb-pixels 0 0 2 2
(bytes 255 255 255 255 (bytes 255 255 255 255
255 0 0 0 255 0 0 0
255 255 255 255 255 255 255 255
255 0 0 0)) 255 0 0 0))
(try-draw (make-object color%) #f #t) (try-draw (make-object color%) 'color
(bytes 255 255 255 255
255 0 0 0
255 255 255 255
255 255 255 255))
(let ([dc (make-object bitmap-dc% mu)]) (let ([dc (make-object bitmap-dc% mu)])
(send dc erase) (send dc erase)
(send dc set-pen "white" 1 'transparent) (send dc set-pen "white" 1 'transparent)
(send dc set-brush "black" 'solid) (send dc set-brush "black" 'solid)
(send dc draw-rectangle 0 0 1 1) (send dc draw-rectangle 0 0 1 1)
(send dc set-bitmap #f)) (send dc set-bitmap #f))
(try-draw (make-object color%) #f #f)) (try-draw (make-object color%) 'color usual-expect))
;; ---------------------------------------- ;; ----------------------------------------