win32: fix flush and periodic canvas flush

original commit: 64d9a391cfe480fd599910026294cff62cd75ca3

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

@@ -252,6 +252,11 @@
      (define/public (end-refresh-sequence)
        (send dc resume-flush))
 
+     ;; Improve this method to flush locally
+     ;; instead of globally:
+     (define/public (flush)
+       (flush-display))
+
      (define/public (on-paint) (void))
      (define/override (refresh) (queue-paint))
 
@@ -268,7 +273,8 @@
            (do-backing-flush this dc hdc)
            (let ([hdc (GetDC canvas-hwnd)])
              (do-backing-flush this dc hdc)
-             (ReleaseDC canvas-hwnd hdc))))
+             (ReleaseDC canvas-hwnd hdc)
+             (ValidateRect canvas-hwnd #f))))
 
      (define/public (make-compatible-bitmap w h)
        (send dc make-backing-bitmap w h))

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

@@ -35,7 +35,6 @@
   get-control-font-size
   get-control-font-size-in-pixels?
   cancel-quit
-  flush-display
   bell
   hide-cursor
   get-display-depth
@@ -44,6 +43,7 @@
   get-highlight-background-color
   get-highlight-text-color
   check-for-break)
+ flush-display
  fill-private-color
  play-sound
  location->window
@@ -84,7 +84,6 @@
 (define (get-control-font-face) (get-theme-font-face))
 (define (get-control-font-size) (get-theme-font-size))
 (define (get-control-font-size-in-pixels?) #t)
-(define (flush-display) (void))
 
 (define-user32 MessageBeep (_wfun _UINT -> _BOOL))
 (define (bell)

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

@@ -36,6 +36,7 @@
               GetDC
               ReleaseDC
               InvalidateRect
+              ValidateRect
               GetMenuState
               CheckMenuItem
               ModifyMenuW
@@ -121,6 +122,8 @@
 
 (define-user32 InvalidateRect (_wfun _HWND (_or-null _RECT-pointer) _BOOL -> (r : _BOOL)
                                      -> (unless r (failed 'InvalidateRect))))
+(define-user32 ValidateRect (_wfun _HWND (_or-null _RECT-pointer) -> (r : _BOOL)
+                                   -> (unless r (failed 'ValidateRect))))
 
 (define-user32 GetMenuState (_wfun _HMENU _UINT _UINT -> _UINT))
 (define-user32 CheckMenuItem (_wfun _HMENU _UINT _UINT -> _DWORD))

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

@@ -24,6 +24,7 @@
               queue-window-event
               queue-window-refresh-event
               location->window
+              flush-display
 
               GetWindowRect
               GetClientRect))
@@ -701,3 +702,7 @@
            (or (let ([wx (any-hwnd->wx hwnd)])
                  (and wx (send wx get-top-frame)))
                (loop (GetParent hwnd)))))))
+
+(define (flush-display)
+  (atomically
+   (pre-event-sync #t)))