win32: fix collecting blit

collects/mred/private/wx/win32/canvas.rkt

@@ -442,11 +442,11 @@
      
      (define/private (register-one-blit x y w h on-hbitmap off-hbitmap)
        (atomically
-        (let ([hwnd (create-gc-window canvas-hwnd x y w h)])
+        (let ([hdc (create-gc-dc canvas-hwnd)])
           (let ([r (scheme_add_gc_callback
-                    (make-gc-show-desc hwnd on-hbitmap w h)
+                    (make-gc-show-desc hdc on-hbitmap x y w h)
-                    (make-gc-hide-desc hwnd off-hbitmap w h))])
+                    (make-gc-hide-desc hdc off-hbitmap x y w h))])
-            (cons hwnd r)))))
+            (cons hdc r)))))
      
      (define/public (register-collecting-blit x y w h on off on-x on-y off-x off-y)
        (let ([on (fix-bitmap-size on w h on-x on-y)]
@@ -459,7 +459,7 @@
      (define/public (unregister-collecting-blits)
        (atomically
         (for ([r (in-list reg-blits)])
-          (DestroyWindow (car r))
+          (ReleaseDC canvas-hwnd (car r))
           (scheme_remove_gc_callback (cdr r)))
         (set! reg-blits null))))))
 

collects/mred/private/wx/win32/gcwin.rkt

@@ -7,15 +7,13 @@
 
 (provide scheme_add_gc_callback
          scheme_remove_gc_callback
-         create-gc-window
+         create-gc-dc
          make-gc-show-desc
          make-gc-hide-desc)
 
 (define-mz scheme_add_gc_callback (_fun _racket _racket -> _racket))
 (define-mz scheme_remove_gc_callback (_fun _racket -> _void))
 
-(define-user32 ShowWindow/raw _fpointer
-  #:c-id ShowWindow)
 (define-gdi32 BitBlt/raw _fpointer
   #;
   (_wfun _HDC _int _int _int _int _HDC _int _int _DWORD -> _BOOL)
@@ -29,40 +27,18 @@
 
 (define blit-hdc (CreateCompatibleDC #f))
 
-(define (create-gc-window parent-hwnd x y w h)
+(define (create-gc-dc hwnd)
-  (CreateWindowExW 0 
+  (GetDC hwnd))
-                   "PLTBlitTarget"
-                   ""
-                   (bitwise-ior WS_CHILD)
-                   x y w h
-                   parent-hwnd
-                   #f
-                   hInstance
-                   #f))
 
-(define (make-draw hwnd hbitmap w h)
+(define (make-draw hdc hbitmap x y w h)
-  (let ([hdc (GetDC hwnd)])
+  (vector
-    null
+   (vector 'osapi_ptr_ptr->void SelectObject/raw blit-hdc hbitmap)
-    (list
+   (vector 'osapi_ptr_int_int_int_int_ptr_int_int_long->void
-     (vector 'osapi_ptr_ptr->void SelectObject/raw blit-hdc hbitmap)
+           BitBlt/raw hdc x y w h blit-hdc 0 0 SRCCOPY)
-     (vector 'osapi_ptr_int_int_int_int_ptr_int_int_long->void
+   (vector 'ptr_ptr->void SelectObject/raw blit-hdc #f)))
-             BitBlt/raw hdc 0 0 w h blit-hdc 0 0 SRCCOPY)
-     (vector 'ptr_ptr->void SelectObject/raw blit-hdc #f))))
 
-(define (make-gc-show-desc hwnd hbitmap w h)
+(define (make-gc-show-desc hdc hbitmap x y w h)
-  (list->vector
+  (make-draw hdc hbitmap x y w h))
-   (append
-    (list
-     (vector 'osapi_ptr_int->void ShowWindow/raw hwnd SW_SHOW))
-    (make-draw hwnd hbitmap w h))))
-
-(define (make-gc-hide-desc hwnd hbitmap w h)
-  (list->vector
-   (append
-    ;; draw the ``off'' bitmap so it changes immediately:
-    (make-draw hwnd hbitmap w h)
-    ;; hide the window; it may take a while for the underlying canvas
-    ;; to refresh:
-    (list
-     (vector 'osapi_ptr_int->void ShowWindow/raw hwnd SW_HIDE)))))
 
+(define (make-gc-hide-desc hdc hbitmap x y w h)
+  (make-draw hdc hbitmap x y w h))

collects/mred/private/wx/win32/wndclass.rkt

@@ -58,7 +58,7 @@
 			_HWND _UINT _WPARAM _LPARAM -> _LRESULT))
 
 (define-cstruct _WNDCLASS ([style _UINT]
-			   [lpfnWndProc _WndProc]
+			   [lpfnWndProc _fpointer]
 			   [cbClsExtra _int]
 			   [cbWndExtra _int]
 			   [hInstace _HINSTANCE]
@@ -77,6 +77,8 @@
                                     -> (if r i (failed 'GetClassInfoW))))
 
 (define-user32 DefWindowProcW (_wfun _HWND _UINT _WPARAM _LPARAM -> _LRESULT))
+(define-user32 DefWindowProcW/raw _fpointer
+  #:c-id DefWindowProcW)
 
 #;(define-user32 PostQuitMessage (_wfun _int -> _void))
 
@@ -86,6 +88,8 @@
         (send wx wndproc w msg wparam lparam DefWindowProcW)
         (DefWindowProcW w msg wparam lparam))))
 
+(define wind-proc-ptr (function-ptr wind-proc _WndProc))
+
 (define hInstance (GetModuleHandleW #f))
 
 (define background-hbrush (let ([p (ptr-add #f (+ COLOR_BTNFACE 1))])
@@ -93,7 +97,7 @@
                             p))
  
 (void (RegisterClassW (make-WNDCLASS CS_OWNDC
-				     wind-proc
+				     wind-proc-ptr
 				     0
                                      0
 				     hInstance
@@ -104,7 +108,7 @@
 				     "PLTFrame")))
 
 (void (RegisterClassW (make-WNDCLASS 0 ; using CS_OWNDC creates trouble when resizing?
-				     wind-proc
+				     wind-proc-ptr
 				     0
                                      0
 				     hInstance
@@ -114,19 +118,8 @@
 				     #f ; menu
 				     "PLTCanvas")))
 
-(void (RegisterClassW (make-WNDCLASS CS_OWNDC
-                                     DefWindowProcW
-				     0
-                                     0
-				     hInstance
-				     #f
-                                     #f
-                                     #f
-				     #f
-				     "PLTBlitTarget")))
-
 (void (RegisterClassW (make-WNDCLASS 0
-				     wind-proc
+				     wind-proc-ptr
 				     0
                                      0
 				     hInstance
@@ -139,7 +132,7 @@
 (define controls-are-transparent? #f)
 
 (void (RegisterClassW (make-WNDCLASS 0
-				     wind-proc
+				     wind-proc-ptr
 				     0
                                      0
 				     hInstance