methodize fonts

pitfall/pitfall/core.rkt

@@ -19,9 +19,13 @@
 
 (define current-pdf-version (make-parameter 1.3))
 (define current-auto-first-page (make-parameter #t))
+(define current-auto-helvetica (make-parameter #t))
 
 (define current-default-margins (make-parameter (margin 72 72 72 72)))
 
+(define current-font (make-parameter #f))
+(define current-font-size (make-parameter 12))
+
 ;; helpers
 
 (define (numberizer x #:round [round? #true])

pitfall/pitfall/document.rkt

@@ -37,9 +37,8 @@
                            'CreationDate (seconds->date (if (test-mode) 0 (current-seconds)) #f))])
 
     ;; initialize mixins
-    (inherit-field @ctm) ; from vector
-    (send this initFonts)
-    (inherit-field @font-families)
+    (inherit-field @ctm) ; from vector mixin
+    (inherit-field @font-families) (inherit font) ; from font mixin
     (send this initText)
     (send this initImages)
 
@@ -47,10 +46,11 @@
     (current-compress-streams? (hash-ref @options 'compress #t))
     (current-auto-first-page (hash-ref @options 'autoFirstPage #t))
     (when (current-auto-first-page) (add-page))
+    (when (current-auto-helvetica) (font "Helvetica"))
 
     ;; copy options
     (for ([(key val) (in-hash (hash-ref @options 'info (hasheq)))]) 
-         (hash-set! @info key val))
+      (hash-set! @info key val))
 
     (define/public (page) (first @pages))
 
@@ -82,15 +82,15 @@
       (write-bytes-out "%ÿÿÿÿ")
 
       (for ([page (in-list @pages)])
-           (send page end))
+        (send page end))
 
       (define doc-info (ref))
       (for ([(key val) (in-hash @info)])
-           (send doc-info set-key! key (if (string? val) (String val) val)))
+        (send doc-info set-key! key (if (string? val) (String val) val)))
       (send doc-info end)
     
       (for ([font (in-hash-values @font-families)])
-           (send font finalize))
+        (send font finalize))
 
       (send* (send @root get-key 'Pages)
         [set-key! 'Count (length @pages)]
@@ -104,8 +104,8 @@
       (write-bytes-out (format "0 ~a" (add1 (length @refs))))
       (write-bytes-out "0000000000 65535 f ")
       (for ([ref (in-list (reverse @refs))])
-           (write-bytes-out
-            (string-append (~r (get-field offset ref) #:min-width 10 #:pad-string "0") " 00000 n ")))
+        (write-bytes-out
+         (string-append (~r (get-field offset ref) #:min-width 10 #:pad-string "0") " 00000 n ")))
       (write-bytes-out "trailer")
       (write-bytes-out (convert (mhasheq 'Size (add1 (length @refs))
                                          'Root @root

pitfall/pitfall/fonts.rkt

@@ -12,97 +12,57 @@
 (define (fonts-mixin [% mixin-tester%])
   (class %
     (super-new)
-    ;; Lookup table for embedded fonts
-    (field [@font-families #f]
-           [_fontCount #f]
-           
-           ;; Font state
-           [_fontSize #f]
-           [_font #f]
-           [_registeredFonts #f])
+    (field [@font-families (mhash)]
+           [@font-count 0]
+           [(@current-font-size current-font-size) 12] ; font state used by text.rkt
+           [(@current-font current-font) #f] ; font state used by text.rkt
+           [@registered-fonts (mhash)])
+    
+    (define/public (font 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)]))
+      ;; check registered fonts if src is a string
+      (define cache-key (match src
+                          [(? string?) #:when (hash-has-key? @registered-fonts src)
+                                       (define ck src)
+                                       (set! src (· (hash-ref @registered-fonts ck) src))
+                                       (set! family (· (hash-ref @registered-fonts ck) family))
+                                       ck]
+                          [_ (match (or family src)
+                               [(? string? str) str]
+                               [_ #false])]))
+
+      (when size (font-size size))
+      (cond       ;; fast path: check if the font is already in the PDF
+        [(hash-ref @font-families cache-key #f)
+         => (λ (val) (set! @current-font val))]
+        [else ;; load the font
+         (set! @font-count (add1 @font-count))
+         (define id (format "F~a" @font-count))
+         (set! @current-font (PDFFont-open this src family id))
+         ;; check for existing font familes with the same name already in the PDF
+         ;; useful if the font was passed as a buffer
+         (match (hash-ref @font-families (· @current-font name) #f)
+           [(? values font) (set! @current-font font)]
+           [_ ;; save the font for reuse later
+            (when cache-key (hash-set! @font-families cache-key @current-font))
+            (hash-set! @font-families (· @current-font name) @current-font)])])
+      this)
+
+    (define/public (font-size size)
+      (set! @current-font-size size)
+      this)
+
+    (define/public (current-line-height [includeGap #f])
+      (send @current-font lineHeight @current-font-size includeGap))
+
+
+    (define/public (register-font name src [family #f])
+      (hash-set! @registered-fonts name
+                 (mhash 'src src 'family family))
+      this)))
 
-    (as-methods
-     initFonts
-     font
-     fontSize
-     currentLineHeight
-     registerFont)))
-
-
-(define/contract (initFonts this)
-  (->m void?)
-  (set-field! @font-families this (mhash))
-  (set-field! _fontCount this 0)
-
-  (set-field! _fontSize this 12)
-  (set-field! _font this #f)
-
-  (set-field! _registeredFonts this (mhash))
-
-  ;; set the default font
-  (send this font "Helvetica")
-  (void))
-
-
-(define/contract (font this src [size-or-family #f] [maybe-size #f])
-  ((any/c) ((or/c string? number? #f) (or/c number? #f)) . ->*m . object?)
-  
-  (match-define (list family size) (if (number? size-or-family)
-                                       (list #f size-or-family)
-                                       (list size-or-family maybe-size)))
-  ;; check registered fonts if src is a string
-  (define cacheKey (let ([this-rfs (· this _registeredFonts)])
-                     (cond
-                       [(and (string? src) (hash-has-key? this-rfs src))
-                        (define ck src)
-                        (set! src (· (hash-ref this-rfs ck) src))
-                        (set! family (· (hash-ref this-rfs ck) family))
-                        ck]
-                       [else (let ([ck (or family src)])
-                               (and (string? ck) ck))])))
-
-  (when size (fontSize this size))
-  
-
-  ;; fast path: check if the font is already in the PDF
-  (cond
-    [(hash-ref (· this @font-families) cacheKey #f) =>
-                                                   (λ (val)
-                                                     (set-field! _font this val))]
-    ;; load the font
-    [else
-     #;(println (format "Load font: ~a" src))
-     (define id (format "F~a" (increment-field! _fontCount this)))
-     (set-field! _font this (PDFFont-open this src family id))
-     
-     ;; check for existing font familes with the same name already in the PDF
-     ;; useful if the font was passed as a buffer
-     (let* ([this-ff (· this @font-families)]
-            [this-f (· this _font)]
-            [font (hash-ref this-ff (· this-f name) #f)])
-       (cond
-         [font (set-field! _font this font)]
-         ;; save the font for reuse later
-         [else
-          (when cacheKey (hash-set! this-ff cacheKey this-f))
-          (hash-set! this-ff (· this-f name) this-f)]))])
-  this)
-
-(define/contract (fontSize this size)
-  (number? . ->m . object?)
-  (set-field! _fontSize this size)
-  this)
-
-(define/contract (currentLineHeight this [includeGap #f])
-  (() (boolean?) . ->*m . number?)
-  (send (· this _font) lineHeight (· this _fontSize) includeGap))
-
-
-(define/contract (registerFont this name src [family #f])
-  ((string? path-string?) ((or/c string? #f)) . ->*m . object?)
-  (hash-set! (· this _registeredFonts) name
-             (mhash 'src src 'family family))
-  this)
 
 (module+ test
   (define fo (new (fonts-mixin))))

pitfall/pitfall/text.rkt

@@ -52,7 +52,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
 
 (define/contract (moveDown this [lines 1] #:factor [factor 1])
   (() (number? #:factor number?) . ->*m . object?)
-  (increment-field! y this (* factor (send this currentLineHeight #t) (+ lines (· this _line-gap))))
+  (increment-field! y this (* factor (send this current-line-height #t) (+ lines (· this _line-gap))))
   this)
 
 
@@ -89,7 +89,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
 (define/contract (widthOfString this str [options (mhash)])
   ((string?) (hash?) . ->*m . number?)
   #;(report str 'measuring-width-of)
-  (+ (send (· this _font) widthOfString str (· this _fontSize) (hash-ref options 'features #f))
+  (+ (send (· this current-font) widthOfString str (· this current-font-size) (hash-ref options 'features #f))
      (* (hash-ref options 'characterSpacing 0) (sub1 (string-length str)))))
 
 
@@ -128,7 +128,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
   ;; 181120 unsuppress the size tracking for now because it breaks test 04
   (if (not wrapper)
       (increment-field! x this (send this widthOfString text))
-      (increment-field! y (+ (send this currentLineHeight #t) line-gap)))
+      (increment-field! y (+ (send this current-line-height #t) line-gap)))
   (void))
 
 
@@ -150,7 +150,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
 
   ;; create link annotations if the link option is given
   (when (· options link)
-    (send this link x y-in (force renderedWidth) (· this currentLineHeight) (· options link)))
+    (send this link x y-in (force renderedWidth) (· this current-line-height) (· options link)))
 
   
   ;; create underline or strikethrough line
@@ -159,12 +159,12 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
     (unless (· options stroke)
       (define fill-colorArgs (· this @current-fill-color))
       (send this stroke-color . fill-colorArgs))
-    (define line-width (if (< (· this _fontSize) 10)
+    (define line-width (if (< (· this current-font-size) 10)
                           0.5
-                          (floor (/ (· this _fontSize) 10))))
+                          (floor (/ (· this current-font-size) 10))))
     (send this line-width line-width)
     (define d (if (· options underline) 1 2))
-    (define lineY (+ y-in (/ (· this currentLineHeight) d)))
+    (define lineY (+ y-in (/ (· this current-line-height) d)))
     (when (· options underline)
       (increment! lineY (- line-width)))
 
@@ -176,10 +176,10 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
   ;; flip coordinate system
   (send this save)
   (send this transform 1 0 0 -1 0 (· this page height))
-  (define y (- (· this page height) y-in (* (/ (· this _font ascender) 1000) (· this _fontSize))))
+  (define y (- (· this page height) y-in (* (/ (· this current-font ascender) 1000) (· this current-font-size))))
 
   ;; add current font to page if necessary
-  (hash-ref! (· this page fonts) (· this _font id) (λ () (· this _font ref)))
+  (hash-ref! (· this page fonts) (· this current-font id) (λ () (· this current-font ref)))
   
   ;; begin the text object
   (send this addContent "BT")
@@ -188,7 +188,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
   (send this addContent (format "1 0 0 1 ~a ~a Tm" (number x) (number y)))
 
   ;; font and font size
-  (send this addContent (format "/~a ~a Tf" (· this _font id) (number (· this _fontSize))))
+  (send this addContent (format "/~a ~a Tf" (· this current-font id) (number (· this current-font-size))))
 
   ;; rendering mode
   (let ([mode (cond
@@ -211,9 +211,9 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
   (match-define (list encoded-char-strs positions)
     (if (not (zero? wordSpacing))
         (error 'unimplemented-brach) ; todo
-        (send (· this _font) encode text (hash-ref options 'features #f))))
+        (send (· this current-font) encode text (hash-ref options 'features #f))))
   
-  (define scale (/ (· this _fontSize) 1000.0))
+  (define scale (/ (· this current-font-size) 1000.0))
   (define commands empty)
   (define last 0)
   

pitfall/ptest/test12.rkt

@@ -5,12 +5,12 @@
 
 (define (proc doc)
   ;; Register a font name for use later
-  (send doc registerFont "Charter" (path->string charter-path))
+  (send doc register-font "Charter" (path->string charter-path))
 
   ;; Set the font, draw some text
   (send* doc
     [font "Charter"]
-    [fontSize 25]
+    [font-size 25]
     [text "Some text with an embedded font" 100 100 (hash
                                                        'width #f)]))
 

pitfall/ptest/test13.rkt

@@ -5,12 +5,12 @@
 
 (define (proc doc)
   ;; Register a font name for use later
-  (send doc registerFont "Charter" (path->string charter-path))
+  (send doc register-font "Charter" (path->string charter-path))
 
   ;; Set the font, draw some text
   (send* doc
     [font "Charter"]
-    [fontSize 25]
+    [font-size 25]
     [text "Åcçénts äre în" 100 100 (hash 'width #f)]))
 
 ;; test against non-subsetted font version

pitfall/ptest/test14.rkt

@@ -6,12 +6,12 @@
 
 (define (proc doc)
   ;; Register a font name for use later
-  (send doc registerFont "the-font" (path->string ttf-path))
+  (send doc register-font "the-font" (path->string ttf-path))
 
   ;; Set the font, draw some text
   (send* doc
     [font "the-font"]
-    [fontSize 25]
+    [font-size 25]
     [text "Hola Hola" 100 100 (hash 'width #f)]))
 
 ;; test against non-subsetted font version

pitfall/ptest/test15.rkt

@@ -7,12 +7,12 @@
 
 (define (proc doc)
   ;; Register a font name for use later
-  (send doc registerFont "the-font" (path->string ttf-path))
+  (send doc register-font "the-font" (path->string ttf-path))
 
   ;; Set the font, draw some text
   (send* doc
     [font "the-font"]
-    [fontSize 25]
+    [font-size 25]
     [text "HTAVATH" 100 100 (hash 'width #f)]))
 
 

pitfall/ptest/test16.rkt

@@ -7,12 +7,12 @@
 
 (define (proc doc)
   ;; Register a font name for use later
-  (send doc registerFont "the-font" (path->string ttf-path))
+  (send doc register-font "the-font" (path->string ttf-path))
 
   ;; Set the font, draw some text
   (send* doc
     [font "the-font"]
-    [fontSize 100]
+    [font-size 100]
     [text "Wofine" 100 100 (hash 'width #f)]))
 
 

pitfall/ptest/test17.rkt

@@ -7,12 +7,12 @@
 
 (define (proc doc)
   ;; Register a font name for use later
-  (send doc registerFont "the-font" (path->string ttf-path))
+  (send doc register-font "the-font" (path->string ttf-path))
 
   ;; Set the font, draw some text
   (send* doc
     [font "the-font"]
-    [fontSize 50]
+    [font-size 50]
     [text "The fifth rifle" 100 100 (hash 'width #f)]))
 
 

pitfall/ptest/test18.rkt

@@ -7,12 +7,12 @@
 
 (define (proc doc)
   ;; Register a font name for use later
-  (send doc registerFont "the-font" (path->string ttf-path))
+  (send doc register-font "the-font" (path->string ttf-path))
 
   ;; Set the font, draw some text
   (send* doc
     [font "the-font"]
-    [fontSize 25]
+    [font-size 25]
     [text "In Xanadu did Kubla Khan" 100 100 (hash 'width #f)]
     [text "A stately pleasure dome decree:" 100 140 (hash 'width #f)]
     [text "Where Alph, the sacred river, ran" 100 180 (hash 'width #f)]

pitfall/ptest/test19.rkt

@@ -8,12 +8,12 @@
 
 (define (proc doc)
   ;; Register a font name for use later
-  (send doc registerFont "the-font" (path->string ttf-path))
+  (send doc register-font "the-font" (path->string ttf-path))
 
   ;; Set the font, draw some text
   (send* doc
     [font "the-font"]
-    [fontSize 100]
+    [font-size 100]
     [text "A&B" 100 100 (hash 'width #f)]
     [text "X&Y" 100 200 (hash 'width #f 'features '(ss03))]))
 

pitfall/ptest/test20.rkt

@@ -8,12 +8,12 @@
 
 (define (proc doc)
   ;; Register a font name for use later
-  (send doc registerFont "the-font" (path->string otf-path))
+  (send doc register-font "the-font" (path->string otf-path))
 
   ;; Set the font, draw some text
   (send* doc
     [font "the-font"]
-    [fontSize 40]
+    [font-size 40]
     [text "Embedded OTF" 100 100 (hash 'width #f)]))
 
 ;; test against non-subsetted font version

pitfall/ptest/test4.rkt

@@ -4,59 +4,59 @@
 (define (proc doc)
   (send* doc
      [font "Courier-Bold"]
-     [fontSize 10]
+     [font-size 10]
      [text "Hello"]
      [translate -30 30]
      [font "Courier-BoldOblique"]
-     [fontSize 11]
+     [font-size 11]
      [text "Hello"]
      [translate -30 30]
      [font "Courier-Oblique"]
-     [fontSize 12]
+     [font-size 12]
      [text "Hello"]
      [translate -30 30]
      [font "Courier"]
-     [fontSize 14]
+     [font-size 14]
      [text "Hello"]
      [translate -30 30]
      [font "Helvetica-Bold"]
-     [fontSize 16]
+     [font-size 16]
      [text "Hello"]
      [translate -30 30]
      [font "Helvetica-BoldOblique"]
-     [fontSize 18]
+     [font-size 18]
      [text "Hello"]
      [translate -30 30]
      [font "Helvetica-Oblique"]
-     [fontSize 20]
+     [font-size 20]
      [text "Hello"]
      [translate -30 30]
      [font "Helvetica"]
-     [fontSize 22]
+     [font-size 22]
      [text "Hello"]
      [translate -30 30]
      [font "Symbol"]
-     [fontSize 24]
+     [font-size 24]
      [text "Hello"]
      [translate -30 30]
      [font "Times-Bold"]
-     [fontSize 26]
+     [font-size 26]
      [text "Hello"]
      [translate -30 30]
      [font "Times-BoldItalic"]
-     [fontSize 28]
+     [font-size 28]
      [text "Hello"]
      [translate -30 30]
      [font "Times-Italic"]
-     [fontSize 30]
+     [font-size 30]
      [text "Hello"]
      [translate -30 30]
      [font "Times-Roman"]
-     [fontSize 32]
+     [font-size 32]
      [text "Hello"]
      [translate -30 30]
      [font "ZapfDingbats"]
-     [fontSize 34]
+     [font-size 34]
      [text "Hello"]))
 
 (define-runtime-path this "test4rkt.pdf")

pitfall/ptest/test5.rkt

@@ -6,7 +6,7 @@
 (define (proc doc)
   (send* doc
   [font "Times-Italic"]
-  [fontSize 25]
+  [font-size 25]
   [text "Some fantastic text!" 100 100 (hash 'lineBreak #f)]
   [image death 100 160 (hash 'width 412)]))
 

pitfall/ptest/test7.rkt

@@ -6,7 +6,7 @@
 (define (proc doc)
   (send* doc
   [font "Times-Italic"]
-  [fontSize 25]
+  [font-size 25]
   [text "Here comes a JPEG!" 100 100 (hash 'lineBreak #f)]
   [image test-jpeg 100 160 (hash 'width 412)]))
 

pitfall/ptest/test8.rkt

@@ -6,7 +6,7 @@
 (define (proc doc)
   (send* doc
   [font "Helvetica-Bold"]
-  [fontSize 25]
+  [font-size 25]
   [text "Another fantastic pic" 100 100 (hash 'lineBreak #f)]
   [image pic 100 160 (hash 'width 412)]))
 

pitfall/ptest/testrkt.rkt

@@ -14,20 +14,20 @@ doc.info['Title'] = 'Test Document'
 doc.info['Author'] = 'Devon Govett'
 
 # Register a font name for use later
-doc.registerFont('Charter', 'charter.ttf')
+doc.register-font('Charter', 'charter.ttf')
 
 # Set the font, draw some text, and embed an image
 doc.font('Charter')
-   .fontSize(25)
+   .font-size(25)
    .text('Some text with an embedded font!', 100, 100)
-   .fontSize(18)
+   .font-size(18)
    .text('PNG and JPEG images:')
    .image('test.png', 100, 160, width: 412)
    .image('test.jpeg', 190, 400, height: 300)
 
 # Add another page
 doc.add-page()
-   .fontSize(25)
+   .font-size(25)
    .text 'Here is some vector graphics...', 100, 100
 
 # Draw a triangle and a circle