diff --git a/collects/framework/splash.rkt b/collects/framework/splash.rkt index 5c7b3ba645..9bb519ec57 100644 --- a/collects/framework/splash.rkt +++ b/collects/framework/splash.rkt @@ -157,6 +157,7 @@ (refresh-splash) (send splash-tlw center 'both) (thread (λ () (send splash-tlw show #t))) + (sync (system-idle-evt)) ; try to wait for dialog to be shown (flush-display) (yield) (sleep) (flush-display) (yield) (sleep))) diff --git a/collects/mred/private/wx/cocoa/procs.rkt b/collects/mred/private/wx/cocoa/procs.rkt index 90e394c771..91f3f9d184 100644 --- a/collects/mred/private/wx/cocoa/procs.rkt +++ b/collects/mred/private/wx/cocoa/procs.rkt @@ -7,6 +7,7 @@ "utils.rkt" "types.rkt" "frame.rkt" + "window.rkt" "finfo.rkt" ; file-creator-and-type "filedialog.rkt" "../../lock.rkt" @@ -93,7 +94,6 @@ (define (get-control-font-size) 13) (define (cancel-quit) (void)) (define-unimplemented fill-private-color) -(define (flush-display) (void)) (define-unimplemented write-resource) (define-unimplemented get-resource) diff --git a/collects/mred/private/wx/cocoa/window.rkt b/collects/mred/private/wx/cocoa/window.rkt index 033f8da750..d89757db51 100644 --- a/collects/mred/private/wx/cocoa/window.rkt +++ b/collects/mred/private/wx/cocoa/window.rkt @@ -32,6 +32,7 @@ request-flush-delay cancel-flush-delay make-init-point + flush-display special-control-key special-option-key) @@ -504,6 +505,9 @@ ;; events (e.g., key repeat) have a corresponding ;; stream of screen updates. (try-to-sync-refresh) + (flush)) + + (define/public (flush) (let ([cocoa-win (get-cocoa-window)]) (when cocoa-win (tellv cocoa-win displayIfNeeded) @@ -676,3 +680,8 @@ (if (= y -11111) 0 y))) + +(define (flush-display) + (try-to-sync-refresh) + (for ([win (in-list (get-top-level-windows))]) + (send win flush))) diff --git a/collects/mred/private/wx/gtk/window.rkt b/collects/mred/private/wx/gtk/window.rkt index b6a00d6134..ef295165c5 100644 --- a/collects/mred/private/wx/gtk/window.rkt +++ b/collects/mred/private/wx/gtk/window.rkt @@ -530,8 +530,6 @@ ;; 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) - (gdk_window_process_all_updates) (flush-display)) (define/public (handles-events? gtk) #f) @@ -612,10 +610,11 @@ (queue-refresh-event (send win get-eventspace) thunk)) (define-gdk gdk_display_flush (_fun _GdkDisplay -> _void)) -(define-gdk gdk_display_sync (_fun _GdkDisplay -> _void)) (define-gdk gdk_display_get_default (_fun -> _GdkDisplay)) -(define (flush-display) (gdk_display_flush (gdk_display_get_default))) -(define (sync-display) (gdk_display_sync (gdk_display_get_default))) +(define (flush-display) + (try-to-sync-refresh) + (gdk_window_process_all_updates) + (gdk_display_flush (gdk_display_get_default))) (define-gdk gdk_window_freeze_updates (_fun _GdkWindow -> _void)) (define-gdk gdk_window_thaw_updates (_fun _GdkWindow -> _void)) diff --git a/collects/racket/draw/dc.rkt b/collects/racket/draw/dc.rkt index d1f10175d8..6bda331a17 100644 --- a/collects/racket/draw/dc.rkt +++ b/collects/racket/draw/dc.rkt @@ -1141,8 +1141,7 @@ (loop next-s (+ w nw) (max h nh) (max d nd) (max a na))))])))])) ;; This is character-by-character mode. It uses a cached per-character+font layout ;; object. - (let ([logical (make-PangoRectangle 0 0 0 0)] - [cache (if (or combine? + (let ([cache (if (or combine? (not (fl= 1.0 effective-scale-x)) (not (fl= 1.0 effective-scale-y))) #f @@ -1244,35 +1243,36 @@ (free log-clusters) #t))))) ;; We use the slower, per-layout way: - (for/fold ([w 0.0][h 0.0][d 0.0][a 0.0]) - ([ch (in-string s)]) - (let ([layout (vector-ref (hash-ref layouts (char->integer ch)) 0)]) - (when draw? - (cairo_move_to cr (align-x/delta (+ x w) 0) (align-y/delta y 0)) - ;; Here's the draw command, which uses most of the time in this mode: - (pango_cairo_show_layout cr layout)) - (let ([v (and cache (hash-ref cache (char->integer ch) #f))]) - (if v - ;; Used cached size: - (values (if blank? 0.0 (+ w (vector-ref v 0))) - (max h (vector-ref v 1)) - (max d (vector-ref v 2)) - (max a (vector-ref v 3))) - ;; Query and record size: - (begin - (pango_layout_get_extents layout #f logical) - (let ([baseline (pango_layout_get_baseline layout)] - [orig-h (PangoRectangle-height logical)]) - (let ([lw (integral (/ (PangoRectangle-width logical) (exact->inexact PANGO_SCALE)))] - [lh (integral (/ orig-h (exact->inexact PANGO_SCALE)))] - [ld (integral (/ (- orig-h baseline) (exact->inexact PANGO_SCALE)))] - [la 0.0]) - (when cache - (hash-set! cache (char->integer ch) (vector lw lh ld la baseline - ;; rounded width in Pango units: - (inexact->exact - (floor (* lw (->fl PANGO_SCALE))))))) - (values (if blank? 0.0 (+ w lw)) (max h lh) (max d ld) (max a la)))))))))) + (let ([logical (make-PangoRectangle 0 0 0 0)]) + (for/fold ([w 0.0][h 0.0][d 0.0][a 0.0]) + ([ch (in-string s)]) + (let ([layout (vector-ref (hash-ref layouts (char->integer ch)) 0)]) + (when draw? + (cairo_move_to cr (align-x/delta (+ x w) 0) (align-y/delta y 0)) + ;; Here's the draw command, which uses most of the time in this mode: + (pango_cairo_show_layout cr layout)) + (let ([v (and cache (hash-ref cache (char->integer ch) #f))]) + (if v + ;; Used cached size: + (values (if blank? 0.0 (+ w (vector-ref v 0))) + (max h (vector-ref v 1)) + (max d (vector-ref v 2)) + (max a (vector-ref v 3))) + ;; Query and record size: + (begin + (pango_layout_get_extents layout #f logical) + (let ([baseline (pango_layout_get_baseline layout)] + [orig-h (PangoRectangle-height logical)]) + (let ([lw (integral (/ (PangoRectangle-width logical) (exact->inexact PANGO_SCALE)))] + [lh (integral (/ orig-h (exact->inexact PANGO_SCALE)))] + [ld (integral (/ (- orig-h baseline) (exact->inexact PANGO_SCALE)))] + [la 0.0]) + (when cache + (hash-set! cache (char->integer ch) (vector lw lh ld la baseline + ;; rounded width in Pango units: + (inexact->exact + (floor (* lw (->fl PANGO_SCALE))))))) + (values (if blank? 0.0 (+ w lw)) (max h lh) (max d ld) (max a la))))))))))) (when rotate? (cairo_restore cr)))))))) (define/private (extract-only-run layout vec)