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

fix text-drawing performance

Browse Source 
original commit: 0e64be35b7610d3e622f20dd121482b897581b91
This commit is contained in:
Matthew Flatt 2010-09-09 07:26:53 -06:00
parent ceddc9fbf5
commit f37b3304f2
4 changed files with 19 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -223,15 +223,17 @@
(when pq (set-box! pq #f)))
(set! paint-queued #f)
(when (or (not b) (is-shown-to-root?))
(send dc reset-backing-retained) ; start with a clean slate
(send dc ensure-ready)
(send dc erase) ; start with a clean slate
(let ([bg (get-canvas-background)])
(when bg
(let ([old-bg (send dc get-background)])
(send dc set-background bg)
(send dc clear)
(send dc set-background old-bg))))
(send dc suspend-flush)
(on-paint)
(send dc resume-flush)
(queue-backing-flush)))
(when req
(cancel-flush-delay req)))

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

@ -449,7 +449,16 @@
;; Called in Cocoa event-handling mode
#f)
(define/private (pre-event-refresh key?)
;; Since we break the connection between the
;; Cocoa queue and event handling, we
;; 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))
(define/public (dispatch-on-char/sync e)
(pre-event-refresh #t)
(dispatch-on-char e #f))
(define/public (dispatch-on-char e just-pre?)
(cond
@ -459,6 +468,7 @@
[else (when enabled? (on-char e)) #t]))
(define/public (dispatch-on-event/sync e)
(pre-event-refresh #f)
(dispatch-on-event e #f))
(define/public (dispatch-on-event e just-pre?)
(cond

5
collects/mred/private/wx/common/backing-dc.rkt
View File

@ -32,7 +32,8 @@
(inherit call-with-cr-lock
internal-get-bitmap
internal-set-bitmap
reset-cr)
reset-cr
erase)
(super-new)
@ -68,7 +69,7 @@
(define/public (reset-backing-retained [proc void])
(let ([cr retained-cr])
(when cr
(when cr
(let ([bm (internal-get-bitmap)])
(set! retained-cr #f)
(internal-set-bitmap #f #t)

4
collects/mred/private/wx/gtk/canvas.rkt
View File

@ -349,15 +349,17 @@
(lambda ()
(set! paint-queued? #f)
(set! now-drawing? #t)
(send dc reset-backing-retained) ; clean slate
(send dc ensure-ready)
(send dc erase) ; clean slate
(let ([bg (get-canvas-background)])
(when bg
(let ([old-bg (send dc get-background)])
(send dc set-background bg)
(send dc clear)
(send dc set-background old-bg))))
(send dc suspend-flush)
(on-paint)
(send dc resume-flush)
(set! now-drawing? #f)
(when refresh-after-drawing?
(set! refresh-after-drawing? #f)