From 936d7347c797f5c03daaf20ae4313b35d471be32 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 13 Oct 2010 17:38:49 -0600 Subject: [PATCH] win32: fix gl canvas repaint original commit: 3d9f52a4d12bb869aecbf7e2c9dbc819344925a5 --- collects/mred/private/wx/win32/canvas.rkt | 32 +++++++++++++---------- 1 file changed, 18 insertions(+), 14 deletions(-) diff --git a/collects/mred/private/wx/win32/canvas.rkt b/collects/mred/private/wx/win32/canvas.rkt index 41a3ab78..a5aabf12 100644 --- a/collects/mred/private/wx/win32/canvas.rkt +++ b/collects/mred/private/wx/win32/canvas.rkt @@ -89,6 +89,7 @@ (define hscroll? (memq 'hscroll style)) (define vscroll? (memq 'vscroll style)) + (define for-gl? (memq 'gl style)) (define panel-hwnd (and (memq 'combo style) @@ -155,19 +156,21 @@ [(= msg WM_PAINT) (let* ([ps (malloc 128)] [hdc (BeginPaint w ps)]) - (unless (positive? paint-suspended) - (let* ([hbrush (if no-autoclear? - #f - (if transparent? - background-hbrush - (CreateSolidBrush bg-colorref)))]) - (when hbrush - (let ([r (GetClientRect canvas-hwnd)]) - (FillRect hdc r hbrush)) - (unless transparent? - (DeleteObject hbrush))) - (unless (do-backing-flush this dc hdc) - (queue-paint)))) + (if for-gl? + (queue-paint) + (unless (positive? paint-suspended) + (let* ([hbrush (if no-autoclear? + #f + (if transparent? + background-hbrush + (CreateSolidBrush bg-colorref)))]) + (when hbrush + (let ([r (GetClientRect canvas-hwnd)]) + (FillRect hdc r hbrush)) + (unless transparent? + (DeleteObject hbrush))) + (unless (do-backing-flush this dc hdc) + (queue-paint))))) (EndPaint hdc ps)) 0] [(= msg WM_NCPAINT) @@ -254,7 +257,8 @@ (define/override (refresh) (queue-paint)) (define/public (queue-backing-flush) - (InvalidateRect canvas-hwnd #f #f)) + (unless for-gl? + (InvalidateRect canvas-hwnd #f #f))) (define/public (make-compatible-bitmap w h) (send dc make-backing-bitmap w h))