add pre-multiplied mode for `{get,set}-argb-pixels'

collects/racket/draw/private/bitmap-dc.rkt

@@ -132,20 +132,22 @@
                                  [exact-nonnegative-integer? w]
                                  [exact-nonnegative-integer? h]
                                  [bytes? bstr]
-                                 [any? [set-alpha? #f]])
+                                 [any? [set-alpha? #f]]
+                                 [any? [pre-mult? #f]])
       (let ([bm (internal-get-bitmap)])
         (when bm
-          (send bm set-argb-pixels x y w h bstr set-alpha?))))
+          (send bm set-argb-pixels x y w h bstr set-alpha? pre-mult?))))
 
     (def/public (get-argb-pixels [exact-nonnegative-integer? x]
                                  [exact-nonnegative-integer? y]
                                  [exact-nonnegative-integer? w]
                                  [exact-nonnegative-integer? h]
                                  [bytes? bstr]
-                                 [any? [get-alpha? #f]])
+                                 [any? [get-alpha? #f]]
+                                 [any? [pre-mult? #f]])
       (let ([bm (internal-get-bitmap)])
         (when bm
-          (send bm get-argb-pixels x y w h bstr get-alpha?))))
+          (send bm get-argb-pixels x y w h bstr get-alpha? pre-mult?))))
 
     (def/public (draw-bitmap-section-smooth [bitmap% src]
                                             [real? dest-x]

collects/racket/draw/private/bitmap.rkt

@@ -572,7 +572,8 @@
                                  [exact-nonnegative-integer? w]
                                  [exact-nonnegative-integer? h]
                                  [bytes? bstr]
-                                 [any? [get-alpha? #f]])
+                                 [any? [get-alpha? #f]]
+                                 [any? [pre-mult? #f]])
       (unless ((bytes-length bstr) . >=  . (* w h 4))
         (raise-mismatch-error (method-name 'bitmap% 'get-argb-pixels)
                               "byte string is too short: "
@@ -581,10 +582,10 @@
         (if alt?
             (call-with-alt-bitmap
              x y w h 
-             (lambda (bm) (send bm get-argb-pixels 0 0 w h bstr get-alpha?)))
+             (lambda (bm) (send bm get-argb-pixels 0 0 w h bstr get-alpha? pre-mult?)))
-            (do-get-argb-pixels x y w h bstr get-alpha?))))
+            (do-get-argb-pixels x y w h bstr get-alpha? pre-mult?))))
 
-    (define/private (do-get-argb-pixels x y w h bstr get-alpha?)
+    (define/private (do-get-argb-pixels x y w h bstr get-alpha? pre-mult?)
       ;; Fill range that is beyond edge of picture:
       (if get-alpha?
           (for* ([i (in-range width (+ x w))]
@@ -603,7 +604,7 @@
           (cairo_surface_flush s)
           (let ([data (cairo_image_surface_get_data s)]
                 [row-width (cairo_image_surface_get_stride s)]
-                [use-alpha? (or alpha-channel? b&w?)]
+                [use-alpha? (or (and alpha-channel? (not pre-mult?)) b&w?)]
                 [set-alpha? alpha-channel?])
             (let ([w2 (+ x (min (- width x) w))])
               (for* ([j (in-range y (min (+ y h) height))])
@@ -652,7 +653,8 @@
                                  [exact-nonnegative-integer? w]
                                  [exact-nonnegative-integer? h]
                                  [bytes? bstr]
-                                 [any? [set-alpha? #f]])
+                                 [any? [set-alpha? #f]]
+                                 [any? [pre-mult? #f]])
       (unless ((bytes-length bstr) . >=  . (* w h 4))
         (raise-mismatch-error (method-name 'bitmap% 'set-argb-pixels)
                               "byte string is too short: "
@@ -687,7 +689,9 @@
                             (if alpha-channel?
                                 (let ([a (bytes-ref bstr pi)]
                                       [pm (lambda (a v)
-                                            (quotient (* a v) 255))])
+                                            (if pre-mult?
+                                                (min a v)
+                                                (quotient (* a v) 255)))])
                                   (bytes-set! data (+ ri A) a)
                                   (bytes-set! data (+ ri R) (pm a (bytes-ref bstr (+ pi 1))))
                                   (bytes-set! data (+ ri G) (pm a (bytes-ref bstr (+ pi 2))))

collects/scribblings/draw/bitmap-class.scrbl

@@ -63,7 +63,8 @@ When a @scheme[bits] byte string is provided: Creates a monochrome
                             [width exact-nonnegative-integer?]
                             [height exact-nonnegative-integer?]
                             [pixels (and/c bytes? mutable?)]
-                            [alpha? any/c #f])
+                            [just-alpha? any/c #f]
+                            [pre-multiplied? any/c #f])
            void?]{
 
 Produces the same result as @xmethod[bitmap-dc% get-argb-pixels], but the
@@ -264,7 +265,8 @@ A monochrome bitmap saved as @scheme['png] without a mask bitmap
                             [width exact-nonnegative-integer?]
                             [height exact-nonnegative-integer?]
                             [pixels bytes?]
-                            [alpha? any/c #f])
+                            [just-alpha? any/c #f]
+                            [pre-multiplied? any/c #f])
            void?]{
 
 The same as @xmethod[bitmap-dc% set-argb-pixels], but the

collects/scribblings/draw/bitmap-dc-class.scrbl

@@ -54,7 +54,8 @@ In older versions, this method smoothed drawing more than
                             [width exact-nonnegative-integer?]
                             [height exact-nonnegative-integer?]
                             [pixels (and/c bytes? (not/c immutable?))]
-                            [alpha? any/c #f])
+                            [just-alpha? any/c #f]
+                            [pre-multiplied? any/c #f])
            void?]{
 
 Gets a rectangle of pixels in the bitmap, subject to the same rules
@@ -73,15 +74,20 @@ The pixel RGB values are copied into @scheme[pixels]. The first byte
  DC. The pixels are in row-major order, left to right then top to
  bottom.
 
-If @scheme[alpha?] is false, if the bitmap does not have an alpha
+If @scheme[just-alpha?] is false, if the bitmap does not have an alpha
  channel, then the alpha value for each pixel is set to 255. If
- @scheme[alpha?] is true, then @italic{only} the alpha value is set
+ @scheme[just-alpha?] is true, then @italic{only} the alpha value is set
  for each pixel; if the bitmap has no alpha channel, then the alpha
  value is based on each pixel's inverted RGB average. Thus, when a
  bitmap has a separate mask bitmap, the same @scheme[pixels] byte
  string is in general filled from two bitmaps: one (the main image)
  for the pixel values and one (the mask) for the alpha values.
 
+If @racket[pre-multiplied?] is true, @scheme[just-alpha?] is false,
+ and the bitmap has an alpha channel, then RGB values in the result
+ are scaled by the corresponding alpha value (i.e., multiplied by the
+ alpha value and then divided by 255).
+
 }
 
 @defmethod[(get-bitmap)
@@ -110,7 +116,8 @@ result is @scheme[#f].
                             [width exact-nonnegative-integer?]
                             [height exact-nonnegative-integer?]
                             [pixels bytes?]
-                            [alpha? any/c #f])
+                            [just-alpha? any/c #f]
+                            [pre-multiplied? any/c #f])
            void?]{
 
 
@@ -126,8 +133,9 @@ The pixel RGB values are taken from @scheme[pixels]. The first byte
  determine the new pixel values in the DC. The pixels are in row-major
  order, left to right then top to bottom.
 
-If @scheme[alpha?] is false, then the alpha value for each pixel is
+If @scheme[just-alpha?] is false, then the alpha value for each pixel is
- used only if the DC's current bitmap has an alpha channel. If @scheme[alpha?] is true, then each
+ used only if the DC's current bitmap has an alpha channel. If 
+ @scheme[just-alpha?] is true and the bitmap has no alpha channel, then each
  pixel is set based @italic{only} on the alpha value, but inverted to serve
  as a mask. Thus, when working with bitmaps that have an associated mask
  bitmap instead of an alpha channel, the same
@@ -135,6 +143,14 @@ If @scheme[alpha?] is false, then the alpha value for each pixel is
  (the main image) for the pixel values and one (the mask) for the
  alpha values.
 
+If @racket[pre-multiplied?] is true, @scheme[just-alpha?] is false,
+ and the bitmap has an alpha channel, then RGB values in
+ @racket[pixels] are interpreted as scaled by the corresponding alpha value
+ (i.e., multiplied by the alpha value and then divided by 255). If an
+ R, G, or B value is greater than its corresponding alpha value (which
+ is not possible if the value is properly scaled), then it is effectively 
+ reduced to the alpha value.
+
 }
 
 @defmethod[(set-bitmap [bitmap (or/c (is-a?/c bitmap%) false/c)])

collects/tests/gracket/dc.rktl

@@ -364,6 +364,7 @@
   (mk #"\377\377\377\377\377\377\377\377\377\0\0\0\377\0\0\0" 'opaque black white #t))
 
 ;; ----------------------------------------
+;; check get-alpha mode of `get-argb-pixels'
 
 (let ()
   (define (get-column-alpha bm x y)
@@ -378,7 +379,7 @@
                                      (bytes-ref bstr 2))
                                   3)))
   (send abm set-argb-pixels 0 0 2 2 #"0123456789abcdef")
-  (send nbm set-argb-pixels 0 0 2 2 #"0123456789abcdef")  
+  (send nbm set-argb-pixels 0 0 2 2 #"0123456789abcdef") ; alphas ignored
 
   (test (bytes (char->integer #\0) 0 0 0) 'a0+0 (get-column-alpha abm 0 0))
   (test (bytes (char->integer #\4) 0 0 0) 'a1+0 (get-column-alpha abm 1 0))
@@ -390,6 +391,34 @@
   (test (bytes (avg #"9ab") 0 0 0) 'n0+1 (get-column-alpha nbm 0 1))
   (test (bytes (avg #"def") 0 0 0) 'n1+1 (get-column-alpha nbm 1 1)))
 
+;; ----------------------------------------
+;; check pre-mult mode of `{get,set}-argb-pixels'
+
+(let ()
+  (define abm (make-object bitmap% 2 2 #f #t))
+  (define nbm (make-object bitmap% 2 2 #f #f))
+  (send abm set-argb-pixels 0 0 2 2 #"30127456b89afcde" #f #t)
+  (send nbm set-argb-pixels 0 0 2 2 #"0123456789abcdef" #f #t) ; alphas ignored
+
+  (define (get-pixels bm pre-mult?)
+    (define bs (make-bytes 16))
+    (send bm get-argb-pixels 0 0 2 2 bs #f pre-mult?)
+    bs)
+
+  (define (unmul b)
+    (define (um v) (quotient (* v 255) (bytes-ref b 0)))
+    (bytes (bytes-ref b 0)
+           (um (bytes-ref b 1))
+           (um (bytes-ref b 2))
+           (um (bytes-ref b 3))))
+
+  (test #"\xFF123\xFF567\xFF9ab\xFFdef" 'no-alpha (get-pixels nbm #f))
+  (test #"\xFF123\xFF567\xFF9ab\xFFdef" 'no-alpha (get-pixels nbm #t))
+
+  (test (apply bytes-append (map unmul '(#"3012" #"7456" #"b89a" #"fcde")))
+        'alpha-normal (get-pixels abm #f))
+  (test #"30127456b89afcde" 'alpha-premult (get-pixels abm #t)))
+
 
 ;; ----------------------------------------