suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

still again yet another refinement to cocoa refresh

Browse Source 
original commit: 748115fe91205e5df2128d8ea4f12b7ec8fa5076
This commit is contained in:
Matthew Flatt 2010-09-09 14:03:29 -06:00
parent d93d8e5dfc
commit 4e23681799
5 changed files with 40 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/mred/private/wx/cocoa/canvas.rkt
View File

@ -10,6 +10,7 @@
"types.rkt"
"window.rkt"
"dc.rkt"
"cg.rkt"
"queue.rkt"
"item.rkt"
"../common/backing-dc.rkt"

20
collects/mred/private/wx/cocoa/cg.rkt Normal file
View File

@ -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))

25
collects/mred/private/wx/cocoa/dc.rkt
View File

@ -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%

6
collects/mred/private/wx/cocoa/window.rkt
View File

@ -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)

19
collects/mred/private/wx/common/queue.rkt
View File

@ -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)