rearrange dc fields to avoid undefined-checking chaperone
This commit is contained in:
parent
6b9cd9fa9c
commit
2ab1fb319a
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user