From d5024f0f20e077621e7ecf34a4d498c6bcd59698 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 8 Aug 2012 09:51:49 -0600 Subject: [PATCH] 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. --- .../mred/private/wx/common/backing-dc.rkt | 6 ++- collects/mred/private/wx/win32/dc.rkt | 46 +++++++++++++++++-- 2 files changed, 46 insertions(+), 6 deletions(-) diff --git a/collects/mred/private/wx/common/backing-dc.rkt b/collects/mred/private/wx/common/backing-dc.rkt index f6874c4c26..655da62df5 100644 --- a/collects/mred/private/wx/common/backing-dc.rkt +++ b/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) diff --git a/collects/mred/private/wx/win32/dc.rkt b/collects/mred/private/wx/win32/dc.rkt index ccc9549956..47de6fbea0 100644 --- a/collects/mred/private/wx/win32/dc.rkt +++ b/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)] - [cr (cairo_create surface)]) - (cairo_surface_destroy surface) - (backing-draw-bm bm cr (unbox w) (unbox h)) - (cairo_destroy cr)))))) + (define r (make-RECT 0 0 (unbox w) (unbox h))) + (define clip-type + (if win64? + (GetClipBox hdc r) + 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