cache out

pitfall/pitfall/afm-font.rkt

@@ -1,9 +1,10 @@
-#lang racket/base
+#lang debug racket/base
 (require
   racket/class
   racket/match
   racket/string
   racket/list
+  with-cache
   sugar/unstable/dict)
 
 (provide AFMFont AFMFont-open)
@@ -11,17 +12,21 @@
 (define (AFMFont-open filename)
   (make-object AFMFont (open-input-file filename)))
 
-(define AFMFont
-  (class object%
-    (super-new)
-    (init-field contents)
-    (field [@attributes (mhasheq)]
-           [@glyph-widths (mhash)]
-           [boundingBoxes (mhash)]
-           [@kern-pairs (mhash)])
-
-    (for/fold ([last-section #f])
-              ([line (in-lines contents)])
+(define (make-kern-table-key left right)
+  (cons left right))
+
+(define (parse-afm input-file)
+  (parameterize ([*current-cache-keys* (list (λ () (file-or-directory-modify-seconds (path->string (object-name input-file)))))])
+    (with-cache (path-replace-extension (object-name input-file) #".rktd")
+      (λ ()
+        (define @attributes (make-hasheq))
+        (define @glyph-widths (make-hash))
+        (define @kern-pairs (make-hash))
+        (for/fold ([last-section #f]
+                   #:result (list (hash->list @attributes)
+                                  (hash->list @glyph-widths)
+                                  (hash->list @kern-pairs)))
+                  ([line (in-lines input-file)])
           (define current-section (cond
                                     [(regexp-match #px"(?<=^Start)\\w+" line) => car]
                                     [(regexp-match #px"(?<=^End)\\w+" line) #f]
@@ -51,7 +56,17 @@
              (when (string-prefix? line "KPX")
                (match-define (list _ left right val) (string-split line))
                (hash-set! @kern-pairs (make-kern-table-key left right) (string->number val)))])
-      current-section)
+          current-section)))))
+
+(define AFMFont
+  (class object%
+    (super-new)
+    (init-field input-file)
+
+    (match-define (list atts gws kps) (parse-afm input-file))
+    (field [@attributes (make-hasheq atts)]
+           [@glyph-widths (make-hash gws)]
+           [@kern-pairs (make-hash kps)])
     
     (field [charWidths (for/list ([i (in-range 256)])
                          (hash-ref @glyph-widths (vector-ref characters i) #f))])
@@ -61,9 +76,6 @@
     (field [(@descender descender) (string->number (or (hash-ref @attributes 'Descender #f) "0"))])
     (field [line-gap (- (list-ref @bbox 3) (list-ref @bbox 1) @ascender @descender)])
 
-    (define/public (make-kern-table-key left right)
-      (cons left right))
-
     (define/public (encode-text str)
       (for/list ([c (in-string str)])
         (define cint (char->integer c))