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

fix (different) refresh issues with both Gtk and Cocoa

Browse Source
This commit is contained in:
Matthew Flatt 2010-09-18 12:48:57 -06:00
parent bdc9538244
commit a1462d0255
2 changed files with 28 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -60,7 +60,12 @@
(values (unbox xb) (unbox yb))))
(define/override (queue-backing-flush)
;; called atomically (not expecting exceptions)
;; With Cocoa window-level delay doesn't stop
;; displays; it blocks flushes to the screen.
;; So leave the delay in place, and `end-delay'
;; after displaying to the window (after which
;; we'll be ready to flush the window), which
;; is at then end of `do-backing-flush'.
(send canvas queue-backing-flush))
(define/override (request-delay)
@ -92,6 +97,6 @@
(cairo_fill cr)
(cairo_set_source cr s)
(cairo_pattern_destroy s))
(cairo_destroy cr))))))
(tellv ctx restoreGraphicsState)
(send dc end-delay)))
(cairo_destroy cr))))
(send dc end-delay)))
(tellv ctx restoreGraphicsState)))

37
collects/mred/private/wx/gtk/dc.rkt
View File

@ -77,6 +77,7 @@
(define dc%
(class backing-dc%
(init [(cnvs canvas)])
(inherit end-delay)
(define canvas cnvs)
(super-new)
@ -102,7 +103,9 @@
(values (unbox xb) (unbox yb))))
(define/override (queue-backing-flush)
;; called atomically (not expecting exceptions)
;; Re-enable expose events so that the queued
;; backing flush will be handled:
(end-delay)
(send canvas queue-backing-flush))
(define/override (request-delay)
@ -111,20 +114,18 @@
(cancel-flush-delay req))))
(define (do-backing-flush canvas dc win)
(begin0
(send dc on-backing-flush
(lambda (bm)
(let ([w (box 0)]
[h (box 0)])
(send canvas get-client-size w h)
(let ([cr (gdk_cairo_create win)])
(let ([s (cairo_get_source cr)])
(cairo_pattern_reference s)
(cairo_set_source_surface cr (send bm get-cairo-surface) 0 0)
(cairo_new_path cr)
(cairo_rectangle cr 0 0 (unbox w) (unbox h))
(cairo_fill cr)
(cairo_set_source cr s)
(cairo_pattern_destroy s))
(cairo_destroy cr)))))
(send dc end-delay)))
(send dc on-backing-flush
(lambda (bm)
(let ([w (box 0)]
[h (box 0)])
(send canvas get-client-size w h)
(let ([cr (gdk_cairo_create win)])
(let ([s (cairo_get_source cr)])
(cairo_pattern_reference s)
(cairo_set_source_surface cr (send bm get-cairo-surface) 0 0)
(cairo_new_path cr)
(cairo_rectangle cr 0 0 (unbox w) (unbox h))
(cairo_fill cr)
(cairo_set_source cr s)
(cairo_pattern_destroy s))
(cairo_destroy cr))))))