From 94208558793118ed2bc30b2c6f9926204eabf6f8 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 12 Apr 2013 14:39:19 -0600
Subject: [PATCH] racket/gui cocoa: delay `on-paint' if a GL context isn't
 ready

The relevant `on-paint' call is one that is forced for a GL
canvas to try to draw a frame's content before the frame is
shown. Sometimes, thread scheduling would let the frame get
sufficiently initialized at the Cocoa level before the `on-paint'
call happened, but sometimes not.
---
 collects/mred/private/wx/cocoa/canvas.rkt       | 17 +++++++++++++++++
 .../mred/private/wx/common/canvas-mixin.rkt     | 10 ++++++----
 collects/mred/private/wx/gtk/canvas.rkt         |  1 +
 collects/mred/private/wx/win32/canvas.rkt       |  1 +
 4 files changed, 25 insertions(+), 4 deletions(-)

diff --git a/collects/mred/private/wx/cocoa/canvas.rkt b/collects/mred/private/wx/cocoa/canvas.rkt
index 94667f13e1..d8461e1f7d 100644
--- a/collects/mred/private/wx/cocoa/canvas.rkt
+++ b/collects/mred/private/wx/cocoa/canvas.rkt
@@ -69,6 +69,7 @@
       (when wxb
         (let ([wx (->wx wxb)])
           (when wx
+            (send wx drawing-requested)
             (unless (send wx paint-or-queue-paint)
               (clear-background wxb)
               ;; ensure that `nextEventMatchingMask:' returns
@@ -280,6 +281,22 @@
          (cancel-flush-delay req)))
      (define/public (queue-canvas-refresh-event thunk)
        (queue-window-refresh-event this  thunk))
+     (define/public (skip-pre-paint?) 
+       (cond
+        [is-gl?
+         ;; We can't use GL on the window until it is ready,
+         ;; as indicated by a request to draw.
+         (unless drawing-requested?
+           (sync/timeout 0.1 drawing-requested-sema))
+         (not drawing-requested?)]
+        [else #f]))
+
+     (define drawing-requested? #f)
+     (define drawing-requested-sema (make-semaphore))
+     (define/public (drawing-requested) 
+       (unless drawing-requested?
+         (set! drawing-requested? #t)
+         (semaphore-post drawing-requested-sema)))
 
      (define/public (paint-or-queue-paint)
        (cond
diff --git a/collects/mred/private/wx/common/canvas-mixin.rkt b/collects/mred/private/wx/common/canvas-mixin.rkt
index 9be983b877..35f1af866b 100644
--- a/collects/mred/private/wx/common/canvas-mixin.rkt
+++ b/collects/mred/private/wx/common/canvas-mixin.rkt
@@ -125,7 +125,8 @@
              on-paint
              queue-backing-flush
              get-dc
-             get-canvas-background-for-backing)
+             get-canvas-background-for-backing
+             skip-pre-paint?)
     
     ;; Avoid multiple queued paints, and also allow cancel
     ;; of queued paint:
@@ -169,9 +170,10 @@
         (cancel-canvas-flush-delay req)))
 
     (define/override (paint-children)
-      (when (or paint-queued
-                (not (send (get-dc) can-backing-flush?)))
-        (do-on-paint #f #f)))
+      (unless (skip-pre-paint?)
+        (when (or paint-queued
+                  (not (send (get-dc) can-backing-flush?)))
+          (do-on-paint #f #f))))
 
 
     (define flush-box #f)
diff --git a/collects/mred/private/wx/gtk/canvas.rkt b/collects/mred/private/wx/gtk/canvas.rkt
index 7e950fe31e..4e78feb530 100644
--- a/collects/mred/private/wx/gtk/canvas.rkt
+++ b/collects/mred/private/wx/gtk/canvas.rkt
@@ -454,6 +454,7 @@
        (cancel-flush-delay req))
      (define/public (queue-canvas-refresh-event thunk)
        (queue-window-refresh-event this thunk))
+     (define/public (skip-pre-paint?) #f)
 
      (define/public (paint-or-queue-paint)
        ;; in atomic mode
diff --git a/collects/mred/private/wx/win32/canvas.rkt b/collects/mred/private/wx/win32/canvas.rkt
index 8816f3c677..ec089a85fb 100644
--- a/collects/mred/private/wx/win32/canvas.rkt
+++ b/collects/mred/private/wx/win32/canvas.rkt
@@ -299,6 +299,7 @@
        (cancel-flush-delay req))
      (define/public (queue-canvas-refresh-event thunk)
        (queue-window-refresh-event this thunk))
+     (define/public (skip-pre-paint?) #f)
 
      (define/public (get-flush-window) canvas-hwnd)