rearrange dc fields to avoid undefined-checking chaperone

gui-lib/mred/private/wx/cocoa/dc.rkt

@@ -32,26 +32,19 @@
   (class backing-dc%
     (init [(cnvs canvas)]
           transparent?)
+
     (define canvas cnvs)
+    (define gl #f)
+    (define trans? transparent?)
 
     (inherit end-delay internal-get-bitmap internal-copy)
     (super-new [transparent? transparent?])
 
-    (define gl #f)
     (define/override (get-gl-context)
       (and (send canvas can-gl?)
            (let ([gl-ctx (tell (send canvas get-cocoa-content) openGLContext)])
              (or gl
-                 (let ([g (new (class gl-context%
+                 (let ([g (new dc-gl-context% [gl-ctx gl-ctx])])
-                                 (define/override (get-handle) gl-ctx)
-                                 (define/override (do-call-as-current t)
-                                   (dynamic-wind
-                                       (lambda () (tellv gl-ctx makeCurrentContext))
-                                       t
-                                       (lambda () (tellv NSOpenGLContext clearCurrentContext))))
-                                 (define/override (do-swap-buffers)
-                                   (tellv gl-ctx flushBuffer))
-                                 (super-new)))])
                    ;; By default, disable screen sync for GL flushBuffer; otherwise,
                    ;; flushBuffer can take around 10 msec depending on the timing
                    ;; of event polling, and that can be bad for examples like gears.
@@ -63,7 +56,6 @@
                    g)))))
 
     ;; Use a quartz bitmap so that text looks good:
-    (define trans? transparent?)
     (define/override (make-backing-bitmap w h) 
       (make-window-bitmap w h (send canvas get-cocoa-window) 
                           trans?
@@ -102,6 +94,20 @@
     (define/override (cancel-delay req)
       (send canvas cancel-canvas-flush-delay req))))
 
+(define dc-gl-context%
+  (class gl-context%
+    (init [(gtx gl-ctx)])
+    (define gl-ctx gtx)
+    (define/override (get-handle) gl-ctx)
+    (define/override (do-call-as-current t)
+      (dynamic-wind
+       (lambda () (tellv gl-ctx makeCurrentContext))
+       t
+       (lambda () (tellv NSOpenGLContext clearCurrentContext))))
+    (define/override (do-swap-buffers)
+      (tellv gl-ctx flushBuffer))
+    (super-new)))
+
 (define-local-member-name get-layer)
 
 (define (do-backing-flush canvas dc ctx dx dy)
@@ -167,20 +173,23 @@
     (define layer (make-layer win w h))
     (define layer-w w)
     (define layer-h h)
-    (define/public (get-layer) layer)
 
     (define is-trans? trans?)
+    (define s-bm #f)
 
-    (let ([bs (inexact->exact 
+    (define bs (inexact->exact
-               (display-bitmap-resolution 0 (lambda () 1)))])
+                (display-bitmap-resolution 0 (lambda () 1))))
-      (super-make-object w h trans? bs
+
-                         (let ([cg (CGLayerGetContext layer)])
+    (super-make-object w h trans? bs
-                           (unless flipped?
+                       (let ([cg (CGLayerGetContext layer)])
-                             (CGContextTranslateCTM cg 0 h)
+                         (unless flipped?
-                             (CGContextScaleCTM cg 1 -1))
+                           (CGContextTranslateCTM cg 0 h)
-                           (unless (= bs 1)
+                           (CGContextScaleCTM cg 1 -1))
-                             (CGContextScaleCTM cg (/ 1 bs) (/ 1 bs)))
+                         (unless (= bs 1)
-                           cg)))
+                           (CGContextScaleCTM cg (/ 1 bs) (/ 1 bs)))
+                         cg))
+
+    (define/public (get-layer) layer)
 
     (define/override (draw-bitmap-to cr sx sy dx dy w h alpha clipping-region)
       ;; Called when the destination rectangle is inside the clipping region
@@ -272,7 +281,6 @@
       (CGContextRestoreGState cg)
       (CGContextSaveGState cg))
 
-    (define s-bm #f)
     (define/override (get-cairo-surface)
       ;; Convert to a platform bitmap, which Cairo understands
       (let ([t-bm (or s-bm

gui-lib/mred/private/wx/common/backing-dc.rkt

@@ -43,6 +43,13 @@
   (class (record-dc-mixin (dc-mixin bitmap-dc-backend%))
     (init transparent?)
 
+    (define retained-cr #f)
+    (define retained-counter 0)
+    (define needs-flush? #f)
+    (define nada? #t)
+    (define flush-suspends 0)
+    (define req #f)
+
     (inherit internal-get-bitmap
              internal-set-bitmap
              reset-cr
@@ -67,11 +74,6 @@
     (define/public (queue-backing-flush)
       (void))
 
-    (define retained-cr #f)
-    (define retained-counter 0)
-    (define needs-flush? #f)
-    (define nada? #t)
-
     ;; called with a procedure that is applied to a bitmap;
     ;;  returns #f if there's nothing to flush
     (define/public (on-backing-flush proc)
@@ -147,9 +149,6 @@
       (super erase)
       (set! nada? #t))
 
-    (define flush-suspends 0)
-    (define req #f)
-
     (define/public (request-delay) (void))
     (define/public (cancel-delay req) (void))