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

adjust flush-display

Browse Source
This commit is contained in:
Matthew Flatt 2010-09-15 06:20:45 -06:00
parent 4bd84adb3a
commit 61788d68d5
5 changed files with 46 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/framework/splash.rkt
View File

@ -157,6 +157,7 @@
(refresh-splash) (refresh-splash)
(send splash-tlw center 'both) (send splash-tlw center 'both)
(thread (λ () (send splash-tlw show #t))) (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)
(flush-display) (yield) (sleep))) (flush-display) (yield) (sleep)))

2
collects/mred/private/wx/cocoa/procs.rkt
View File

@ -7,6 +7,7 @@
"utils.rkt" "utils.rkt"
"types.rkt" "types.rkt"
"frame.rkt" "frame.rkt"
"window.rkt"
"finfo.rkt" ; file-creator-and-type "finfo.rkt" ; file-creator-and-type
"filedialog.rkt" "filedialog.rkt"
"../../lock.rkt" "../../lock.rkt"
@ -93,7 +94,6 @@
(define (get-control-font-size) 13) (define (get-control-font-size) 13)
(define (cancel-quit) (void)) (define (cancel-quit) (void))
(define-unimplemented fill-private-color) (define-unimplemented fill-private-color)
(define (flush-display) (void))
(define-unimplemented write-resource) (define-unimplemented write-resource)
(define-unimplemented get-resource) (define-unimplemented get-resource)

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

@ -32,6 +32,7 @@
request-flush-delay request-flush-delay
cancel-flush-delay cancel-flush-delay
make-init-point make-init-point
flush-display
special-control-key special-control-key
special-option-key) special-option-key)
@ -504,6 +505,9 @@
;; events (e.g., key repeat) have a corresponding ;; events (e.g., key repeat) have a corresponding
;; stream of screen updates. ;; stream of screen updates.
(try-to-sync-refresh) (try-to-sync-refresh)
(flush))
(define/public (flush)
(let ([cocoa-win (get-cocoa-window)]) (let ([cocoa-win (get-cocoa-window)])
(when cocoa-win (when cocoa-win
(tellv cocoa-win displayIfNeeded) (tellv cocoa-win displayIfNeeded)
@ -676,3 +680,8 @@
(if (= y -11111) (if (= y -11111)
0 0
y))) y)))
(define (flush-display)
(try-to-sync-refresh)
(for ([win (in-list (get-top-level-windows))])
(send win flush)))

9
collects/mred/private/wx/gtk/window.rkt
View File

@ -530,8 +530,6 @@
;; re-sync the display in case a stream of ;; re-sync the display in case a stream of
;; events (e.g., key repeat) have a corresponding ;; events (e.g., key repeat) have a corresponding
;; stream of screen updates. ;; stream of screen updates.
(try-to-sync-refresh)
(gdk_window_process_all_updates)
(flush-display)) (flush-display))
(define/public (handles-events? gtk) #f) (define/public (handles-events? gtk) #f)
@ -612,10 +610,11 @@
(queue-refresh-event (send win get-eventspace) thunk)) (queue-refresh-event (send win get-eventspace) thunk))
(define-gdk gdk_display_flush (_fun _GdkDisplay -> _void)) (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-gdk gdk_display_get_default (_fun -> _GdkDisplay))
(define (flush-display) (gdk_display_flush (gdk_display_get_default))) (define (flush-display)
(define (sync-display) (gdk_display_sync (gdk_display_get_default))) (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_freeze_updates (_fun _GdkWindow -> _void))
(define-gdk gdk_window_thaw_updates (_fun _GdkWindow -> _void)) (define-gdk gdk_window_thaw_updates (_fun _GdkWindow -> _void))

62
collects/racket/draw/dc.rkt
View File

@ -1141,8 +1141,7 @@
(loop next-s (+ w nw) (max h nh) (max d nd) (max a na))))])))])) (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 ;; This is character-by-character mode. It uses a cached per-character+font layout
;; object. ;; object.
(let ([logical (make-PangoRectangle 0 0 0 0)] (let ([cache (if (or combine?
[cache (if (or combine?
(not (fl= 1.0 effective-scale-x)) (not (fl= 1.0 effective-scale-x))
(not (fl= 1.0 effective-scale-y))) (not (fl= 1.0 effective-scale-y)))
#f #f
@ -1244,35 +1243,36 @@
(free log-clusters) (free log-clusters)
#t))))) #t)))))
;; We use the slower, per-layout way: ;; We use the slower, per-layout way:
(for/fold ([w 0.0][h 0.0][d 0.0][a 0.0]) (let ([logical (make-PangoRectangle 0 0 0 0)])
([ch (in-string s)]) (for/fold ([w 0.0][h 0.0][d 0.0][a 0.0])
(let ([layout (vector-ref (hash-ref layouts (char->integer ch)) 0)]) ([ch (in-string s)])
(when draw? (let ([layout (vector-ref (hash-ref layouts (char->integer ch)) 0)])
(cairo_move_to cr (align-x/delta (+ x w) 0) (align-y/delta y 0)) (when draw?
;; Here's the draw command, which uses most of the time in this mode: (cairo_move_to cr (align-x/delta (+ x w) 0) (align-y/delta y 0))
(pango_cairo_show_layout cr layout)) ;; Here's the draw command, which uses most of the time in this mode:
(let ([v (and cache (hash-ref cache (char->integer ch) #f))]) (pango_cairo_show_layout cr layout))
(if v (let ([v (and cache (hash-ref cache (char->integer ch) #f))])
;; Used cached size: (if v
(values (if blank? 0.0 (+ w (vector-ref v 0))) ;; Used cached size:
(max h (vector-ref v 1)) (values (if blank? 0.0 (+ w (vector-ref v 0)))
(max d (vector-ref v 2)) (max h (vector-ref v 1))
(max a (vector-ref v 3))) (max d (vector-ref v 2))
;; Query and record size: (max a (vector-ref v 3)))
(begin ;; Query and record size:
(pango_layout_get_extents layout #f logical) (begin
(let ([baseline (pango_layout_get_baseline layout)] (pango_layout_get_extents layout #f logical)
[orig-h (PangoRectangle-height logical)]) (let ([baseline (pango_layout_get_baseline layout)]
(let ([lw (integral (/ (PangoRectangle-width logical) (exact->inexact PANGO_SCALE)))] [orig-h (PangoRectangle-height logical)])
[lh (integral (/ orig-h (exact->inexact PANGO_SCALE)))] (let ([lw (integral (/ (PangoRectangle-width logical) (exact->inexact PANGO_SCALE)))]
[ld (integral (/ (- orig-h baseline) (exact->inexact PANGO_SCALE)))] [lh (integral (/ orig-h (exact->inexact PANGO_SCALE)))]
[la 0.0]) [ld (integral (/ (- orig-h baseline) (exact->inexact PANGO_SCALE)))]
(when cache [la 0.0])
(hash-set! cache (char->integer ch) (vector lw lh ld la baseline (when cache
;; rounded width in Pango units: (hash-set! cache (char->integer ch) (vector lw lh ld la baseline
(inexact->exact ;; rounded width in Pango units:
(floor (* lw (->fl PANGO_SCALE))))))) (inexact->exact
(values (if blank? 0.0 (+ w lw)) (max h lh) (max d ld) (max a la)))))))))) (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)))))))) (when rotate? (cairo_restore cr))))))))
(define/private (extract-only-run layout vec) (define/private (extract-only-run layout vec)