diff --git a/quad/quad/atomize.rkt b/quad/quad/atomize.rkt index cf93a10c..ecc47d5d 100644 --- a/quad/quad/atomize.rkt +++ b/quad/quad/atomize.rkt @@ -7,13 +7,13 @@ (flatten (let loop ([x x][loop-attrs default-attrs]) (cond - [(symbol? x) ($shim (make-attrs) 0 x)] + [(symbol? x) ($shim (make-attrs) #f x)] [(string? x) (for/list ([c (in-string x)]) - (cons ($shim (make-attrs) 0 0) + (cons ($shim (make-attrs) #f 0) (case c - [(#\space #\newline #\return) ($white loop-attrs 0 c)] - [else ($black loop-attrs 0 c)])))] + [(#\space #\newline #\return) ($white loop-attrs #f c)] + [else ($black loop-attrs #f c)])))] [else (map (λ(xi) (loop xi ((quad-attrs x) . override-with . loop-attrs))) (quad-val x))]))))) diff --git a/quad/quad/measure-chars.rkt b/quad/quad/measure-chars.rkt index c8feafeb..8fe9935f 100644 --- a/quad/quad/measure-chars.rkt +++ b/quad/quad/measure-chars.rkt @@ -6,59 +6,25 @@ (let ([measure-cache (make-hash)] [glyph-idx-cache (make-hash)] [glyph-width-cache (make-hash)] - [em-size-cache (make-hash)]) + [em-size-cache (make-hash)] + [ft-library (FT_Init_FreeType)] + [ft-face-cache (make-hash)]) (λ (font-pathstring char) (define (do-measure) - (define ft-library (FT_Init_FreeType)) - (define ft-face (FT_New_Face ft-library font-pathstring 0)) - (define prev-glyph-idx #f) - (define sum + (define ft-face (hash-ref! ft-face-cache font-pathstring (λ () (FT_New_Face ft-library font-pathstring 0)))) + (define width (let ([glyph-idx (hash-ref! glyph-idx-cache (cons char font-pathstring) (λ () (FT_Get_Char_Index ft-face (char->integer char))))]) (hash-ref! glyph-width-cache (cons glyph-idx font-pathstring) (λ () (FT_Load_Glyph ft-face glyph-idx FT_LOAD_NO_RECURSE) ; loads into FTFace's 'glyph' slot - (FT_Vector-x (FT_GlyphSlotRec-advance (FT_FaceRec-glyph ft-face))))))) + (define width (FT_Vector-x (FT_GlyphSlotRec-advance (FT_FaceRec-glyph ft-face)))) + (* width 1.0))))) ; store as inexact (define em-size - (hash-ref! em-size-cache font-pathstring (λ () (+ (FT_FaceRec-units_per_EM ft-face) 0.0)))) - ; will anything bad happen if I skip these? - (FT_Done_Face ft-face) - (FT_Done_FreeType ft-library) - (/ sum em-size)) ; normalize to em size + (hash-ref! em-size-cache font-pathstring (λ () (FT_FaceRec-units_per_EM ft-face)))) + (/ width em-size)) (hash-ref! measure-cache (cons font-pathstring char) do-measure)))) -(define measure-chars - (let ([measure-cache (make-hash)] - [glyph-idx-cache (make-hash)] - [glyph-width-cache (make-hash)] - [kern-cache (make-hash)]) - (λ (font-pathstring chars) - (define (do-measure) - (define ft-library (FT_Init_FreeType)) - (define ft-face (FT_New_Face ft-library font-pathstring 0)) - (define prev-glyph-idx #f) - (define sum - (for/sum ([char (in-list chars)]) - (define glyph-idx (hash-ref! glyph-idx-cache (cons char font-pathstring) - (λ () (FT_Get_Char_Index ft-face (char->integer char))))) - (define glyph-width (hash-ref! glyph-width-cache (cons glyph-idx font-pathstring) - (λ () - (FT_Load_Glyph ft-face glyph-idx FT_LOAD_NO_RECURSE) ; loads into FTFace's 'glyph' slot - (FT_Vector-x (FT_GlyphSlotRec-advance (FT_FaceRec-glyph ft-face)))))) - (define kern (if prev-glyph-idx - (hash-ref! kern-cache (cons prev-glyph-idx (cons glyph-idx font-pathstring)) - (λ () - (FT_Vector-x (FT_Get_Kerning ft-face prev-glyph-idx glyph-idx FT_KERNING_UNSCALED)))) - 0)) - (set! prev-glyph-idx glyph-idx) - (+ glyph-width kern))) - ; will anything bad happen if I skip these? - (FT_Done_Face ft-face) - (FT_Done_FreeType ft-library) - sum) - (hash-ref! measure-cache (cons font-pathstring chars) do-measure)))) - (module+ test (require rackunit) - (check-equal? (measure-chars "charter.ttf" '(#\f)) 321)) - + (check-equal? (measure-char "charter.ttf" #\f) .321)) \ No newline at end of file diff --git a/quad/quad/measure.rkt b/quad/quad/measure.rkt index 17371b3a..e62a7713 100644 --- a/quad/quad/measure.rkt +++ b/quad/quad/measure.rkt @@ -3,7 +3,7 @@ (provide (all-defined-out)) (define (measure! q) - (quad-posn-set! q + (quad-dim-set! q (cond [(or ($black? q) ($white? q)) (* (measure-char (quad-font q) (quad-val q)) (quad-font-size q))] diff --git a/quad/quad/quads.rkt b/quad/quad/quads.rkt index ec35ee8b..70b1a25b 100644 --- a/quad/quad/quads.rkt +++ b/quad/quad/quads.rkt @@ -2,7 +2,7 @@ (provide (all-defined-out)) (require (for-syntax racket/string racket/base racket/syntax)) -(struct $quad (attrs posn val) #:transparent #:mutable) +(struct $quad (attrs dim val) #:transparent #:mutable) (struct $black $quad () #:transparent) (struct $white $quad () #:transparent) (struct $skip $quad () #:transparent) @@ -37,16 +37,16 @@ measure (line width) (hasheq 'size size 'font font)) -(define (quad-posn q) - ($quad-posn q)) +(define (quad-dim q) + ($quad-dim q)) (define (quad-font q) (hash-ref (quad-attrs q) 'font)) (define (quad-font-size q) (hash-ref (quad-attrs q) 'size)) -(define (quad-posn-set! q val) - (set-$quad-posn! q val)) +(define (quad-dim-set! q val) + (set-$quad-dim! q val)) (define (override-with dest source) ;; replace missing values in dest with values from source diff --git a/quad/quad/typeset.rkt b/quad/quad/typeset.rkt index 6145054b..38ebf2b6 100644 --- a/quad/quad/typeset.rkt +++ b/quad/quad/typeset.rkt @@ -3,17 +3,17 @@ (require "measure.rkt") (define last-bp-k #f) -(define line-measure 60) +(define line-measure 80) (define (typeset qs) (for/fold ([line-pos 0]) ([q (in-vector qs)]) - (measure! q) - (when (and ($white? q) (let/cc bp-k (set! last-bp-k bp-k) #f)) - (quad-posn-set! q 'break-line)) + (unless (quad-dim q) (measure! q)) (cond - [(eq? 'break-line (quad-posn q)) 0] - [else (define next-line-pos (+ line-pos (quad-posn q))) + [(and ($white? q) (let/cc bp-k (set! last-bp-k bp-k) #f)) + (quad-dim-set! q 'break-line) + 0] + [else (define next-line-pos (+ line-pos (quad-dim q))) (if (> next-line-pos line-measure) (last-bp-k #t) next-line-pos)]))