tidy

pitfall/pitfall/document.rkt

@@ -94,7 +94,7 @@
   (ref-end doc-info)
     
   (for ([font (in-hash-values ($doc-font-families doc))])
-    (send font end))
+    (send font font-end))
 
   (define pages-ref (dict-ref ($doc-root doc) 'Pages))
   (dict-set! pages-ref 'Count (length ($doc-pages doc)))

pitfall/pitfall/embedded-font.rkt

@@ -12,7 +12,7 @@
   sugar/unstable/dict
   "font.rkt"
   fontland)
-(provide EmbeddedFont)
+(provide embedded-font%)
 
 #|
 approximates
@@ -32,14 +32,17 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee
    (for/list ([code (in-list codePoints)])
      (~r code #:base 16 #:min-width 4 #:pad-string "0"))))
 
-(define EmbeddedFont
-  (class PDFFont
-    (init-field font id)
-    (field [subset (create-subset font)]
+(define embedded-font%
+  (class pdf-font%
+    (init-field name-in [id #f])
+    (field [font (cond
+                   [(string? name-in) (open-font name-in)]
+                   [(path? name-in) (open-font (path->string name-in))])]
+           [subset (create-subset font)]
            ;; we make `unicode` and `width` fields integer-keyed hashes not lists
            ;; because they offer better random access and growability 
-           [unicode (mhash 0 '(0))] ; always include the missing glyph (gid = 0)
-           [widths (mhash 0 (glyph-advance-width (get-glyph font 0)))]
+           [unicode (mhasheqv 0 '(0))] ; always include the missing glyph (gid = 0)
+           [widths (mhasheqv 0 (glyph-advance-width (get-glyph font 0)))]
            ;; always include the width of the missing glyph (gid = 0)
            [name (font-postscript-name font)]
            [scale (/ 1000 (font-units-per-em font))])
@@ -49,6 +52,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee
                [line-gap (* (font-linegap font) scale)])
 
     (inherit-field [@ascender ascender]
+                   [@bbox bbox]
                    [@descender descender]
                    [@dictionary dictionary])
 
@@ -94,9 +98,11 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee
       (ref-write font-file (get-output-bytes (encode-to-port subset)))
       (ref-end font-file)
 
-      (define family-class (if (has-table? font 'OS/2)
-                               (floor (/ (hash-ref (get-OS/2-table font) 'sFamilyClass) 256)) ; >> 8
-                               0))
+      (define family-class
+        (if (has-table? font 'OS/2)
+            (floor (/ (hash-ref (get-OS/2-table font) 'sFamilyClass) 256)) ; >> 8
+            0))
+      
       ;; font descriptor flags
       (match-define (list FIXED_PITCH SERIF SYMBOLIC SCRIPT _UNUSED NONSYMBOLIC ITALIC)
         (map (λ (x) (expt 2 x)) (range 7)))
@@ -113,18 +119,16 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee
       (define tag (list->string (for/list ([i (in-range 6)])
                                   (integer->char (random 65 (+ 65 26))))))
       (define name (string->symbol (string-append tag "+" (font-postscript-name font))))
-      (define bbox (font-bbox font))
       (define descriptor (make-ref
-                          (mhash
+                          (mhasheq
                            'Type 'FontDescriptor
                            'FontName name
                            'Flags flags
-                           'FontBBox (map (λ (x) (* scale x))
-                                          (bbox->list bbox))
+                           'FontBBox (map (λ (x) (* scale x)) (bbox->list @bbox))
                            'ItalicAngle (font-italic-angle font)
                            'Ascent @ascender
                            'Descent @descender
-                           'CapHeight (* (or (font-cap-height font) (font-ascent font)) scale)
+                           'CapHeight (* (or (font-cap-height font) @ascender) scale)
                            'XHeight (* (or (font-x-height font) 0) scale)
                            'StemV 0)))
 
@@ -132,12 +136,12 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee
       (ref-end descriptor)
 
       (define descendant-font (make-ref
-                               (mhash
+                               (mhasheq
                                 'Type 'Font
-                                'Subtype (string->symbol (string-append "CIDFontType" (if isCFF "0" "2")))
+                                'Subtype (if isCFF 'CIDFontType0 'CIDFontType2)
                                 'BaseFont name
                                 'CIDSystemInfo
-                                (mhash
+                                (mhasheq
                                  'Registry "Adobe"
                                  'Ordering "Identity"
                                  'Supplement 0)
@@ -146,18 +150,18 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee
                                              (hash-ref widths idx (λ () (error 'embed (format "hash key ~a not found" idx)))))))))
       (ref-end descendant-font)
       
-      [dict-set! @dictionary 'Type 'Font]
-      [dict-set! @dictionary 'Subtype 'Type0]
-      [dict-set! @dictionary 'BaseFont name]
-      [dict-set! @dictionary 'Encoding 'Identity-H]
-      [dict-set! @dictionary 'DescendantFonts (list descendant-font)]
-      [dict-set! @dictionary 'ToUnicode (toUnicodeCmap)]
+      (dict-set*! @dictionary
+                  'Type 'Font
+                  'Subtype 'Type0
+                  'BaseFont name
+                  'Encoding 'Identity-H
+                  'DescendantFonts (list descendant-font)
+                  'ToUnicode (to-unicode-cmap))
 
       (ref-end @dictionary))
 
-
-    (define/public (toUnicodeCmap)
-      (define cmap (make-ref))
+    (define/public (to-unicode-cmap)
+      (define cmap-ref (make-ref))
       (define entries
         (for/list ([idx (in-range (length (hash-keys unicode)))])
           (define codepoints (hash-ref unicode idx))
@@ -191,19 +195,18 @@ end
 HERE
         )
   
-      (ref-write cmap (format unicode-cmap-str (to-hex (sub1 (length entries))) (string-join entries " ")))
-      (ref-end cmap)
-      cmap)))
+      (ref-write cmap-ref (format unicode-cmap-str (to-hex (sub1 (length entries))) (string-join entries " ")))
+      (ref-end cmap-ref)
+      cmap-ref)))
 
 (module+ test
   (require rackunit fontland sugar/unstable/js)
-  (define f (open-font "../ptest/assets/charter.ttf"))
-  (define ef (make-object EmbeddedFont f #f))
+  (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) (mhash 0 278))
+  (check-equal? (· ef widths) (mhasheqv 0 278))
   (check-equal? (glyph-advance-width (get-glyph (· ef font) H-gid)) 738))

pitfall/pitfall/font-open.rkt

@@ -1,20 +0,0 @@
-#lang racket/base
-(require
-  racket/class
-  "standard-font.rkt"
-  "font.rkt"
-  fontland
-  "embedded.rkt")
-(provide PDFFont-open)
-
-(define (PDFFont-open src family id)
-  (cond
-    [(and (string? src) (standard-font? src)) (make-object StandardFont src id)]
-    [else
-     (define font
-       (cond
-         [(string? src) (open-font src)]
-         [(path? src) (open-font (path->string src))]
-         ;; todo: other font-loading cases
-         [else (raise-argument-error 'PDFFont-open "loadable font thingy" src)]))
-     (make-object EmbeddedFont font id)]))

pitfall/pitfall/font.rkt

@@ -1,8 +1,11 @@
 #lang racket/base
 (require racket/class "reference.rkt")
-(provide PDFFont)
+(provide pdf-font%)
 
-(define PDFFont
+;; 181227 structifying the fonts didn't do anything for speed
+;; the class is implementation is equally fast, and less code
+
+(define pdf-font%
   (class object%
     (super-new)
     (init-field [(@ascender ascender) #f]
@@ -19,7 +22,7 @@
         (set! @dictionary (make-ref)))
       @dictionary)
 
-    (define/public (end)
+    (define/public (font-end)
       (unless (or @embedded (not @dictionary))
         (embed)
         (set! @embedded #t)))
@@ -27,8 +30,3 @@
     (define/public (line-height size [include-gap #f])
       (define gap (if include-gap @line-gap 0))
       (* (/ (+ @ascender gap (- @descender)) 1000.0) size))))
-
-
-
-
-

pitfall/pitfall/fonts.rkt

@@ -1,31 +1,28 @@
 #lang debug racket/base
 (require
   "core.rkt"
-  racket/class
   racket/match
-  sugar/unstable/dict
-  "font-open.rkt")
+  racket/class
+  "standard-font.rkt"
+  "embedded-font.rkt")
 (provide (all-defined-out))
 
+(define (open-pdf-font name id)
+  (make-object (if (standard-font-name? name) standard-font% embedded-font%) name id))
+
 (define (current-line-height doc [include-gap #f])
   (send ($doc-current-font doc) line-height ($doc-current-font-size doc) include-gap))
 
-(define (font doc src [size-or-family #f] [maybe-size #f])
-  (match-define (list family size)
-    (match size-or-family
-      [(? number?) (list #f size-or-family)]
-      [_ (list size-or-family maybe-size)]))
+(define (font doc src [size #f])
   ;; check registered fonts if src is a string
   (define cache-key
     (match src
       [(? string?) #:when (hash-has-key? ($doc-registered-fonts doc) src)
                    (define ck src)
                    (set! src (hash-ref (hash-ref ($doc-registered-fonts doc) ck) 'src))
-                   (set! family (hash-ref (hash-ref ($doc-registered-fonts doc) ck) 'family))
                    ck]
-      [_ (match (or family src)
-           [(? string? str) str]
-           [_ #false])]))
+      [(? string?) src]
+      [_ #false]))
       
   (when size (font-size doc size))
 
@@ -34,7 +31,7 @@
     [_ ; if not, load the font
      (define font-index (add1 (length (hash-keys ($doc-font-families doc)))))
      (define id (string->symbol (format "F~a" font-index)))
-     (set-$doc-current-font! doc (PDFFont-open src family id))
+     (set-$doc-current-font! doc (open-pdf-font src id))
      ;; check for existing font families with the same name already in the PDF
      (match (hash-ref ($doc-font-families doc) (get-field name ($doc-current-font doc)) #f)
        [(? values font) (set-$doc-current-font! doc font)]
@@ -47,7 +44,6 @@
   (set-$doc-current-font-size! doc size)
   doc)
 
-(define (register-font doc name src [family #f])
-  (hash-set! ($doc-registered-fonts doc) name (make-hash (list (cons 'src src)
-                                                               (cons 'family family))))
+(define (register-font doc name src)
+  (hash-set! ($doc-registered-fonts doc) name (make-hasheq (list (cons 'src src))))
   doc)

pitfall/pitfall/standard-font.rkt

@@ -12,12 +12,12 @@
   racket/list
   with-cache)
 
-(provide standard-font? StandardFont)
+(provide standard-font-name? standard-font%)
 
 (define-runtime-path here ".")
 
-(define StandardFont
-  (class PDFFont
+(define standard-font%
+  (class pdf-font%
     (init-field name id)
 
     (match-define (list atts gws kps) (parse-afm (open-input-file (build-path here (format "data/~a.afm" name)))))
@@ -95,16 +95,16 @@
                         Times-Roman
                         ZapfDingbats)))
 
-(define (standard-font? name) (and (member name standard-fonts) #t))
+(define (standard-font-name? name) (and (string? name) (member name standard-fonts) #t))
 
 (module+ test
   (require rackunit)
-  (check-true (standard-font? "Helvetica"))
-  (check-true (standard-font? "Courier"))
-  (check-true (standard-font? "ZapfDingbats"))
-  (check-false (standard-font? "Not A Font Name"))
+  (check-true (standard-font-name? "Helvetica"))
+  (check-true (standard-font-name? "Courier"))
+  (check-true (standard-font-name? "ZapfDingbats"))
+  (check-false (standard-font-name? "Not A Font Name"))
   
-  (define stdfont (make-object StandardFont "Helvetica" #f)))
+  (define stdfont (make-object standard-font% "Helvetica" #f)))
 
 
 (define (make-kern-table-key left right)