From b98ba3e60b5173dec8f6ca6970592c8ab2441046 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 13 Oct 2010 21:22:20 -0600
Subject: [PATCH] win32: gl bitmaps

---
 collects/mred/private/wx/win32/dc.rkt    | 10 +++++++++-
 collects/mred/private/wx/win32/procs.rkt |  2 +-
 collects/racket/draw/cairo.rkt           |  3 +++
 3 files changed, 13 insertions(+), 2 deletions(-)

diff --git a/collects/mred/private/wx/win32/dc.rkt b/collects/mred/private/wx/win32/dc.rkt
index 9c14dc1f33..51e3fc86d7 100644
--- a/collects/mred/private/wx/win32/dc.rkt
+++ b/collects/mred/private/wx/win32/dc.rkt
@@ -21,7 +21,7 @@
 
 (define win32-bitmap%
   (class bitmap%
-    (init w h hwnd)
+    (init w h hwnd [gl-config #f])
     (super-make-object (make-alternate-bitmap-kind w h))
 
     (define s
@@ -40,6 +40,14 @@
           (cairo_paint cr)
           (cairo_destroy cr))
         s))
+    
+    (define gl (and gl-config
+                    (let ([hdc (cairo_win32_surface_get_dc s)])
+                      (set-cpointer-tag! hdc 'HDC)
+                      (create-gl-context hdc 
+                                         gl-config
+                                         #t))))
+    (define/override (get-bitmap-gl-context) gl)
 
     (define/override (ok?) #t)
     (define/override (is-color?) #t)
diff --git a/collects/mred/private/wx/win32/procs.rkt b/collects/mred/private/wx/win32/procs.rkt
index 9659eb6f03..cf34f38a5b 100644
--- a/collects/mred/private/wx/win32/procs.rkt
+++ b/collects/mred/private/wx/win32/procs.rkt
@@ -106,6 +106,6 @@
 (define/top (make-gl-bitmap [exact-positive-integer? w]
                             [exact-positive-integer? h]
                             [gl-config% c])
-  (make-object win32-bitmap% w h #f))
+  (make-object win32-bitmap% w h #f c))
 
 (define (check-for-break) #f)
diff --git a/collects/racket/draw/cairo.rkt b/collects/racket/draw/cairo.rkt
index 3886dfef6f..4501b0d457 100644
--- a/collects/racket/draw/cairo.rkt
+++ b/collects/racket/draw/cairo.rkt
@@ -79,6 +79,9 @@
   (_fun _pointer _int _int _int -> _cairo_surface_t)
   #:make-fail make-not-available
   #:wrap (allocator cairo_surface_destroy))
+(define-cairo cairo_win32_surface_get_dc
+  (_fun _cairo_surface_t -> _pointer)
+  #:make-fail make-not-available)
 
 (define-cairo cairo_create (_fun _cairo_surface_t -> _cairo_t)
   #:wrap (allocator cairo_destroy))