better getter

pitfall/fontkit/font.rkt

@@ -7,6 +7,12 @@ approximates
 https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
 |#
 
+(require (for-syntax "tables.rkt"))
+(define-macro (define-table-getters)
+  (with-pattern ([(TABLE-TAG ...) (hash-keys table-codecs)])
+    #'(begin
+        (define/public (TABLE-TAG) (_getTable 'TABLE-TAG)) ...)))
+
 ;; This is the base class for all SFNT-based font formats in fontkit.
 ;;  It supports TrueType, and PostScript glyphs, and several color glyph formats.
 (define-subclass object% (TTFFont stream [_src #f])
@@ -29,6 +35,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
       (raise-argument-error '_getTable "table that exists in font" table-tag))
     (hash-ref! _tables table-tag (_decodeTable table-tag))) ; get table from cache, load if not there
 
+  (define-table-getters)
+
   (define/public (_getTableStream tag)
     (define table (hash-ref (· this directory tables) tag))
     (cond
@@ -86,25 +94,25 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
 ;; The size of the font’s internal coordinate grid
 (define/contract (unitsPerEm this)
   (->m number?)
-  (hash-ref (send this _getTable 'head) 'unitsPerEm))
+  (· this head unitsPerEm))
 
 
 ;; The font’s [ascender](https://en.wikipedia.org/wiki/Ascender_(typography))
 (define/contract (ascent this)
   (->m number?)
-  (hash-ref (send this _getTable 'hhea) 'ascent))
+  (· this hhea ascent))
 
 
 ;; The font’s [descender](https://en.wikipedia.org/wiki/Descender)
 (define/contract (descent this)
   (->m number?)
-  (hash-ref (send this _getTable 'hhea) 'descent))
+  (· this hhea descent))
 
 
 ;; The amount of space that should be included between lines
 (define/contract (lineGap this)
   (->m number?)
-  (hash-ref (send this _getTable 'hhea) 'lineGap))
+  (· this hhea lineGap))
 
 
 (define/contract (underlinePosition this)
@@ -150,11 +158,10 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
 ;; The font’s bounding box, i.e. the box that encloses all glyphs in the font.
 (define/contract (bbox this)
   (->m (is-a?/c BBox))
-  (define head-table (send this _getTable 'head))
+  (make-object BBox (· this head xMin)
-  (make-object BBox (· head-table xMin)
+    (· this head yMin)
-    (· head-table yMin)
+    (· this head xMax)
-    (· head-table xMax)
+    (· this head yMax)))
-    (· head-table yMax)))
 
 
 (define/contract (_cmapProcessor this)

pitfall/fontkit/hmtx.rkt

@@ -15,9 +15,9 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/hmtx.js
 
 (define hmtx (+Rhmtx
               (dictify
-               'metrics (+LazyArray HmtxEntry (λ (this-array) (· (send (· this-array parent) _getTable 'hhea) numberOfMetrics)))
+               'metrics (+LazyArray HmtxEntry (λ (this-array) (· this-array parent hhea numberOfMetrics)))
-               'bearings (+LazyArray int16be (λ (this-array) (- (· (send (· this-array parent) _getTable 'maxp) numGlyphs)
+               'bearings (+LazyArray int16be (λ (this-array) (- (· this-array parent maxp numGlyphs)
-                                                                (· (send (· this-array parent) _getTable 'hhea) numberOfMetrics)))))))
+                                                                (· this-array parent hhea numberOfMetrics)))))))
 
 
 

pitfall/fontkit/loca.rkt

@@ -35,7 +35,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/loca.js
       (hash-update! this-val 'offsets (λ (offsets) (map (curryr / 2) offsets))))))
 
 (define loca (make-object Rloca
-               (λ (parent) (hash-ref (send parent _getTable 'head) 'indexToLocFormat)) 
+               (λ (parent) (· parent head indexToLocFormat)) 
                (dictify
                 0 (dictify 'offsets (+Array uint16be))
                 1 (dictify 'offsets (+Array uint32be)))))

pitfall/fontkit/post.rkt

@@ -35,7 +35,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/post.js
                   2.5 (append header-fields (dictify 'numberOfGlyphs uint16be
                                                      'offsets (+Array uint8)))
                   3 (append header-fields null)
-                  4 (append header-fields (dictify 'map (+Array uint32be (λ (t) (· (send (· t parent) _getTable 'maxp) numGlyphs)))))))))
+                  4 (append header-fields (dictify 'map (+Array uint32be (λ (t) (· t parent maxp numGlyphs)))))))))
 
 (test-module
  (define ip (open-input-file charter-path))

pitfall/fontkit/subset.rkt

@@ -65,9 +65,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
   (define glyf (send glyph _decode))
 
   ;; get the offset to the glyph from the loca table
-  (define loca (send (· this font) _getTable 'loca))
+  (match-define (list curOffset nextOffset) (take (drop (· this font loca offsets) gid) 2))
-  (define curOffset (list-ref (· loca offsets) gid))
-  (define nextOffset (list-ref (· loca offsets) (add1 gid)))
 
   (define stream (send (· this font) _getTableStream 'glyf))
   (send stream pos (+ (send stream pos) curOffset))
@@ -113,17 +111,17 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
     (define gid (list-ref (· this glyphs) idx))
     (send this _addGlyph gid))
 
-  (define maxp (cloneDeep (send (· this font) _getTable 'maxp)))
+  (define maxp (cloneDeep (· this font maxp)))
   (hash-set! maxp 'numGlyphs (length (· this glyf)))
 
   ;; populate the new loca table
   (hash-update! (· this loca) 'offsets (λ (vals) (append vals (list (· this offset)))))
   (loca-preEncode (· this loca))
 
-  (define head (cloneDeep (send (· this font) _getTable 'head)))
+  (define head (cloneDeep (· this font head)))
   (hash-set! head 'indexToLocFormat (· this loca version))
   
-  (define hhea (cloneDeep (send (· this font) _getTable 'hhea)))
+  (define hhea (cloneDeep (· this font hhea)))
   (hash-set! hhea 'numberOfMetrics (length (· this hmtx metrics)))
 
   (send Directory encode stream
@@ -133,11 +131,11 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
                 'hhea hhea
                 'loca (· this loca)
                 'maxp maxp
-                'cvt_ (send (· this font) _getTable 'cvt_)
+                'cvt_ (· this font cvt_)
-                'prep (send (· this font) _getTable 'prep)
+                'prep (· this font prep)
                 'glyf (· this glyf)
                 'hmtx (· this hmtx)
-                'fpgm (send (· this font) _getTable 'fpgm)
+                'fpgm (· this font fpgm)
                 )))
 
   #;(report* (bytes-length (send stream dump)) (send stream dump))

pitfall/fontkit/ttfglyph.rkt

@@ -80,7 +80,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js
   ;; Decodes the glyph data into points for simple glyphs,
   ;; or components for composite glyphs
   (define/public (_decode)
-    (define offsets (· (send _font _getTable 'loca) offsets))
+    (define offsets (· _font loca offsets))
     (match-define (list glyfPos nextPos) (take (drop offsets id) 2))
 
     ;; Nothing to do if there is no data for this glyph

pitfall/pitfall/embedded.rkt

@@ -79,16 +79,16 @@ For now, we'll just measure width of the characters.
   (send fontFile end (send (send (· this subset) encodeStream) dump))
 
   (define familyClass (let ([val (if (send (· this font) has-table? 'OS/2)
-                          (· (send (· this font) _getTable 'OS/2) sFamilyClass)
+                          (· this font OS/2 sFamilyClass)
                           0)])
                         (floor (/ val 256)))) ; equivalent to >> 8
 
   (define flags (+
-                 (if (not (zero? (· (send (· this font) _getTable 'post) isFixedPitch))) (expt 2 0) 0)
+                 (if (not (zero? (· this font post isFixedPitch))) (expt 2 0) 0)
                  (if (<= 1 familyClass 7) (expt 2 1) 0)
                  (expt 2 2) ; assume the font uses non-latin characters
                  (if (= familyClass 10) (expt 2 3) 0)
-                 (if (· (send (· this font) _getTable 'head) macStyle italic) (expt 2 6) 0)))
+                 (if (· this font head macStyle italic) (expt 2 6) 0)))
 
   ;; generate a random tag (6 uppercase letters. 65 is the char code for 'A')
   (when (test-mode) (random-seed 0))