From 33e75ab6ec041005aebef0f3ecddfe30ed441e78 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 1 Nov 2006 23:04:12 +0000
Subject: [PATCH] use new get-argb-pixels to convert bitmap to GL

svn: r4743
---
 collects/sgl/bitmap.ss | 23 ++++++++++++-----------
 collects/sgl/doc.txt   | 12 +++++++++---
 2 files changed, 21 insertions(+), 14 deletions(-)

diff --git a/collects/sgl/bitmap.ss b/collects/sgl/bitmap.ss
index 60d998e9ae..df5ea7b4b8 100644
--- a/collects/sgl/bitmap.ss
+++ b/collects/sgl/bitmap.ss
@@ -4,7 +4,8 @@
            (lib "class.ss")
            (lib "gl-vectors.ss" "sgl")
            (prefix gl- (lib "sgl.ss" "sgl"))
-           (lib "gl.ss" "sgl"))
+           (lib "gl.ss" "sgl")
+           (lib "kw.ss"))
   
   (provide bitmap->gl-list)
   
@@ -20,22 +21,22 @@
           (loop (+ i 4))))
       rgba))
   
-  (define (bitmap->argb bmp)
+  (define (bitmap->argb bmp bmp-mask)
     (let* ((width (send bmp get-width))
            (height (send bmp get-height))
-           (argb (make-bytes (* 4 width height) 255))
-           (dc (make-object bitmap-dc% bmp)))
-      (send dc get-argb-pixels 0 0 width height argb #f)
-      (when (send bmp get-loaded-mask)
-        (send dc set-bitmap (send bmp get-loaded-mask))
-        (send dc get-argb-pixels 0 0 width height argb #t))
-      (send dc set-bitmap #f)
+           (argb (make-bytes (* 4 width height) 255)))
+      (send bmp get-argb-pixels 0 0 width height argb #f)
+      (when bmp-mask
+        (send bmp-mask get-argb-pixels 0 0 width height argb #t))
       argb))
   
-  (define (bitmap->gl-list bm with-gl)
+  (define/kw (bitmap->gl-list bm 
+                              #:key 
+                              [with-gl (lambda (f) (f))]
+                              [mask (send bm get-loaded-mask)])
     (let ([w (send bm get-width)]
           [h (send bm get-height)]
-          [rgba (argb->rgba (bitmap->argb bm))])
+          [rgba (argb->rgba (bitmap->argb bm mask))])
     (with-gl
      (lambda ()
        (let ((tex (gl-vector-ref (glGenTextures 1) 0))
diff --git a/collects/sgl/doc.txt b/collects/sgl/doc.txt
index e621681858..bbb49df824 100644
--- a/collects/sgl/doc.txt
+++ b/collects/sgl/doc.txt
@@ -277,14 +277,20 @@ _bitmap.ss_
 The "bitmap.ss" library in the "sgl" collection provides a helper
 function for converting a MrEd bitmap to a GL list:
 
-> (bitmap->gl-list bitmap with-gl-proc)
+> (bitmap->gl-list bitmap #:with-gl with-gl-proc
+                          #:mask bitmap)
 
 Converts the given bitmap (an instance of bitmap%) into a GL list that
 can be rendered with `call-list' or `glCallList'. The rendered object
 is a square on the z=0 plane with corners at (0,0) and (1,1).
 
-The given `with-gl-proc' function must accept a thunk and call it
-while the relevant GL context is selected.
+If `with-gl-proc' is provided, it must accept a thunk and call it
+while the relevant GL context is selected. Otherwise, the relevant GL
+context must be selected already.
+
+If `mask' is given, it is used as the mask bitmap (for extracting
+alpha values). The default is the result of the `get-loaded-mask'
+method of `bm'.
 
 =================================================================
 Function indexes