win64 racket/gui: another work around for Cairo clipping issues

Cairo doesn't seem to deal correctly with an HDC produced
by BeginPaint() that has a clipping region. The problem affects
only Win64. Work around the problem by drawing to a separate
HDC and copying to/from the screen. (To see the problem before
this patch, draw the DrRacket window to the edge of the screen
and back, and observe tha the toolbar doesn't update correctly.)

This change could affect performance, but it should mostly
be limited to refresh when a window moves.

collects/mred/private/wx/common/backing-dc.rkt

@@ -200,14 +200,18 @@
                     (cairo_rectangle cr 0 0 w h)
                     (cairo_clip cr))))))
 
-(define (backing-draw-bm bm cr w h)
+(define (backing-draw-bm bm cr w h [dx 0] [dy 0])
   (if (procedure? bm)
       (begin
         (send cairo-dc reset-config)
         (send cairo-dc set-cr cr w h)
+	(unless (and (zero? dx) (zero? dy))
+	  (send cairo-dc translate dx dy))
         (bm cairo-dc)
         (send cairo-dc set-cr #f 0 0))
       (let ([s (cairo_get_source cr)])
+	(unless (and (zero? dx) (zero? dy))
+	  (cairo_translate cr dx dy))
         (cairo_pattern_reference s)
         (cairo_set_source_surface cr (send bm get-cairo-surface) 0 0)
         (cairo_new_path cr)

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

@@ -23,6 +23,12 @@
 
 (define-gdi32 SelectClipRgn (_wfun _pointer _pointer -> _int))
 
+(define-gdi32 GetClipBox (_wfun _pointer _RECT-pointer -> _int))
+(define SIMPLEREGION 2)
+
+(define-gdi32 BitBlt (_wfun _pointer _int _int _int _int _pointer _int _int _DWORD -> _BOOL))
+(define SRCCOPY #X00cc0020)
+
 (define hwnd-param (make-parameter #f))
 
 (define win32-bitmap%
@@ -119,11 +125,41 @@
           (let ([w (box 0)]
                 [h (box 0)])
             (send canvas get-client-size w h)
-            (let* ([surface (cairo_win32_surface_create hdc)]
+	    (define r (make-RECT 0 0 (unbox w) (unbox h)))
-                   [cr (cairo_create surface)])
+	    (define clip-type
-              (cairo_surface_destroy surface)
+	      (if win64?
-              (backing-draw-bm bm cr (unbox w) (unbox h))
+		  (GetClipBox hdc r)
-              (cairo_destroy cr))))))
+		  SIMPLEREGION))
+	    (cond
+	     [(and win64?
+		   (not (and (= clip-type SIMPLEREGION)
+			     (= (RECT-left r) 0)
+			     (= (RECT-top r) 0)
+			     (= (RECT-right r) (unbox w))
+			     (= (RECT-bottom r) (unbox h)))))
+	      ;; Another workaround: a clipping region installed by BeginPaint()
+	      ;; seems to interfere with Cairo drawing. So, draw to a
+	      ;; fresh context and copy back and forth using Win32.
+	      (define cw (- (RECT-right r) (RECT-left r)))
+	      (define ch (- (RECT-bottom r) (RECT-top r)))
+	      (let* ([surface (cairo_win32_surface_create_with_ddb hdc
+								   CAIRO_FORMAT_RGB24
+								   cw
+								   ch)]
+		     [cr (cairo_create surface)]
+		     [hdc2 (cairo_win32_surface_get_dc surface)])
+		(BitBlt hdc2 0 0 cw ch hdc (RECT-left r) (RECT-top r) SRCCOPY)
+		(backing-draw-bm bm cr (unbox w) (unbox h) (- (RECT-left r)) (- (RECT-top r)))
+		(cairo_surface_flush surface)
+		(BitBlt hdc (RECT-left r) (RECT-top r) cw ch hdc2 0 0 SRCCOPY)
+		(cairo_surface_destroy surface)
+		(cairo_destroy cr))]
+	     [else
+	      (let* ([surface (cairo_win32_surface_create hdc)]
+		     [cr (cairo_create surface)])
+		(cairo_surface_destroy surface)
+		(backing-draw-bm bm cr (unbox w) (unbox h))
+		(cairo_destroy cr))])))))
 
 (define (request-flush-delay canvas)
   (do-request-flush-delay