From b69b97c113e78f974d0f73cc81f0154faf09d9b3 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 14 Sep 2010 06:32:07 -0600 Subject: [PATCH] cut overhead in fast path for text drawing --- collects/racket/draw/dc.rkt | 100 ++++++++++++++++++++---------------- 1 file changed, 56 insertions(+), 44 deletions(-) diff --git a/collects/racket/draw/dc.rkt b/collects/racket/draw/dc.rkt index 394642a0cb..9f7a9d9391 100644 --- a/collects/racket/draw/dc.rkt +++ b/collects/racket/draw/dc.rkt @@ -1061,7 +1061,9 @@ ;; is too small, so that it would look bad), then we draw character by character. (if (and combine? (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]) (cond [(not s) @@ -1146,15 +1148,16 @@ (zero? (pango_layout_get_unknown_glyphs_count layout))) ;; No good glyph; look for an alternate face (install-alternate-face ch layout font desc attrs context)) - (let ([run (extract-only-run layout)]) - (let ([layout-info (vector layout xform run)]) - (hash-set! layouts (char->integer ch) layout-info) - layout-info))))] + ;; layout-info vector is (vector _layout _xform _run _font _glyphs) + (let ([layout-info (vector layout xform #f #f #f)]) + (extract-only-run layout layout-info) + (hash-set! layouts (char->integer ch) layout-info) + layout-info)))] [layout (vector-ref layout-info 0)]) (unless (equal? xform (vector-ref layout-info 1)) (pango_cairo_update_layout cr layout) (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. ;; If layouts all use the same font and a single glyph, then ;; build a glyph string with the right offsets and draw all the @@ -1167,47 +1170,45 @@ (unless (and draw? cache + (not attrs) ; fast path doesn't handle underline ((string-length s) . > . 1) (let ([len (string-length s)] - [first-v (hash-ref cache (char->integer (string-ref s 0)) #f)]) - ;; Check whether the fast way applies... + [first-v (hash-ref cache (char->integer (string-ref s 0)) #f)] + [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 [log-clusters (malloc len _int 'raw)] - [first-font (let* ([run (vector-ref (hash-ref layouts (char->integer (string-ref s 0))) 2)]) - (and run - (PangoItem-font (PangoGlyphItem-item run))))] + [first-font (vector-ref (hash-ref layouts (char->integer (string-ref s 0))) 3)] [first-ascent (and first-v (fl- (vector-ref first-v 1) (vector-ref first-v 2)))]) (and - (let loop ([i 0][dx 0.0]) + (let loop ([i 0]) (or (= i len) (let* ([ch (string-ref s i)] [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)]) - (and run + (and font v - (fl= first-ascent - (fl- (vector-ref v 1) (vector-ref v 2))) - (ptr-equal? first-font - (PangoItem-font (PangoGlyphItem-item run))) + ;; Need the same font for all glyphs for the fast path: + (ptr-equal? first-font font) + ;; The slow path uses a top-left corner, this fast + ;; 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, ;; and start filling in the glyph-info array: - (let ([dest-info (cast (ptr-add glyph-infos i _PangoGlyphInfo) - _pointer - _PangoGlyphInfo-pointer)]) - (memcpy dest-info - (PangoGlyphString-glyphs (PangoGlyphItem-glyphs run)) - 1 - _PangoGlyphInfo) - (ptr-set! log-clusters _int i i) - ;; Adjust width to be consistent with integral widths - ;; used when drawing individual characters. - (let ([w (vector-ref v 0)]) - (set-PangoGlyphInfo-width! dest-info - (inexact->exact - (flfloor - (fl* w (->fl PANGO_SCALE))))) - (loop (add1 i) (fl+ dx w)))))))) + (memcpy glyph-infos i glyphs 1 _PangoGlyphInfo) + ;; Every glyph is is own cluster: + (ptr-set! log-clusters _int i i) + ;; Adjust width to be consistent with integral widths + ;; used when drawing individual characters. + ;; This is `set-PangoGlyphInfo-width!', but without + ;; computing a + (ptr-set! glyph-infos _uint32 'abs (+ (* i pgi-size) 4) (vector-ref v 5)) + (loop (add1 i)))))) ;; If we get here, we can use the fast way: (let ([glyph-string (make-PangoGlyphString len glyph-infos @@ -1225,18 +1226,18 @@ (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 (and draw? (or (not (eq? ch #\space)) - attrs)) + (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))]) + (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)] @@ -1246,21 +1247,32 @@ [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))) + (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) + (define/private (extract-only-run layout vec) (let* ([iter (pango_layout_get_iter layout)] [run (pango_layout_iter_get_run_readonly iter)] [done? (or (not (pango_layout_iter_next_run iter)) (and (not (pango_layout_iter_get_run_readonly iter)) (not (pango_layout_iter_next_run iter))))]) (pango_layout_iter_free iter) - (and run - done? - (= 1 (PangoGlyphString-num_glyphs (PangoGlyphItem-glyphs run))) - run))) + (or (and run + done? + (= 1 (PangoGlyphString-num_glyphs (PangoGlyphItem-glyphs 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) (or