simplify typeset loop

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

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

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

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

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