From 75de9243e4481608669885cb5a41e7d6cfef89e2 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sun, 11 May 2014 21:53:13 -0500
Subject: [PATCH] add pict->argb-pixels and argb-pixels->pict

---
 .../pict-doc/pict/scribblings/pict.scrbl      | 45 ++++++++++++++++++-
 pkgs/pict-pkgs/pict-lib/info.rkt              |  2 +
 pkgs/pict-pkgs/pict-lib/pict/main.rkt         | 15 ++++++-
 pkgs/pict-pkgs/pict-lib/pict/private/main.rkt | 18 +++++++-
 4 files changed, 75 insertions(+), 5 deletions(-)

diff --git a/pkgs/pict-pkgs/pict-doc/pict/scribblings/pict.scrbl b/pkgs/pict-pkgs/pict-doc/pict/scribblings/pict.scrbl
index 6992ca3861..ca9eb93d6e 100644
--- a/pkgs/pict-pkgs/pict-doc/pict/scribblings/pict.scrbl
+++ b/pkgs/pict-pkgs/pict-doc/pict/scribblings/pict.scrbl
@@ -959,11 +959,52 @@ Draws @racket[pict] to @racket[dc], with its top-left corner at offset
  (@racket[x], @racket[y]).}
 
 
-@defproc[(pict->bitmap [pict pict?])
+@defproc[(pict->bitmap [pict pict?] 
+                       [smoothing (or/c 'unsmoothed 'smoothed 'aligned) 'aligned])
          (is-a?/c bitmap%)]{
 
-Returns a @racket[bitmap%] with an alpha channel, no larger than @racket[pict], with @racket[pict] drawn on it in the top-left corner (@racket[0], @racket[0]).}
+Returns a @racket[bitmap%] with an alpha channel, no larger than @racket[pict],
+with @racket[pict] drawn on it in the top-left corner (@racket[0], @racket[0]).
 
+When drawing the pict into the bitmap using the smoothing mode @racket[smoothing]
+(see @method[set-smoothing dc<%>] for more information on smoothing modes).
+}
+
+@defproc[(pict->argb-pixels [pict pict?]
+                            [smoothing (or/c 'unsmoothed 'smoothed 'aligned) 'aligned])
+         bytes?]{
+Returns the @racket[bytes?] with the pixels corresponding the bitmap that @racket[pict->bitmap]
+returns. Each pixel has four bytes in the result: the alpha, red, green, and blue components.
+
+@examples[#:eval 
+          ss-eval
+          (pict->argb-pixels
+           (filled-rectangle 1 1))
+          (pict->argb-pixels
+           (colorize (filled-rectangle 1 1) "red"))]
+
+@history[#:added "1.1"]
+}
+
+@defproc[(argb-pixels->pict [bytes bytes?] [width exact-nonnegative-integer?]) pict?]{
+  Constructs a pict from @racket[bytes] with the width @racket[width]. Each pixel
+  in the resulting pict corresponds to four entries in @racket[bytes]: the alpha value,
+  and the red, green, and blue values.
+  
+ @examples[#:eval 
+          ss-eval
+          (let ([b (make-bytes (* 40 40 4) 255)])
+            (for ([x (in-range (bytes-length b))])
+              (code:comment "when in one of two vertical bands (10-20 & 30-40)")
+              (when (or (<= 10 (modulo (quotient x 4) 40) 20)
+                        (<= 30 (modulo (quotient x 4) 40) 40))
+                (code:comment "change the red and green fields of the pixel")
+                (when (= 1 (modulo x 4)) (bytes-set! b x 0))
+                (when (= 2 (modulo x 4)) (bytes-set! b x 150))))
+            (argb-pixels->pict b 40))]
+ 
+@history[#:added "1.1"]
+}
 
 @defproc[(make-pict-drawer [pict pict?])
          ((is-a?/c dc<%>) real? real? . -> . void?)]{
diff --git a/pkgs/pict-pkgs/pict-lib/info.rkt b/pkgs/pict-pkgs/pict-lib/info.rkt
index 29ba051c03..fb0736c177 100644
--- a/pkgs/pict-pkgs/pict-lib/info.rkt
+++ b/pkgs/pict-pkgs/pict-lib/info.rkt
@@ -11,3 +11,5 @@
 (define pkg-desc "implementation (no documentation) part of \"pict\"")
 
 (define pkg-authors '(mflatt robby))
+
+(define version "1.1")
diff --git a/pkgs/pict-pkgs/pict-lib/pict/main.rkt b/pkgs/pict-pkgs/pict-lib/pict/main.rkt
index 91e919a5a7..2c42d4b51e 100644
--- a/pkgs/pict-pkgs/pict-lib/pict/main.rkt
+++ b/pkgs/pict-pkgs/pict-lib/pict/main.rkt
@@ -5,11 +5,22 @@
          racket/draw)
 (provide 
  (except-out (all-from-out "private/main.rkt")
-                     pict->bitmap)
+             pict->bitmap
+             pict->argb-pixels
+             argb-pixels->pict)
  (contract-out 
   [pict->bitmap (->* (pict?)
                      ((or/c 'unsmoothed 'smoothed 'aligned))
-                     (is-a?/c bitmap%))]))
+                     (is-a?/c bitmap%))]
+  [pict->argb-pixels (->* (pict?) 
+                          ((or/c 'unsmoothed 'smoothed 'aligned))
+                          (and/c bytes? multiple-of-four-bytes?))]
+  [argb-pixels->pict (-> (and/c bytes? multiple-of-four-bytes?) 
+                         exact-nonnegative-integer?
+                         pict?)]))
+
+(define (multiple-of-four-bytes? b)
+  (zero? (modulo (bytes-length b) 4)))
   
 (require "private/play-pict.rkt")
 (provide
diff --git a/pkgs/pict-pkgs/pict-lib/pict/private/main.rkt b/pkgs/pict-pkgs/pict-lib/pict/private/main.rkt
index 8c7f0081b2..7c4c959ee4 100644
--- a/pkgs/pict-pkgs/pict-lib/pict/private/main.rkt
+++ b/pkgs/pict-pkgs/pict-lib/pict/private/main.rkt
@@ -218,6 +218,20 @@
     (send dc set-smoothing smoothing)
     (draw-pict p dc 0 0)
     bm)
+  
+  (define (pict->argb-pixels p [smoothing 'aligned])
+    (define bm (pict->bitmap p smoothing))
+    (define w (send bm get-width)) 
+    (define h (send bm get-height))
+    (define bytes (make-bytes (* w h 4)))
+    (send bm get-argb-pixels 0 0 w h bytes)
+    bytes)
+  
+  (define (argb-pixels->pict b w)
+    (define h (/ (bytes-length b) w 4))
+    (define bm (make-bitmap w (/ (bytes-length b) w 4)))
+    (send bm set-argb-pixels 0 0 w h b)
+    (bitmap bm))
 
   (provide hline vline
            frame
@@ -282,4 +296,6 @@
 
                        find-pen find-brush)
            (rename-out [fish standard-fish])
-           pict->bitmap))
+           pict->bitmap
+           pict->argb-pixels
+           argb-pixels->pict))