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

cut overhead in fast path for text drawing

Browse Source
This commit is contained in:
Matthew Flatt 2010-09-14 06:32:07 -06:00
parent d57f72136d
commit b69b97c113
1 changed files with 56 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1061,7 +1061,9 @@
;; is too small, so that it would look bad), then we draw character by character. ;; is too small, so that it would look bad), then we draw character by character.
(if (and combine? (if (and combine?
(can-combine-text? (* effective-scale-y (send font get-point-size)))) (can-combine-text? (* effective-scale-y (send font get-point-size))))
;; This is combine mode. ;; This is combine mode. It has to be a little complicated, after all,
;; because we may need to implement font substitution ourselves, which
;; breaks the string into multiple layouts.
(let loop ([s s] [w 0.0] [h 0.0] [d 0.0] [a 0.0]) (let loop ([s s] [w 0.0] [h 0.0] [d 0.0] [a 0.0])
(cond (cond
[(not s) [(not s)
@ -1146,15 +1148,16 @@
(zero? (pango_layout_get_unknown_glyphs_count layout))) (zero? (pango_layout_get_unknown_glyphs_count layout)))
;; No good glyph; look for an alternate face ;; No good glyph; look for an alternate face
(install-alternate-face ch layout font desc attrs context)) (install-alternate-face ch layout font desc attrs context))
(let ([run (extract-only-run layout)]) ;; layout-info vector is (vector _layout _xform _run _font _glyphs)
(let ([layout-info (vector layout xform run)]) (let ([layout-info (vector layout xform #f #f #f)])
(extract-only-run layout layout-info)
(hash-set! layouts (char->integer ch) layout-info) (hash-set! layouts (char->integer ch) layout-info)
layout-info))))] layout-info)))]
[layout (vector-ref layout-info 0)]) [layout (vector-ref layout-info 0)])
(unless (equal? xform (vector-ref layout-info 1)) (unless (equal? xform (vector-ref layout-info 1))
(pango_cairo_update_layout cr layout) (pango_cairo_update_layout cr layout)
(vector-set! layout-info 1 xform) (vector-set! layout-info 1 xform)
(vector-set! layout-info 2 (extract-only-run layout))))) (extract-only-run layout layout-info))))
;; At this point, we have two options for dealing with the layouts. ;; At this point, we have two options for dealing with the layouts.
;; If layouts all use the same font and a single glyph, then ;; If layouts all use the same font and a single glyph, then
;; build a glyph string with the right offsets and draw all the ;; build a glyph string with the right offsets and draw all the
@ -1167,47 +1170,45 @@
(unless (and (unless (and
draw? draw?
cache cache
(not attrs) ; fast path doesn't handle underline
((string-length s) . > . 1) ((string-length s) . > . 1)
(let ([len (string-length s)] (let ([len (string-length s)]
[first-v (hash-ref cache (char->integer (string-ref s 0)) #f)]) [first-v (hash-ref cache (char->integer (string-ref s 0)) #f)]
;; Check whether the fast way applies... [pgi-size (ctype-sizeof _PangoGlyphInfo)])
;; Check whether the fast way applies. The speed of this
;; loop directly affects the responsiveness of the DrRacket
;; editor.
(let ([glyph-infos (malloc len _PangoGlyphInfo 'raw)] ;; assuming atomic until `free' below (let ([glyph-infos (malloc len _PangoGlyphInfo 'raw)] ;; assuming atomic until `free' below
[log-clusters (malloc len _int 'raw)] [log-clusters (malloc len _int 'raw)]
[first-font (let* ([run (vector-ref (hash-ref layouts (char->integer (string-ref s 0))) 2)]) [first-font (vector-ref (hash-ref layouts (char->integer (string-ref s 0))) 3)]
(and run
(PangoItem-font (PangoGlyphItem-item run))))]
[first-ascent (and first-v (fl- (vector-ref first-v 1) (vector-ref first-v 2)))]) [first-ascent (and first-v (fl- (vector-ref first-v 1) (vector-ref first-v 2)))])
(and (and
(let loop ([i 0][dx 0.0]) (let loop ([i 0])
(or (= i len) (or (= i len)
(let* ([ch (string-ref s i)] (let* ([ch (string-ref s i)]
[layout-info (hash-ref layouts (char->integer ch))] [layout-info (hash-ref layouts (char->integer ch))]
[run (vector-ref layout-info 2)] [font (vector-ref layout-info 3)]
[glyphs (vector-ref layout-info 4)]
[v (hash-ref cache (char->integer ch) #f)]) [v (hash-ref cache (char->integer ch) #f)])
(and run (and font
v v
(fl= first-ascent ;; Need the same font for all glyphs for the fast path:
(fl- (vector-ref v 1) (vector-ref v 2))) (ptr-equal? first-font font)
(ptr-equal? first-font ;; The slow path uses a top-left corner, this fast
(PangoItem-font (PangoGlyphItem-item run))) ;; path uses a baseline, so only use the fast path
;; if those two are consistent:
(fl= first-ascent (fl- (vector-ref v 1) (vector-ref v 2)))
;; Assume that the rect of the characters will pan out, ;; Assume that the rect of the characters will pan out,
;; and start filling in the glyph-info array: ;; and start filling in the glyph-info array:
(let ([dest-info (cast (ptr-add glyph-infos i _PangoGlyphInfo) (memcpy glyph-infos i glyphs 1 _PangoGlyphInfo)
_pointer ;; Every glyph is is own cluster:
_PangoGlyphInfo-pointer)])
(memcpy dest-info
(PangoGlyphString-glyphs (PangoGlyphItem-glyphs run))
1
_PangoGlyphInfo)
(ptr-set! log-clusters _int i i) (ptr-set! log-clusters _int i i)
;; Adjust width to be consistent with integral widths ;; Adjust width to be consistent with integral widths
;; used when drawing individual characters. ;; used when drawing individual characters.
(let ([w (vector-ref v 0)]) ;; This is `set-PangoGlyphInfo-width!', but without
(set-PangoGlyphInfo-width! dest-info ;; computing a
(inexact->exact (ptr-set! glyph-infos _uint32 'abs (+ (* i pgi-size) 4) (vector-ref v 5))
(flfloor (loop (add1 i))))))
(fl* w (->fl PANGO_SCALE)))))
(loop (add1 i) (fl+ dx w))))))))
;; If we get here, we can use the fast way: ;; If we get here, we can use the fast way:
(let ([glyph-string (make-PangoGlyphString len (let ([glyph-string (make-PangoGlyphString len
glyph-infos glyph-infos
@ -1225,18 +1226,18 @@
(for/fold ([w 0.0][h 0.0][d 0.0][a 0.0]) (for/fold ([w 0.0][h 0.0][d 0.0][a 0.0])
([ch (in-string s)]) ([ch (in-string s)])
(let ([layout (vector-ref (hash-ref layouts (char->integer ch)) 0)]) (let ([layout (vector-ref (hash-ref layouts (char->integer ch)) 0)])
(when (and draw? (or (not (eq? ch #\space)) (when draw?
attrs))
(cairo_move_to cr (align-x/delta (+ x w) 0) (align-y/delta y 0)) (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: ;; Here's the draw command, which uses most of the time in this mode:
(pango_cairo_show_layout cr layout)) (pango_cairo_show_layout cr layout))
(let ([v (and cache (let ([v (and cache (hash-ref cache (char->integer ch) #f))])
(hash-ref cache (char->integer ch) #f))])
(if v (if v
;; Used cached size:
(values (if blank? 0.0 (+ w (vector-ref v 0))) (values (if blank? 0.0 (+ w (vector-ref v 0)))
(max h (vector-ref v 1)) (max h (vector-ref v 1))
(max d (vector-ref v 2)) (max d (vector-ref v 2))
(max a (vector-ref v 3))) (max a (vector-ref v 3)))
;; Query and record size:
(begin (begin
(pango_layout_get_extents layout #f logical) (pango_layout_get_extents layout #f logical)
(let ([baseline (pango_layout_get_baseline layout)] (let ([baseline (pango_layout_get_baseline layout)]
@ -1246,21 +1247,32 @@
[ld (integral (/ (- orig-h baseline) (exact->inexact PANGO_SCALE)))] [ld (integral (/ (- orig-h baseline) (exact->inexact PANGO_SCALE)))]
[la 0.0]) [la 0.0])
(when cache (when cache
(hash-set! cache (char->integer ch) (vector lw lh ld la baseline))) (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)))))))))) (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) (define/private (extract-only-run layout vec)
(let* ([iter (pango_layout_get_iter layout)] (let* ([iter (pango_layout_get_iter layout)]
[run (pango_layout_iter_get_run_readonly iter)] [run (pango_layout_iter_get_run_readonly iter)]
[done? (or (not (pango_layout_iter_next_run iter)) [done? (or (not (pango_layout_iter_next_run iter))
(and (not (pango_layout_iter_get_run_readonly iter)) (and (not (pango_layout_iter_get_run_readonly iter))
(not (pango_layout_iter_next_run iter))))]) (not (pango_layout_iter_next_run iter))))])
(pango_layout_iter_free iter) (pango_layout_iter_free iter)
(and run (or (and run
done? done?
(= 1 (PangoGlyphString-num_glyphs (PangoGlyphItem-glyphs run))) (= 1 (PangoGlyphString-num_glyphs (PangoGlyphItem-glyphs run)))
run))) (begin
(vector-set! vec 2 run)
(vector-set! vec 3 (PangoItem-font (PangoGlyphItem-item run)))
(vector-set! vec 4 (PangoGlyphString-glyphs (PangoGlyphItem-glyphs run)))
#t))
(begin
(vector-set! vec 2 #f)
(vector-set! vec 3 #f)
(vector-set! vec 4 #f)))))
(define/private (install-alternate-face ch layout font desc attrs context) (define/private (install-alternate-face ch layout font desc attrs context)
(or (or