From 4e23681799fe70886e63fd872ece648c4d18d952 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 9 Sep 2010 14:03:29 -0600 Subject: [PATCH] still again yet another refinement to cocoa refresh original commit: 748115fe91205e5df2128d8ea4f12b7ec8fa5076 --- collects/mred/private/wx/cocoa/canvas.rkt | 1 + collects/mred/private/wx/cocoa/cg.rkt | 20 ++++++++++++++++++ collects/mred/private/wx/cocoa/dc.rkt | 25 +++-------------------- collects/mred/private/wx/cocoa/window.rkt | 6 +++++- collects/mred/private/wx/common/queue.rkt | 19 +++++++++-------- 5 files changed, 40 insertions(+), 31 deletions(-) create mode 100644 collects/mred/private/wx/cocoa/cg.rkt diff --git a/collects/mred/private/wx/cocoa/canvas.rkt b/collects/mred/private/wx/cocoa/canvas.rkt index 6c4bb59d..432d8847 100644 --- a/collects/mred/private/wx/cocoa/canvas.rkt +++ b/collects/mred/private/wx/cocoa/canvas.rkt @@ -10,6 +10,7 @@ "types.rkt" "window.rkt" "dc.rkt" + "cg.rkt" "queue.rkt" "item.rkt" "../common/backing-dc.rkt" diff --git a/collects/mred/private/wx/cocoa/cg.rkt b/collects/mred/private/wx/cocoa/cg.rkt new file mode 100644 index 00000000..95bd5da5 --- /dev/null +++ b/collects/mred/private/wx/cocoa/cg.rkt @@ -0,0 +1,20 @@ +#lang racket/base +(require ffi/unsafe + ffi/unsafe/objc + "types.rkt" + "utils.rkt") + +(provide (all-defined-out)) + +(define _CGContextRef (_cpointer 'CGContextRef)) +(define-appserv CGContextSynchronize (_fun _CGContextRef -> _void)) +(define-appserv CGContextFlush (_fun _CGContextRef -> _void)) +(define-appserv CGContextTranslateCTM (_fun _CGContextRef _CGFloat _CGFloat -> _void)) +(define-appserv CGContextScaleCTM (_fun _CGContextRef _CGFloat _CGFloat -> _void)) +(define-appserv CGContextSaveGState (_fun _CGContextRef -> _void)) +(define-appserv CGContextRestoreGState (_fun _CGContextRef -> _void)) +(define-appserv CGContextSetRGBFillColor (_fun _CGContextRef _CGFloat _CGFloat _CGFloat _CGFloat -> _void)) +(define-appserv CGContextFillRect (_fun _CGContextRef _NSRect -> _void)) +(define-appserv CGContextAddRect (_fun _CGContextRef _NSRect -> _void)) +(define-appserv CGContextAddLines (_fun _CGContextRef (v : (_vector i _NSPoint)) (_long = (vector-length v)) -> _void)) +(define-appserv CGContextStrokePath (_fun _CGContextRef -> _void)) diff --git a/collects/mred/private/wx/cocoa/dc.rkt b/collects/mred/private/wx/cocoa/dc.rkt index bb375f78..c8986fc4 100644 --- a/collects/mred/private/wx/cocoa/dc.rkt +++ b/collects/mred/private/wx/cocoa/dc.rkt @@ -9,30 +9,11 @@ "window.rkt" "../../lock.rkt" "../common/queue.rkt" - "../common/backing-dc.rkt") + "../common/backing-dc.rkt" + "cg.rkt") (provide dc% - do-backing-flush - - _CGContextRef - CGContextSetRGBFillColor - CGContextFillRect - CGContextAddRect - CGContextStrokePath - CGContextAddLines) - -(define _CGContextRef (_cpointer 'CGContextRef)) -(define-appserv CGContextSynchronize (_fun _CGContextRef -> _void)) -(define-appserv CGContextFlush (_fun _CGContextRef -> _void)) -(define-appserv CGContextTranslateCTM (_fun _CGContextRef _CGFloat _CGFloat -> _void)) -(define-appserv CGContextScaleCTM (_fun _CGContextRef _CGFloat _CGFloat -> _void)) -(define-appserv CGContextSaveGState (_fun _CGContextRef -> _void)) -(define-appserv CGContextRestoreGState (_fun _CGContextRef -> _void)) -(define-appserv CGContextSetRGBFillColor (_fun _CGContextRef _CGFloat _CGFloat _CGFloat _CGFloat -> _void)) -(define-appserv CGContextFillRect (_fun _CGContextRef _NSRect -> _void)) -(define-appserv CGContextAddRect (_fun _CGContextRef _NSRect -> _void)) -(define-appserv CGContextAddLines (_fun _CGContextRef (v : (_vector i _NSPoint)) (_long = (vector-length v)) -> _void)) -(define-appserv CGContextStrokePath (_fun _CGContextRef -> _void)) + do-backing-flush) (define quartz-bitmap% (class object% diff --git a/collects/mred/private/wx/cocoa/window.rkt b/collects/mred/private/wx/cocoa/window.rkt index 39492e5b..e2a3a0a3 100644 --- a/collects/mred/private/wx/cocoa/window.rkt +++ b/collects/mred/private/wx/cocoa/window.rkt @@ -455,7 +455,11 @@ ;; re-sync the display in case a stream of ;; events (e.g., key repeat) have a corresponding ;; stream of screen updates. - (try-to-sync-refresh)) + (try-to-sync-refresh) + (let ([cocoa-win (get-cocoa-window)]) + (when cocoa-win + (tellv cocoa-win displayIfNeeded) + (tellv cocoa-win flushWindowIfNeeded)))) (define/public (dispatch-on-char/sync e) (pre-event-refresh #t) diff --git a/collects/mred/private/wx/common/queue.rkt b/collects/mred/private/wx/common/queue.rkt index 6f524ac0..27a25c42 100644 --- a/collects/mred/private/wx/common/queue.rkt +++ b/collects/mred/private/wx/common/queue.rkt @@ -177,8 +177,8 @@ (make-eventspace th (let ([count 0]) (let ([lo (mcons #f #f)] - [med (mcons #f #f)] [refresh (mcons #f #f)] + [med (mcons #f #f)] [hi (mcons #f #f)] [timer (box '())] [timer-counter 0] @@ -226,8 +226,8 @@ (let ([val (cdr v)]) (case (car v) [(lo) (enqueue val lo)] - [(med) (enqueue val med)] [(refresh) (enqueue val refresh)] + [(med) (enqueue val med)] [(hi) (enqueue val hi)] [(timer-add) (set! timer-counter (add1 timer-counter)) @@ -275,8 +275,8 @@ (lambda (_) #f)) (or (first hi) (timer-first-ready timer) - (first med) (first refresh) + (first med) (first lo) (timer-first-wait timer) ;; nothing else ready... @@ -374,11 +374,14 @@ (define yield-refresh (lambda () (let ([e (current-eventspace)]) - (when (eq? (current-thread) (eventspace-handler-thread e)) - (let ([v (sync/timeout 0 ((eventspace-queue-proc e) #f #f))]) - (when v - (handle-event v) - (yield-refresh))))))) + (and (eq? (current-thread) (eventspace-handler-thread e)) + (let loop ([result #f]) + (let ([v (sync/timeout 0 ((eventspace-queue-proc e) #f #f))]) + (if v + (begin + (handle-event v) + (loop #t)) + result))))))) (define event-dispatch-handler (make-parameter void)) (define (main-eventspace? e)