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

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

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

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

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

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

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

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))))])))]))
;; 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)