windows: revise transparent canvas refresh

This commit mostly reverts a34d169, and instead addresses the problem
with flickering by moving the timing of the erase step. The previous
approach didn't actually use a non-transparent backing store due to
the use of `get-canvas-background` in `make-backing-bitmap`. Another
key change is an extra callback to `on-backing-flush` when there's
nothing to draw.

gui-lib/mred/private/wx/common/backing-dc.rkt

@@ -77,13 +77,14 @@
 
     ;; called with a procedure that is applied to a bitmap;
     ;;  returns #f if there's nothing to flush
-    (define/public (on-backing-flush proc)
+    (define/public (on-backing-flush proc [nothing-to-draw-proc void])
       (cond
        [(not retained-cr) #f]
        [(positive? retained-counter) 
-        (unless nada?
-          (proc (or (get-recorded-command)
-                    (internal-get-bitmap))))
+        (if nada?
+	    (nothing-to-draw-proc)
+            (proc (or (get-recorded-command)
+                      (internal-get-bitmap))))
         #t]
        [else 
         (reset-backing-retained proc)

gui-lib/mred/private/wx/win32/canvas.rkt

@@ -53,11 +53,6 @@
 
 (define CB_SHOWDROPDOWN #x014F)
 
-;; Since the Win32 layer doesn't buffer windows, and since
-;; panels always have the same color, we don't actually
-;; use transparent mode
-(define transparent? #f)
-
 (define-cstruct _SCROLLINFO
   ([cbSize _UINT]
    [fMask _UINT]
@@ -105,6 +100,8 @@
      (define vscroll? (or (memq 'vscroll style)
                           (memq 'auto-vscroll style)))
      (define for-gl? (memq 'gl style))
+     (define no-autoclear? (memq 'no-autoclear style))
+     (define transparent? (memq 'transparent style))
 
      (define panel-hwnd
        (and (memq 'combo style)
@@ -200,17 +197,16 @@
                             (lambda ()
                               (let* ([hbrush (if no-autoclear?
                                                  #f
-                                                 (if transparent-ish?
+                                                 (if transparent?
                                                      background-hbrush
                                                      (CreateSolidBrush bg-colorref)))])
                                 (when hbrush
                                   (let ([r (GetClientRect canvas-hwnd)])
                                     (FillRect hdc r hbrush))
-                                  (unless transparent-ish?
+                                  (unless transparent?
                                     (DeleteObject hbrush)))))])
-                       (when transparent? (erase))
                        (unless (do-canvas-backing-flush hdc)
-                         (unless transparent? (erase))
+                         (erase)
                          (queue-paint)))))
              (EndPaint w ps)))
          0]
@@ -346,14 +342,15 @@
      (define/public (schedule-periodic-backing-flush)
        (void))
      (define/public (do-canvas-backing-flush hdc)
+       (define clear-hbrush (and transparent? background-hbrush))
        (if hdc
-           (do-backing-flush this dc hdc)
+           (do-backing-flush this dc hdc clear-hbrush)
            (if (positive? paint-suspended)
                ;; suspended => try again later
                (schedule-periodic-backing-flush)
                ;; not suspended
                (let ([hdc (GetDC canvas-hwnd)])
-                 (do-backing-flush this dc hdc)
+                 (do-backing-flush this dc hdc clear-hbrush)
                  (ReleaseDC canvas-hwnd hdc)
                  ;; We'd like to validate the region that
                  ;; we just updated, so we can potentially
@@ -384,14 +381,12 @@
             (set! suspended-refresh? #f)
             (InvalidateRect canvas-hwnd #f #f)))))
 
-     (define no-autoclear? (memq 'no-autoclear style))
-     (define transparent-ish? (memq 'transparent style))
      (define bg-col (make-object color% "white"))
      (define bg-colorref #xFFFFFF)
-     (define/public (get-canvas-background) (if transparent-ish?
+     (define/public (get-canvas-background) (if transparent?
                                                 #f
                                                 bg-col))
-     (define/public (get-canvas-background-for-backing) (if transparent-ish?
+     (define/public (get-canvas-background-for-backing) (if transparent?
 							    background-hbrush-color
 							    (and (not no-autoclear?)
 								 bg-col)))

gui-lib/mred/private/wx/win32/dc.rkt

@@ -29,6 +29,9 @@
 (define-gdi32 BitBlt (_wfun _pointer _int _int _int _int _pointer _int _int _DWORD -> _BOOL))
 (define SRCCOPY #X00cc0020)
 
+(define-user32 FillRect (_wfun _HDC _RECT-pointer _HBRUSH -> (r : _int)
+                               -> (when (zero? r) (failed 'FillRect))))
+
 (define hwnd-param (make-parameter #f))
 
 (define need-clip-text-workaround? #t)
@@ -122,7 +125,7 @@
     (define/override (cancel-delay req)
       (cancel-flush-delay req))))
 
-(define (do-backing-flush canvas dc hdc)
+(define (do-backing-flush canvas dc hdc clear-hbrush)
   (send dc on-backing-flush
         (lambda (bm)
           (let ([w (box 0)]
@@ -131,6 +134,8 @@
 	    (define sw (->screen (unbox w)))
 	    (define sh (->screen (unbox h)))
 	    (define r (make-RECT 0 0 sw sh))
+	    (when clear-hbrush
+	      (FillRect hdc r clear-hbrush))
 	    (define clip-type
 	      (if need-clip-refresh-workaround?
 		  (GetClipBox hdc r)
@@ -170,7 +175,13 @@
 		(backing-draw-bm bm cr (->normal sw) (->normal sh)
 				 0 0
 				 (->screen 1.0))
-		(cairo_destroy cr))])))))
+		(cairo_destroy cr))])))
+	(if clear-hbrush
+	    (lambda ()
+	      (define r (make-RECT 0 0 0 0))
+	      (GetClipBox hdc r)
+	      (FillRect hdc r clear-hbrush))
+	    void)))
 
 (define (request-flush-delay canvas)
   (do-request-flush-delay