diff --git a/pitfall/pitfall/embedded-font.rkt b/pitfall/pitfall/embedded-font.rkt index 3726630d..27025bd4 100644 --- a/pitfall/pitfall/embedded-font.rkt +++ b/pitfall/pitfall/embedded-font.rkt @@ -1,6 +1,5 @@ #lang debug racket/base (require - (for-syntax racket/base) "core.rkt" "reference.rkt" racket/class @@ -58,35 +57,38 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee (define/override (string-width str size [features null]) ; #f disables features ; null enables default features ; list adds features - (match-define (list _ posns) (encode str features)) (define scale (/ size (+ (font-units-per-em font) 0.0))) + ;; use `encode` because it's cached. + ;; we assume that the side effects of `encode` + ;; (e.g., appending to `widths` and `unicode`) + ;; are ok because every string that gets measured is going to be encoded eventually + (match-define (list _ posns) (encode str features)) (define width (for/sum ([p (in-vector posns)]) (glyph-position-x-advance p))) (* width scale)) - (define layout-cache (make-hash)) + (define encoding-cache (make-hash)) + ;; called from text.rkt - (define/override (encode str [features null]) - (hash-ref! (hash-ref! layout-cache features make-hash) str + (define/override (encode str [features null]) + (define features-key (and features (sort features stringvector subset-idxs) (list->vector new-positions))))) - (define/override (embed) ;; no CFF support (define isCFF #false) #;(is-a? subset CFFSubset) @@ -202,11 +204,11 @@ HERE (module+ test (require rackunit fontland sugar/unstable/js) (define ef (make-object embedded-font% "../ptest/assets/charter.ttf")) - (check-equal? (send ef string-width "f" 1000) 321.0) (check-equal? (· ef ascender) 980) (check-equal? (· ef descender) -238) (check-equal? (· ef line-gap) 0) (check-equal? (bbox->list (· ef bbox)) '(-161 -236 1193 963)) (define H-gid 41) (check-equal? (· ef widths) (mhasheqv 0 278)) - (check-equal? (glyph-advance-width (get-glyph (· ef font) H-gid)) 738)) \ No newline at end of file + (check-equal? (send ef string-width "f" 1000) 321.0) + (check-equal? (glyph-advance-width (get-glyph (· ef font) H-gid)) 738)) diff --git a/pitfall/pitfall/standard-font.rkt b/pitfall/pitfall/standard-font.rkt index aa85a386..e1da4393 100644 --- a/pitfall/pitfall/standard-font.rkt +++ b/pitfall/pitfall/standard-font.rkt @@ -1,4 +1,4 @@ -#lang racket/base +#lang debug racket/base (require racket/class racket/string @@ -62,19 +62,25 @@ (define/public (get-kern-pair left right) (hash-ref @kern-pairs (make-kern-table-key left right) 0)) - (define/override (encode text [options #f]) - (define encoded (for/vector ([c (in-string text)]) - (define cint (char->integer c)) - (number->string (hash-ref win-ansi-table cint cint) 16))) - (define glyphs (glyphs-for-string text)) - (define positions (for/vector ([glyph (in-list glyphs)] - [advance (in-list (advances-for-glyphs glyphs))]) - (+glyph-position advance 0 0 0 (glyph-width glyph)))) - (list encoded positions)) + (define encoding-cache (make-hash)) + + (define/override (encode str [options #f]) + (hash-ref encoding-cache str + (λ () + (define encoded + (for/vector ([c (in-string str)]) + (define cint (char->integer c)) + (number->string (hash-ref win-ansi-table cint cint) 16))) + (define glyphs (glyphs-for-string str)) + (define positions + (for/vector ([glyph (in-list glyphs)] + [advance (in-list (advances-for-glyphs glyphs))]) + (+glyph-position advance 0 0 0 (glyph-width glyph)))) + (list encoded positions)))) (define/override (string-width str size [options #f]) - (define glyphs (glyphs-for-string str)) - (define width (apply + (advances-for-glyphs glyphs))) + (match-define (list _ posns) (encode str options)) + (define width (for/sum ([p (in-vector posns)]) (glyph-position-x-advance p))) (define scale (/ size 1000.0)) (* width scale))))