diff --git a/pitfall/fontkit/font.rkt b/pitfall/fontkit/font.rkt index 9fd62162..8f5f944e 100644 --- a/pitfall/fontkit/font.rkt +++ b/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 (· head-table xMin) - (· head-table yMin) - (· head-table xMax) - (· head-table yMax))) + (make-object BBox (· this head xMin) + (· this head yMin) + (· this head xMax) + (· this head yMax))) (define/contract (_cmapProcessor this) diff --git a/pitfall/fontkit/hmtx.rkt b/pitfall/fontkit/hmtx.rkt index 07d96633..dae90bc0 100644 --- a/pitfall/fontkit/hmtx.rkt +++ b/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))) - 'bearings (+LazyArray int16be (λ (this-array) (- (· (send (· this-array parent) _getTable 'maxp) numGlyphs) - (· (send (· this-array parent) _getTable 'hhea) numberOfMetrics))))))) + 'metrics (+LazyArray HmtxEntry (λ (this-array) (· this-array parent hhea numberOfMetrics))) + 'bearings (+LazyArray int16be (λ (this-array) (- (· this-array parent maxp numGlyphs) + (· this-array parent hhea numberOfMetrics))))))) diff --git a/pitfall/fontkit/loca.rkt b/pitfall/fontkit/loca.rkt index afbde9d5..26541c32 100644 --- a/pitfall/fontkit/loca.rkt +++ b/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))))) diff --git a/pitfall/fontkit/post.rkt b/pitfall/fontkit/post.rkt index 0dba6ede..55b0b193 100644 --- a/pitfall/fontkit/post.rkt +++ b/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)) diff --git a/pitfall/fontkit/subset.rkt b/pitfall/fontkit/subset.rkt index f4851696..3da6f330 100644 --- a/pitfall/fontkit/subset.rkt +++ b/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)) - (define curOffset (list-ref (· loca offsets) gid)) - (define nextOffset (list-ref (· loca offsets) (add1 gid))) + (match-define (list curOffset nextOffset) (take (drop (· this font loca offsets) gid) 2)) (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_) - 'prep (send (· this font) _getTable 'prep) + 'cvt_ (· this font cvt_) + '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)) diff --git a/pitfall/fontkit/ttfglyph.rkt b/pitfall/fontkit/ttfglyph.rkt index 1e956222..74060403 100644 --- a/pitfall/fontkit/ttfglyph.rkt +++ b/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 diff --git a/pitfall/pitfall/embedded.rkt b/pitfall/pitfall/embedded.rkt index 108d9c21..87dd9a65 100644 --- a/pitfall/pitfall/embedded.rkt +++ b/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))