diff --git a/gui-lib/mred/private/wx/cocoa/dc.rkt b/gui-lib/mred/private/wx/cocoa/dc.rkt index e4caf96a..b381eae6 100644 --- a/gui-lib/mred/private/wx/cocoa/dc.rkt +++ b/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% - (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)))]) + (let ([g (new dc-gl-context% [gl-ctx gl-ctx])]) ;; 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 - (display-bitmap-resolution 0 (lambda () 1)))]) - (super-make-object w h trans? bs - (let ([cg (CGLayerGetContext layer)]) - (unless flipped? - (CGContextTranslateCTM cg 0 h) - (CGContextScaleCTM cg 1 -1)) - (unless (= bs 1) - (CGContextScaleCTM cg (/ 1 bs) (/ 1 bs))) - cg))) + (define bs (inexact->exact + (display-bitmap-resolution 0 (lambda () 1)))) + + (super-make-object w h trans? bs + (let ([cg (CGLayerGetContext layer)]) + (unless flipped? + (CGContextTranslateCTM cg 0 h) + (CGContextScaleCTM cg 1 -1)) + (unless (= bs 1) + (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 diff --git a/gui-lib/mred/private/wx/common/backing-dc.rkt b/gui-lib/mred/private/wx/common/backing-dc.rkt index 73304a6d..2c5f4b11 100644 --- a/gui-lib/mred/private/wx/common/backing-dc.rkt +++ b/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))