slimming regimen

main
Matthew Butterick 6 years ago
parent 974c7e52f3
commit a921849ad6

@ -1,7 +1,11 @@
#lang racket/base #lang racket/base
(require "racket.rkt") (require xenomorph
"tables.rkt"
(require xenomorph "tables.rkt" describe) sugar/unstable/dict
racket/string
sugar/unstable/class
sugar/unstable/js
racket/class)
(provide (all-defined-out)) (provide (all-defined-out))

@ -1,6 +1,22 @@
#lang debug racket/base #lang debug racket/base
(require "racket.rkt") (require (for-syntax racket/base)
(require "freetype-ffi.rkt" "subset.rkt" "glyph.rkt" "bbox.rkt" "glyphrun.rkt" "directory.rkt" xenomorph "tables.rkt") "helper.rkt"
"freetype-ffi.rkt"
"subset.rkt"
"glyph.rkt"
"bbox.rkt"
"glyphrun.rkt"
"directory.rkt"
xenomorph
"tables.rkt"
racket/contract
racket/class
racket/match
racket/file
sugar/unstable/class
sugar/unstable/contract
sugar/unstable/dict
sugar/unstable/js)
(provide (all-defined-out)) (provide (all-defined-out))
#| #|
@ -9,10 +25,12 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
|# |#
(require (for-syntax "tables.rkt")) (require (for-syntax "tables.rkt"))
(define-macro (define-table-getters) (define-syntax (define-table-getters stx)
(with-pattern ([(TABLE-TAG ...) (hash-keys table-codecs)]) (syntax-case stx ()
#'(begin [(_)
(define/public (TABLE-TAG) (_getTable 'TABLE-TAG)) ...))) (with-syntax ([(TABLE-TAG ...) (hash-keys table-codecs)])
#'(begin
(define/public (TABLE-TAG) (_getTable 'TABLE-TAG)) ...))]))
(test-module (test-module
@ -184,9 +202,9 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
(define/contract (bbox this) (define/contract (bbox this)
(->m BBox?) (->m BBox?)
(make-BBox (· this head xMin) (make-BBox (· this head xMin)
(· this head yMin) (· this head yMin)
(· this head xMax) (· this head xMax)
(· this head yMax))) (· this head yMax)))
(test-module (test-module
(check-equal? (bbox->list (· f bbox)) '(-161 -236 1193 963))) (check-equal? (bbox->list (· f bbox)) '(-161 -236 1193 963)))
@ -206,10 +224,10 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js
(string->symbol (bytes->string/latin-1 tag)) (string->symbol (bytes->string/latin-1 tag))
tag))) tag)))
(define has-cff-table? (curryr has-table? 'CFF_)) (define (has-cff-table? x) (has-table? x 'CFF_))
(define has-morx-table? (curryr has-table? 'morx)) (define (has-morx-table? x) (has-table? x 'morx))
(define has-gpos-table? (curryr has-table? 'GPOS)) (define (has-gpos-table? x) (has-table? x 'GPOS))
(define has-gsub-table? (curryr has-table? 'GSUB)) (define (has-gsub-table? x) (has-table? x 'GSUB))
(test-module (test-module
(check-false (· f has-cff-table?)) (check-false (· f has-cff-table?))
@ -342,7 +360,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/base.js
(for*/first ([format (in-list formats)] (for*/first ([format (in-list formats)]
;; rather than use a `probe` function, ;; rather than use a `probe` function,
;; just try making a font with each format and see what happens ;; just try making a font with each format and see what happens
[font (in-value (with-handlers ([(curry eq? 'probe-fail) (λ (exn) #f)]) [font (in-value (with-handlers ([(λ (x) (eq? x 'probe-fail)) (λ (exn) #f)])
(make-object format (open-input-bytes buffer) filename)))] (make-object format (open-input-bytes buffer) filename)))]
#:when font) #:when font)
(if postscriptName (if postscriptName

@ -1,6 +1,8 @@
#lang racket/base #lang racket/base
(require "racket.rkt") (require sugar/unstable/class
sugar/unstable/js
racket/class
racket/contract)
(provide (all-defined-out)) (provide (all-defined-out))
;; Represents positioning information for a glyph in a GlyphRun. ;; Represents positioning information for a glyph in a GlyphRun.

@ -1,7 +1,16 @@
#lang racket/base #lang racket/base
(require "racket.rkt") (require (for-syntax racket/base)
xenomorph
(require xenomorph "freetype-ffi.rkt") racket/class
racket/match
racket/list
racket/contract
sugar/unstable/class
sugar/unstable/dict
sugar/unstable/js
sugar/unstable/stub
"freetype-ffi.rkt"
"helper.rkt")
(provide (all-defined-out)) (provide (all-defined-out))
(module+ test (require rackunit)) (module+ test (require rackunit))
@ -68,10 +77,10 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
(error 'cff-glyph-unimplemented) (error 'cff-glyph-unimplemented)
#;(define/override (_getName this) #;(define/override (_getName this)
(->m any/c) (->m any/c)
(if (send (· this _font) _getTable 'CFF2) (if (send (· this _font) _getTable 'CFF2)
(super _getName) (super _getName)
(send (send (· this _font) _getTable 'CFF_) getGlyphName (· this id)))) (send (send (· this _font) _getTable 'CFF_) getGlyphName (· this id))))
(as-methods (as-methods
#;_getName #;_getName
#;bias #;bias
@ -94,8 +103,10 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js
'yMax int16be))) 'yMax int16be)))
;; Flags for simple glyphs ;; Flags for simple glyphs
(define-macro (define-flag-series . IDS) (define-syntax (define-flag-series stx)
#`(match-define (list . IDS) (map (curry expt 2) (range #,(length (syntax->list #'IDS)))))) (syntax-case stx ()
[(_ . IDS)
#`(match-define (list . IDS) (map (λ (x) (expt 2 x)) (range #,(length (syntax->list #'IDS)))))]))
;; Flags for simple glyphs ;; Flags for simple glyphs
(define-flag-series ON_CURVE (define-flag-series ON_CURVE
@ -194,18 +205,18 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js
[count (in-range (add1 (if (not (zero? (bitwise-and flag REPEAT))) [count (in-range (add1 (if (not (zero? (bitwise-and flag REPEAT)))
(decode uint8 port) (decode uint8 port)
0)))]) 0)))])
flag)) flag))
(match-define-values (match-define-values
(points _ _) (points _ _)
(for/fold ([points empty] [px 0] [py 0]) (for/fold ([points empty] [px 0] [py 0])
([(flag i) (in-indexed flags)]) ([(flag i) (in-indexed flags)])
(define point (+Point (zero? (bitwise-and flag ON_CURVE)) (and (index-of endPtsOfContours i) #t) 0 0)) (define point (+Point (zero? (bitwise-and flag ON_CURVE)) (and (index-of endPtsOfContours i) #t) 0 0))
(define next-px (_parseGlyphCoord port px (not (zero? (bitwise-and flag X_SHORT_VECTOR))) (not (zero? (bitwise-and flag SAME_X))))) (define next-px (_parseGlyphCoord port px (not (zero? (bitwise-and flag X_SHORT_VECTOR))) (not (zero? (bitwise-and flag SAME_X)))))
(define next-py (_parseGlyphCoord port py (not (zero? (bitwise-and flag Y_SHORT_VECTOR))) (not (zero? (bitwise-and flag SAME_Y))))) (define next-py (_parseGlyphCoord port py (not (zero? (bitwise-and flag Y_SHORT_VECTOR))) (not (zero? (bitwise-and flag SAME_Y)))))
(set-field! x point next-px) (set-field! x point next-px)
(set-field! y point next-py) (set-field! y point next-py)
(values (cons point points) next-px next-py))) (values (cons point points) next-px next-py)))
(dict-set! glyph 'points (reverse points))) (dict-set! glyph 'points (reverse points)))
(define/public (_decodeComposite glyph port [offset 0]) (define/public (_decodeComposite glyph port [offset 0])
@ -217,34 +228,34 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js
(dict-set! glyph 'components (dict-set! glyph 'components
(for/list ([i (in-naturals)] (for/list ([i (in-naturals)]
#:break (zero? (bitwise-and flags MORE_COMPONENTS))) #:break (zero? (bitwise-and flags MORE_COMPONENTS)))
(set! flags (send uint16be decode port)) (set! flags (send uint16be decode port))
(define gPos (- (pos port) offset)) (define gPos (- (pos port) offset))
(define glyphID (send uint16be decode port)) (define glyphID (send uint16be decode port))
(unless haveInstructions (unless haveInstructions
(set! haveInstructions (not (zero? (bitwise-and flags WE_HAVE_INSTRUCTIONS))))) (set! haveInstructions (not (zero? (bitwise-and flags WE_HAVE_INSTRUCTIONS)))))
(match-define (match-define
(list dx dy) (list dx dy)
(let ([decoder (if (not (zero? (bitwise-and flags ARG_1_AND_2_ARE_WORDS))) int16be int8)]) (let ([decoder (if (not (zero? (bitwise-and flags ARG_1_AND_2_ARE_WORDS))) int16be int8)])
(list (send decoder decode port) (send decoder decode port)))) (list (send decoder decode port) (send decoder decode port))))
(define component (+Component glyphID dx dy)) (define component (+Component glyphID dx dy))
(set-field! pos component gPos) (set-field! pos component gPos)
(cond (cond
[(not (zero? (bitwise-and flags WE_HAVE_A_SCALE))) [(not (zero? (bitwise-and flags WE_HAVE_A_SCALE)))
(define scale (read-fixed14 port)) (define scale (read-fixed14 port))
(set-field! scaleX component scale) (set-field! scaleX component scale)
(set-field! scaleY component scale)] (set-field! scaleY component scale)]
[(not (zero? (bitwise-and flags WE_HAVE_AN_X_AND_Y_SCALE))) [(not (zero? (bitwise-and flags WE_HAVE_AN_X_AND_Y_SCALE)))
(set-field! scaleX component (read-fixed14 port)) (set-field! scaleX component (read-fixed14 port))
(set-field! scaleY component (read-fixed14 port))] (set-field! scaleY component (read-fixed14 port))]
[(not (zero? (bitwise-and flags WE_HAVE_A_TWO_BY_TWO))) [(not (zero? (bitwise-and flags WE_HAVE_A_TWO_BY_TWO)))
(set-field! scaleX component (read-fixed14 port)) (set-field! scaleX component (read-fixed14 port))
(set-field! scale01 component (read-fixed14 port)) (set-field! scale01 component (read-fixed14 port))
(set-field! scale10 component (read-fixed14 port)) (set-field! scale10 component (read-fixed14 port))
(set-field! scaleY component (read-fixed14 port))]) (set-field! scaleY component (read-fixed14 port))])
component)) component))
haveInstructions)) haveInstructions))

@ -1,7 +1,11 @@
#lang racket/base #lang racket/base
(require "racket.rkt") (require sugar/unstable/class
sugar/unstable/dict
(require "ot-processor.rkt") sugar/unstable/js
racket/class
racket/list
racket/dict
"helper.rkt")
(provide (all-defined-out)) (provide (all-defined-out))
#| #|
@ -41,7 +45,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/opentype/GlyphInfo.js
(set-field! substituted this #t) (set-field! substituted this #t)
(cond (cond
[(and (· this _font GDEF) (· this _font GDEF glyphClassDef)) ;; we're out of the GDEF business
#;[(and (· this _font GDEF) (· this _font GDEF glyphClassDef))
(define classID (send (+OTProcessor) getClassID id-in (· this _font GDEF glyphClassDef))) (define classID (send (+OTProcessor) getClassID id-in (· this _font GDEF glyphClassDef)))
(set-field! isMark this (= classID 3)) (set-field! isMark this (= classID 3))
(set-field! isLigature this (= classID 2))] (set-field! isLigature this (= classID 2))]

@ -1,7 +1,8 @@
#lang racket/base #lang racket/base
(require "racket.rkt") (require (prefix-in Script- "script.rkt")
sugar/unstable/class
(require (prefix-in Script- "script.rkt")) sugar/unstable/js
racket/class)
(provide (all-defined-out)) (provide (all-defined-out))
#| #|

@ -1,7 +1,10 @@
#lang racket/base #lang racket
(require (for-syntax racket/base) racket/runtime-path br/define) (require racket/runtime-path)
(provide (all-defined-out)) (provide (all-defined-out))
(define-syntax-rule (r+p ID ...)
(begin (require ID ...) (provide (all-from-out ID ...))))
(define index? (λ (x) (and (number? x) (integer? x) (not (negative? x))))) (define index? (λ (x) (and (number? x) (integer? x) (not (negative? x)))))
(define-runtime-path charter-path "assets/charter.ttf") (define-runtime-path charter-path "assets/charter.ttf")
@ -11,10 +14,12 @@
(define-runtime-path charter-directory-path "assets/charter-directory.rktd") (define-runtime-path charter-directory-path "assets/charter-directory.rktd")
(define-runtime-path charter-italic-directory-path "assets/charter-italic-directory.rktd") (define-runtime-path charter-italic-directory-path "assets/charter-italic-directory.rktd")
(define-macro (test-module . EXPRS) (define-syntax (test-module stx)
#`(module+ test (syntax-case stx ()
(require #,(datum->syntax caller-stx 'rackunit) #,(datum->syntax caller-stx 'racket/serialize)) [(_ . EXPRS)
. EXPRS)) #`(module+ test
(require #,(datum->syntax stx 'rackunit) #,(datum->syntax stx 'racket/serialize))
. EXPRS)]))
(define (is-mark? codepoint) (define (is-mark? codepoint)

@ -1,5 +1,5 @@
#lang racket/base #lang racket/base
(require "racket.rkt") (require "helper.rkt")
(r+p "font.rkt" (r+p "font.rkt"
"glyph-position.rkt" "glyph-position.rkt"

@ -1,27 +0,0 @@
#lang racket/base
(require (for-syntax racket/base br/syntax))
(provide (for-syntax (all-from-out racket/base br/syntax)))
(provide (all-from-out racket/base) r+p (all-defined-out))
(define-syntax-rule (r+p id ...) (begin (require id ...) (provide (all-from-out id ...))))
(r+p "helper.rkt"
sugar/debug
racket/class
racket/file
racket/match
racket/string
racket/format
racket/contract
racket/dict
racket/list
racket/port
racket/function
br/define
sugar/unstable/class
sugar/unstable/js
sugar/unstable/dict
sugar/unstable/stub
sugar/unstable/port
sugar/unstable/contract
describe)

@ -1,5 +1,8 @@
#lang racket/base #lang racket/base
(require "racket.rkt") (require sugar/unstable/dict
sugar/unstable/contract
sugar/unstable/stub
racket/contract)
(provide (all-defined-out)) (provide (all-defined-out))

@ -1,6 +1,16 @@
#lang debug racket/base #lang debug racket/base
(require "racket.rkt") (require racket/serialize
(require racket/serialize "table/loca.rkt" "directory.rkt" xenomorph) racket/contract
racket/class
racket/list
racket/match
sugar/unstable/class
sugar/unstable/dict
sugar/unstable/js
"table/loca.rkt"
"directory.rkt"
"helper.rkt"
xenomorph)
(provide Subset CFFSubset TTFSubset) (provide Subset CFFSubset TTFSubset)
#| #|

@ -1,5 +1,5 @@
#lang racket/base #lang racket/base
(require "../racket.rkt") (require sugar/unstable/class)
(require xenomorph) (require xenomorph)
(provide CFF_) (provide CFF_)

@ -1,7 +1,8 @@
#lang racket/base #lang racket/base
(require "../racket.rkt") (require xenomorph
sugar/unstable/class
(require xenomorph) sugar/unstable/dict
"../helper.rkt")
(provide (all-defined-out)) (provide (all-defined-out))
#| #|
@ -66,6 +67,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/OS2.js
5 (append type-1 type-2 type-5))))) 5 (append type-1 type-2 type-5)))))
(test-module (test-module
(require sugar/unstable/js
racket/class)
(define ip (open-input-file charter-path)) (define ip (open-input-file charter-path))
(define dir (deserialize (read (open-input-file charter-directory-path)))) (define dir (deserialize (read (open-input-file charter-directory-path))))
(define offset (· dir tables OS/2 offset)) (define offset (· dir tables OS/2 offset))

@ -1,5 +1,7 @@
#lang racket/base #lang racket/base
(require "../racket.rkt") (require sugar/unstable/class
sugar/unstable/dict
"../helper.rkt")
(require xenomorph) (require xenomorph)
(provide (all-defined-out)) (provide (all-defined-out))
@ -16,6 +18,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/cvt.js
(test-module (test-module
(require sugar/unstable/js
sugar/unstable/port)
(define ip (open-input-file charter-path)) (define ip (open-input-file charter-path))
(define dir (deserialize (read (open-input-file charter-directory-path)))) (define dir (deserialize (read (open-input-file charter-directory-path))))
(define offset (· dir tables cvt_ offset)) (define offset (· dir tables cvt_ offset))

@ -1,5 +1,7 @@
#lang racket/base #lang racket/base
(require "../racket.rkt") (require sugar/unstable/class
sugar/unstable/dict
"../helper.rkt")
(require xenomorph) (require xenomorph)
(provide (all-defined-out)) (provide (all-defined-out))
@ -15,12 +17,15 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/fpgm.js
(define-subclass Struct (Rfpgm)) (define-subclass Struct (Rfpgm))
(define fpgm (make-object Rfpgm (define fpgm (+Rfpgm
(dictify (dictify
'instructions (make-object Array uint8)))) 'instructions (+Array uint8))))
(test-module (test-module
(require sugar/unstable/js
sugar/unstable/port
racket/class)
(define ip (open-input-file charter-path)) (define ip (open-input-file charter-path))
(define dir (deserialize (read (open-input-file charter-directory-path)))) (define dir (deserialize (read (open-input-file charter-directory-path))))
(define offset (· dir tables fpgm offset)) (define offset (· dir tables fpgm offset))

@ -1,5 +1,6 @@
#lang racket/base #lang racket/base
(require "../racket.rkt") (require sugar/unstable/class
"../helper.rkt")
(require xenomorph) (require xenomorph)
(provide (all-defined-out)) (provide (all-defined-out))
@ -13,6 +14,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/glyf.js
(define glyf (+Array (+BufferT))) (define glyf (+Array (+BufferT)))
(test-module (test-module
(require sugar/unstable/js
sugar/unstable/port)
(define ip (open-input-file charter-path)) (define ip (open-input-file charter-path))
(define dir (deserialize (read (open-input-file charter-directory-path)))) (define dir (deserialize (read (open-input-file charter-directory-path))))
(define offset (· dir tables glyf offset)) (define offset (· dir tables glyf offset))

@ -1,5 +1,7 @@
#lang racket/base #lang racket/base
(require "../racket.rkt") (require "../helper.rkt"
sugar/unstable/class
sugar/unstable/dict)
(require xenomorph) (require xenomorph)
(provide (all-defined-out)) (provide (all-defined-out))
@ -11,7 +13,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/head.js
(define-subclass Struct (Rhead)) (define-subclass Struct (Rhead))
(define head (make-object Rhead (define head (+Rhead
(dictify (dictify
'version int32be ;; 0x00010000 (version 1.0) 'version int32be ;; 0x00010000 (version 1.0)
'revision int32be ;; set by font manufacturer 'revision int32be ;; set by font manufacturer
@ -34,7 +36,10 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/head.js
(test-module (test-module
(require racket/serialize) (require racket/serialize
sugar/unstable/js
sugar/unstable/port
racket/class)
(define ip (open-input-file charter-italic-path)) (define ip (open-input-file charter-italic-path))
(define dir (deserialize (read (open-input-file charter-italic-directory-path)))) (define dir (deserialize (read (open-input-file charter-italic-directory-path))))
(define offset (· dir tables head offset)) (define offset (· dir tables head offset))

@ -1,12 +1,14 @@
#lang racket/base #lang racket/base
(require "../racket.rkt") (require sugar/unstable/class
sugar/unstable/dict
"../helper.rkt")
(require xenomorph) (require xenomorph)
(provide (all-defined-out)) (provide (all-defined-out))
(define-subclass Struct (Rhhea)) (define-subclass Struct (Rhhea))
(define hhea (make-object Rhhea (define hhea (+Rhhea
(dictify (dictify
'version int32be 'version int32be
'ascent int16be ;; Distance from baseline of highest ascender 'ascent int16be ;; Distance from baseline of highest ascender
@ -25,6 +27,9 @@
))) )))
(test-module (test-module
(require racket/serialize
sugar/unstable/js
sugar/unstable/port)
(define ip (open-input-file charter-path)) (define ip (open-input-file charter-path))
(define dir (deserialize (read (open-input-file charter-directory-path)))) (define dir (deserialize (read (open-input-file charter-directory-path))))
(define offset (· dir tables hhea offset)) (define offset (· dir tables hhea offset))

@ -1,5 +1,8 @@
#lang racket/base #lang racket/base
(require "../racket.rkt") (require sugar/unstable/class
sugar/unstable/dict
sugar/unstable/js
"../helper.rkt")
(require xenomorph) (require xenomorph)
(provide (all-defined-out)) (provide (all-defined-out))
@ -24,6 +27,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/hmtx.js
(test-module (test-module
(require racket/class)
;; same as hmtx but doesn't require resolution of function to get length ;; same as hmtx but doesn't require resolution of function to get length
(define hmtx-test (+Rhmtx (define hmtx-test (+Rhmtx
(dictify (dictify

@ -1,7 +1,11 @@
#lang racket/base #lang racket/base
(require "../racket.rkt") (require xenomorph
sugar/unstable/class
(require xenomorph) sugar/unstable/js
sugar/unstable/dict
racket/class
racket/list
"../helper.rkt")
(provide (all-defined-out)) (provide (all-defined-out))
(define 16bit-style 0) (define 16bit-style 0)
@ -20,7 +24,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/loca.js
(when (= 16bit-style (· res version)) (when (= 16bit-style (· res version))
;; in a 16bits-style loca table, actual 32bit offset values are divided by 2 (to fit into 16 bits) ;; in a 16bits-style loca table, actual 32bit offset values are divided by 2 (to fit into 16 bits)
;; so we re-inflate them. ;; so we re-inflate them.
(dict-update! res 'offsets (λ (offsets) (map (curry * 2) offsets)))) (dict-update! res 'offsets (λ (offsets) (map (λ (x) (* 2 x)) offsets))))
res) res)
(define/augride (pre-encode this-val stream) (define/augride (pre-encode this-val stream)
@ -36,7 +40,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/loca.js
32bit-style 32bit-style
16bit-style)) 16bit-style))
(when (= 16bit-style (· this version)) (when (= 16bit-style (· this version))
(dict-update! this 'offsets (λ (offsets) (map (curryr / 2) offsets)))))) (dict-update! this 'offsets (λ (offsets) (map (λ (x) (/ x 2)) offsets))))))
(define loca (+Rloca (define loca (+Rloca
(λ (o) (· o head indexToLocFormat)) (λ (o) (· o head indexToLocFormat))

@ -1,12 +1,13 @@
#lang racket/base #lang racket/base
(require "../racket.rkt") (require xenomorph
sugar/unstable/class
(require xenomorph) sugar/unstable/dict
"../helper.rkt")
(provide (all-defined-out)) (provide (all-defined-out))
(define-subclass Struct (Rmaxp)) (define-subclass Struct (Rmaxp))
(define maxp (make-object Rmaxp (define maxp (+Rmaxp
(dictify 'version int32be (dictify 'version int32be
'numGlyphs uint16be ;; The number of glyphs in the font 'numGlyphs uint16be ;; The number of glyphs in the font
'maxPoints uint16be ;; Maximum points in a non-composite glyph 'maxPoints uint16be ;; Maximum points in a non-composite glyph
@ -26,6 +27,9 @@
(test-module (test-module
(require sugar/unstable/js
sugar/unstable/port
racket/class)
(define ip (open-input-file charter-path)) (define ip (open-input-file charter-path))
(define dir (deserialize (read (open-input-file charter-directory-path)))) (define dir (deserialize (read (open-input-file charter-directory-path))))
(define maxp-offset (· dir tables maxp offset)) (define maxp-offset (· dir tables maxp offset))

@ -1,7 +1,9 @@
#lang racket/base #lang racket/base
(require "../racket.rkt") (require xenomorph
sugar/unstable/class
(require xenomorph) sugar/unstable/dict
sugar/unstable/js
"../helper.rkt")
(provide (all-defined-out)) (provide (all-defined-out))
#| #|
@ -12,7 +14,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/post.js
(define-subclass VersionedStruct (Rpost)) (define-subclass VersionedStruct (Rpost))
(define post (make-object Rpost (define post (+Rpost
fixed32be fixed32be
(dictify (dictify
'header (dictify 'italicAngle fixed32be ;; Italic angle in counter-clockwise degrees from the vertical. 'header (dictify 'italicAngle fixed32be ;; Italic angle in counter-clockwise degrees from the vertical.
@ -35,6 +37,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/post.js
4 (dictify 'map (+Array uint32be (λ (t) (· t parent maxp numGlyphs))))))) 4 (dictify 'map (+Array uint32be (λ (t) (· t parent maxp numGlyphs)))))))
(test-module (test-module
(require racket/class)
(define ip (open-input-file charter-path)) (define ip (open-input-file charter-path))
(define dir (deserialize (read (open-input-file charter-directory-path)))) (define dir (deserialize (read (open-input-file charter-directory-path))))
(define offset (· dir tables post offset)) (define offset (· dir tables post offset))

@ -1,5 +1,9 @@
#lang racket/base #lang racket/base
(require "../racket.rkt") (require xenomorph
sugar/unstable/class
sugar/unstable/dict
sugar/unstable/js
"../helper.rkt")
(require xenomorph) (require xenomorph)
(provide (all-defined-out)) (provide (all-defined-out))
@ -10,12 +14,13 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/prep.js
(define-subclass Struct (Rprep)) (define-subclass Struct (Rprep))
(define prep (make-object Rprep (define prep (+Rprep
(dictify (dictify
'controlValueProgram (+Array uint8)))) 'controlValueProgram (+Array uint8))))
(test-module (test-module
(require sugar/unstable/port)
(define ip (open-input-file charter-path)) (define ip (open-input-file charter-path))
(define dir (deserialize (read (open-input-file charter-directory-path)))) (define dir (deserialize (read (open-input-file charter-directory-path))))
(define offset (· dir tables prep offset)) (define offset (· dir tables prep offset))

@ -1,22 +1,21 @@
#lang racket/base #lang racket/base
(require "racket.rkt") (require (for-syntax racket/base racket/string) "helper.rkt")
(provide (all-defined-out)) (provide (all-defined-out))
(require (for-syntax racket/string))
#| #|
approximates approximates
https://github.com/mbutterick/fontkit/blob/master/src/tables/index.js https://github.com/mbutterick/fontkit/blob/master/src/tables/index.js
|# |#
(define-macro (define-table-codecs ID TABLE-ID ...) (define-syntax (define-table-codecs stx)
(with-pattern ([(TABLE-ID-STRING ...) (pattern-case-filter #'(TABLE-ID ...) (syntax-case stx ()
[STX (datum->syntax caller-stx [(_ ID TABLE-ID ...)
(string-append "table/" (string-replace (format "~a.rkt" (syntax->datum #'STX)) "/" "")))])]) (with-syntax ([(TABLE-ID-STRING ...) (map (λ (s) (datum->syntax stx (string-append "table/" (string-replace (format "~a.rkt" (syntax->datum s)) "/" ""))))
#'(begin (syntax->list #'(TABLE-ID ...)))])
(r+p TABLE-ID-STRING ...) #'(begin
(test-module (require (submod TABLE-ID-STRING test) ...)) (r+p TABLE-ID-STRING ...)
(define ID (make-hasheq (map cons (list 'TABLE-ID ...) (list TABLE-ID ...))))))) (test-module (require (submod TABLE-ID-STRING test) ...))
(define ID (make-hasheq (map cons (list 'TABLE-ID ...) (list TABLE-ID ...))))))]))
(define-table-codecs table-codecs head hhea hmtx maxp OS/2 post cvt_ fpgm loca prep glyf) (define-table-codecs table-codecs head hhea hmtx maxp OS/2 post cvt_ fpgm loca prep glyf)

Loading…
Cancel
Save