From 905eb116517dc86a768aa0ee13d72f20364bf02f Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 17 May 2011 15:49:21 -0700
Subject: [PATCH] fix alpha-only mode of `get-argb-pixels'  Closes PR 11927

---
 collects/racket/draw/private/bitmap.rkt       |  2 +-
 .../scribblings/draw/bitmap-dc-class.scrbl    |  3 +-
 collects/tests/gracket/dc.rktl                | 28 +++++++++++++++++++
 3 files changed, 31 insertions(+), 2 deletions(-)

diff --git a/collects/racket/draw/private/bitmap.rkt b/collects/racket/draw/private/bitmap.rkt
index 1326a6baca..9da77f6fa1 100644
--- a/collects/racket/draw/private/bitmap.rkt
+++ b/collects/racket/draw/private/bitmap.rkt
@@ -718,7 +718,7 @@
         (for ([j (in-range y (min (+ y h) height))])
           (let ([row (* j row-width)])
             (for ([i (in-range x (min (+ x w) width))])
-              (let ([p (* 4 (+ i (* j w)))]
+              (let ([p (* 4 (+ (- i x) (* (- j y) w)))]
                     [q (+ row (* i 4))])
                 (bytes-set! bstr p (bytes-ref data (+ q A)))))))))
     
diff --git a/collects/scribblings/draw/bitmap-dc-class.scrbl b/collects/scribblings/draw/bitmap-dc-class.scrbl
index 4200395217..2cdc2ce061 100644
--- a/collects/scribblings/draw/bitmap-dc-class.scrbl
+++ b/collects/scribblings/draw/bitmap-dc-class.scrbl
@@ -76,7 +76,8 @@ The pixel RGB values are copied into @scheme[pixels]. The first byte
 If @scheme[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
- for each pixel, based on each pixel's inverted value. Thus, when a
+ 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.
diff --git a/collects/tests/gracket/dc.rktl b/collects/tests/gracket/dc.rktl
index 4d431e3c0d..99553be130 100644
--- a/collects/tests/gracket/dc.rktl
+++ b/collects/tests/gracket/dc.rktl
@@ -365,4 +365,32 @@
 
 ;; ----------------------------------------
 
+(let ()
+  (define (get-column-alpha bm x y)
+    (define bs (make-bytes 4))
+    (send bm get-argb-pixels x y 1 1 bs #t)
+    bs)
+  (define abm (make-object bitmap% 2 2 #f #t))
+  (define nbm (make-object bitmap% 2 2 #f #f))
+  (define (avg bstr) (- 255
+                        (quotient (+ (bytes-ref bstr 0)
+                                     (bytes-ref bstr 1)
+                                     (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")  
+
+  (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))
+  (test (bytes (char->integer #\8) 0 0 0) 'a0+1 (get-column-alpha abm 0 1))
+  (test (bytes (char->integer #\c) 0 0 0) 'a1+1 (get-column-alpha abm 1 1))
+
+  (test (bytes (avg #"123") 0 0 0) 'n0+0 (get-column-alpha nbm 0 0))
+  (test (bytes (avg #"567") 0 0 0) 'n1+0 (get-column-alpha nbm 1 0))
+  (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)))
+
+
+;; ----------------------------------------
+
 (report-errs)