diff --git a/fontland/fontland/directory.rkt b/fontland/fontland/directory.rkt index 38dc8e80..f92dd7ce 100644 --- a/fontland/fontland/directory.rkt +++ b/fontland/fontland/directory.rkt @@ -1,7 +1,11 @@ #lang racket/base -(require "racket.rkt") - -(require xenomorph "tables.rkt" describe) +(require xenomorph + "tables.rkt" + sugar/unstable/dict + racket/string + sugar/unstable/class + sugar/unstable/js + racket/class) (provide (all-defined-out)) diff --git a/fontland/fontland/font.rkt b/fontland/fontland/font.rkt index bc490c2d..408663b4 100644 --- a/fontland/fontland/font.rkt +++ b/fontland/fontland/font.rkt @@ -1,6 +1,22 @@ #lang debug racket/base -(require "racket.rkt") -(require "freetype-ffi.rkt" "subset.rkt" "glyph.rkt" "bbox.rkt" "glyphrun.rkt" "directory.rkt" xenomorph "tables.rkt") +(require (for-syntax racket/base) + "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)) #| @@ -9,10 +25,12 @@ 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)) ...))) +(define-syntax (define-table-getters stx) + (syntax-case stx () + [(_) + (with-syntax ([(TABLE-TAG ...) (hash-keys table-codecs)]) + #'(begin + (define/public (TABLE-TAG) (_getTable 'TABLE-TAG)) ...))])) (test-module @@ -184,9 +202,9 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js (define/contract (bbox this) (->m BBox?) (make-BBox (· this head xMin) - (· this head yMin) - (· this head xMax) - (· this head yMax))) + (· this head yMin) + (· this head xMax) + (· this head yMax))) (test-module (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)) tag))) -(define has-cff-table? (curryr has-table? 'CFF_)) -(define has-morx-table? (curryr has-table? 'morx)) -(define has-gpos-table? (curryr has-table? 'GPOS)) -(define has-gsub-table? (curryr has-table? 'GSUB)) +(define (has-cff-table? x) (has-table? x 'CFF_)) +(define (has-morx-table? x) (has-table? x 'morx)) +(define (has-gpos-table? x) (has-table? x 'GPOS)) +(define (has-gsub-table? x) (has-table? x 'GSUB)) (test-module (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)] ;; rather than use a `probe` function, ;; 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)))] #:when font) (if postscriptName diff --git a/fontland/fontland/glyph-position.rkt b/fontland/fontland/glyph-position.rkt index fc7b63fc..dce69858 100644 --- a/fontland/fontland/glyph-position.rkt +++ b/fontland/fontland/glyph-position.rkt @@ -1,6 +1,8 @@ #lang racket/base -(require "racket.rkt") - +(require sugar/unstable/class + sugar/unstable/js + racket/class + racket/contract) (provide (all-defined-out)) ;; Represents positioning information for a glyph in a GlyphRun. diff --git a/fontland/fontland/glyph.rkt b/fontland/fontland/glyph.rkt index 75e3fc72..8188e5ef 100644 --- a/fontland/fontland/glyph.rkt +++ b/fontland/fontland/glyph.rkt @@ -1,7 +1,16 @@ #lang racket/base -(require "racket.rkt") - -(require xenomorph "freetype-ffi.rkt") +(require (for-syntax racket/base) + xenomorph + 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)) (module+ test (require rackunit)) @@ -68,10 +77,10 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js (error 'cff-glyph-unimplemented) #;(define/override (_getName this) - (->m any/c) - (if (send (· this _font) _getTable 'CFF2) - (super _getName) - (send (send (· this _font) _getTable 'CFF_) getGlyphName (· this id)))) + (->m any/c) + (if (send (· this _font) _getTable 'CFF2) + (super _getName) + (send (send (· this _font) _getTable 'CFF_) getGlyphName (· this id)))) (as-methods #;_getName #;bias @@ -94,8 +103,10 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js 'yMax int16be))) ;; Flags for simple glyphs -(define-macro (define-flag-series . IDS) - #`(match-define (list . IDS) (map (curry expt 2) (range #,(length (syntax->list #'IDS)))))) +(define-syntax (define-flag-series stx) + (syntax-case stx () + [(_ . IDS) + #`(match-define (list . IDS) (map (λ (x) (expt 2 x)) (range #,(length (syntax->list #'IDS)))))])) ;; Flags for simple glyphs (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))) (decode uint8 port) 0)))]) - flag)) + flag)) (match-define-values - (points _ _) - (for/fold ([points empty] [px 0] [py 0]) - ([(flag i) (in-indexed flags)]) - (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-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! y point next-py) - (values (cons point points) next-px next-py))) + (points _ _) + (for/fold ([points empty] [px 0] [py 0]) + ([(flag i) (in-indexed flags)]) + (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-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! y point next-py) + (values (cons point points) next-px next-py))) (dict-set! glyph 'points (reverse points))) (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 (for/list ([i (in-naturals)] #:break (zero? (bitwise-and flags MORE_COMPONENTS))) - (set! flags (send uint16be decode port)) - (define gPos (- (pos port) offset)) - (define glyphID (send uint16be decode port)) - (unless haveInstructions - (set! haveInstructions (not (zero? (bitwise-and flags WE_HAVE_INSTRUCTIONS))))) - - (match-define - (list dx dy) - (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)))) - - (define component (+Component glyphID dx dy)) - (set-field! pos component gPos) - - (cond - [(not (zero? (bitwise-and flags WE_HAVE_A_SCALE))) - (define scale (read-fixed14 port)) - (set-field! scaleX component scale) - (set-field! scaleY component scale)] - [(not (zero? (bitwise-and flags WE_HAVE_AN_X_AND_Y_SCALE))) - (set-field! scaleX component (read-fixed14 port)) - (set-field! scaleY component (read-fixed14 port))] - [(not (zero? (bitwise-and flags WE_HAVE_A_TWO_BY_TWO))) - (set-field! scaleX component (read-fixed14 port)) - (set-field! scale01 component (read-fixed14 port)) - (set-field! scale10 component (read-fixed14 port)) - (set-field! scaleY component (read-fixed14 port))]) - component)) + (set! flags (send uint16be decode port)) + (define gPos (- (pos port) offset)) + (define glyphID (send uint16be decode port)) + (unless haveInstructions + (set! haveInstructions (not (zero? (bitwise-and flags WE_HAVE_INSTRUCTIONS))))) + + (match-define + (list dx dy) + (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)))) + + (define component (+Component glyphID dx dy)) + (set-field! pos component gPos) + + (cond + [(not (zero? (bitwise-and flags WE_HAVE_A_SCALE))) + (define scale (read-fixed14 port)) + (set-field! scaleX component scale) + (set-field! scaleY component scale)] + [(not (zero? (bitwise-and flags WE_HAVE_AN_X_AND_Y_SCALE))) + (set-field! scaleX component (read-fixed14 port)) + (set-field! scaleY component (read-fixed14 port))] + [(not (zero? (bitwise-and flags WE_HAVE_A_TWO_BY_TWO))) + (set-field! scaleX component (read-fixed14 port)) + (set-field! scale01 component (read-fixed14 port)) + (set-field! scale10 component (read-fixed14 port)) + (set-field! scaleY component (read-fixed14 port))]) + component)) haveInstructions)) diff --git a/fontland/fontland/glyphinfo.rkt b/fontland/fontland/glyphinfo.rkt index efa505e9..3cb8f764 100644 --- a/fontland/fontland/glyphinfo.rkt +++ b/fontland/fontland/glyphinfo.rkt @@ -1,7 +1,11 @@ #lang racket/base -(require "racket.rkt") - -(require "ot-processor.rkt") +(require sugar/unstable/class + sugar/unstable/dict + sugar/unstable/js + racket/class + racket/list + racket/dict + "helper.rkt") (provide (all-defined-out)) #| @@ -41,7 +45,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/opentype/GlyphInfo.js (set-field! substituted this #t) (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))) (set-field! isMark this (= classID 3)) (set-field! isLigature this (= classID 2))] diff --git a/fontland/fontland/glyphrun.rkt b/fontland/fontland/glyphrun.rkt index fb3bdd9b..1131a5f6 100644 --- a/fontland/fontland/glyphrun.rkt +++ b/fontland/fontland/glyphrun.rkt @@ -1,7 +1,8 @@ #lang racket/base -(require "racket.rkt") - -(require (prefix-in Script- "script.rkt")) +(require (prefix-in Script- "script.rkt") + sugar/unstable/class + sugar/unstable/js + racket/class) (provide (all-defined-out)) #| diff --git a/fontland/fontland/helper.rkt b/fontland/fontland/helper.rkt index 93adc597..60f25477 100644 --- a/fontland/fontland/helper.rkt +++ b/fontland/fontland/helper.rkt @@ -1,7 +1,10 @@ -#lang racket/base -(require (for-syntax racket/base) racket/runtime-path br/define) +#lang racket +(require racket/runtime-path) (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-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-italic-directory-path "assets/charter-italic-directory.rktd") -(define-macro (test-module . EXPRS) - #`(module+ test - (require #,(datum->syntax caller-stx 'rackunit) #,(datum->syntax caller-stx 'racket/serialize)) - . EXPRS)) +(define-syntax (test-module stx) + (syntax-case stx () + [(_ . EXPRS) + #`(module+ test + (require #,(datum->syntax stx 'rackunit) #,(datum->syntax stx 'racket/serialize)) + . EXPRS)])) (define (is-mark? codepoint) diff --git a/fontland/fontland/main.rkt b/fontland/fontland/main.rkt index f5e9c098..132710cb 100644 --- a/fontland/fontland/main.rkt +++ b/fontland/fontland/main.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require "racket.rkt") +(require "helper.rkt") (r+p "font.rkt" "glyph-position.rkt" diff --git a/fontland/fontland/racket.rkt b/fontland/fontland/racket.rkt deleted file mode 100644 index 075e13a3..00000000 --- a/fontland/fontland/racket.rkt +++ /dev/null @@ -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) diff --git a/fontland/fontland/script.rkt b/fontland/fontland/script.rkt index ade700e4..8619c46e 100644 --- a/fontland/fontland/script.rkt +++ b/fontland/fontland/script.rkt @@ -1,5 +1,8 @@ #lang racket/base -(require "racket.rkt") +(require sugar/unstable/dict + sugar/unstable/contract + sugar/unstable/stub + racket/contract) (provide (all-defined-out)) diff --git a/fontland/fontland/subset.rkt b/fontland/fontland/subset.rkt index f784f9e7..e42d87a2 100644 --- a/fontland/fontland/subset.rkt +++ b/fontland/fontland/subset.rkt @@ -1,6 +1,16 @@ #lang debug racket/base -(require "racket.rkt") -(require racket/serialize "table/loca.rkt" "directory.rkt" xenomorph) +(require racket/serialize + 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) #| diff --git a/fontland/fontland/table/CFF_.rkt b/fontland/fontland/table/CFF_.rkt index d0a9e453..230b83cd 100644 --- a/fontland/fontland/table/CFF_.rkt +++ b/fontland/fontland/table/CFF_.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require "../racket.rkt") +(require sugar/unstable/class) (require xenomorph) (provide CFF_) diff --git a/fontland/fontland/table/OS2.rkt b/fontland/fontland/table/OS2.rkt index 3a467c74..9648fdca 100644 --- a/fontland/fontland/table/OS2.rkt +++ b/fontland/fontland/table/OS2.rkt @@ -1,7 +1,8 @@ #lang racket/base -(require "../racket.rkt") - -(require xenomorph) +(require xenomorph + sugar/unstable/class + sugar/unstable/dict + "../helper.rkt") (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))))) (test-module + (require sugar/unstable/js + racket/class) (define ip (open-input-file charter-path)) (define dir (deserialize (read (open-input-file charter-directory-path)))) (define offset (· dir tables OS/2 offset)) diff --git a/fontland/fontland/table/cvt_.rkt b/fontland/fontland/table/cvt_.rkt index 65b92240..31a97c06 100644 --- a/fontland/fontland/table/cvt_.rkt +++ b/fontland/fontland/table/cvt_.rkt @@ -1,5 +1,7 @@ #lang racket/base -(require "../racket.rkt") +(require sugar/unstable/class + sugar/unstable/dict + "../helper.rkt") (require xenomorph) (provide (all-defined-out)) @@ -16,6 +18,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/cvt.js (test-module + (require sugar/unstable/js + sugar/unstable/port) (define ip (open-input-file charter-path)) (define dir (deserialize (read (open-input-file charter-directory-path)))) (define offset (· dir tables cvt_ offset)) diff --git a/fontland/fontland/table/fpgm.rkt b/fontland/fontland/table/fpgm.rkt index a99c878f..ca331acb 100644 --- a/fontland/fontland/table/fpgm.rkt +++ b/fontland/fontland/table/fpgm.rkt @@ -1,5 +1,7 @@ #lang racket/base -(require "../racket.rkt") +(require sugar/unstable/class + sugar/unstable/dict + "../helper.rkt") (require xenomorph) (provide (all-defined-out)) @@ -15,12 +17,15 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/fpgm.js (define-subclass Struct (Rfpgm)) -(define fpgm (make-object Rfpgm +(define fpgm (+Rfpgm (dictify - 'instructions (make-object Array uint8)))) + 'instructions (+Array uint8)))) (test-module + (require sugar/unstable/js + sugar/unstable/port + racket/class) (define ip (open-input-file charter-path)) (define dir (deserialize (read (open-input-file charter-directory-path)))) (define offset (· dir tables fpgm offset)) diff --git a/fontland/fontland/table/glyf.rkt b/fontland/fontland/table/glyf.rkt index 5055ff75..57fee9cc 100644 --- a/fontland/fontland/table/glyf.rkt +++ b/fontland/fontland/table/glyf.rkt @@ -1,5 +1,6 @@ #lang racket/base -(require "../racket.rkt") +(require sugar/unstable/class + "../helper.rkt") (require xenomorph) (provide (all-defined-out)) @@ -13,6 +14,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/glyf.js (define glyf (+Array (+BufferT))) (test-module + (require sugar/unstable/js + sugar/unstable/port) (define ip (open-input-file charter-path)) (define dir (deserialize (read (open-input-file charter-directory-path)))) (define offset (· dir tables glyf offset)) diff --git a/fontland/fontland/table/head.rkt b/fontland/fontland/table/head.rkt index ee5609a8..14635f7d 100644 --- a/fontland/fontland/table/head.rkt +++ b/fontland/fontland/table/head.rkt @@ -1,5 +1,7 @@ #lang racket/base -(require "../racket.rkt") +(require "../helper.rkt" + sugar/unstable/class + sugar/unstable/dict) (require xenomorph) (provide (all-defined-out)) @@ -11,7 +13,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/head.js (define-subclass Struct (Rhead)) -(define head (make-object Rhead +(define head (+Rhead (dictify 'version int32be ;; 0x00010000 (version 1.0) 'revision int32be ;; set by font manufacturer @@ -34,7 +36,10 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/head.js (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 dir (deserialize (read (open-input-file charter-italic-directory-path)))) (define offset (· dir tables head offset)) diff --git a/fontland/fontland/table/hhea.rkt b/fontland/fontland/table/hhea.rkt index b0037e09..b0916a9c 100644 --- a/fontland/fontland/table/hhea.rkt +++ b/fontland/fontland/table/hhea.rkt @@ -1,12 +1,14 @@ #lang racket/base -(require "../racket.rkt") +(require sugar/unstable/class + sugar/unstable/dict + "../helper.rkt") (require xenomorph) (provide (all-defined-out)) (define-subclass Struct (Rhhea)) -(define hhea (make-object Rhhea +(define hhea (+Rhhea (dictify 'version int32be 'ascent int16be ;; Distance from baseline of highest ascender @@ -25,6 +27,9 @@ ))) (test-module + (require racket/serialize + sugar/unstable/js + sugar/unstable/port) (define ip (open-input-file charter-path)) (define dir (deserialize (read (open-input-file charter-directory-path)))) (define offset (· dir tables hhea offset)) diff --git a/fontland/fontland/table/hmtx.rkt b/fontland/fontland/table/hmtx.rkt index cd85dd11..269f54b1 100644 --- a/fontland/fontland/table/hmtx.rkt +++ b/fontland/fontland/table/hmtx.rkt @@ -1,5 +1,8 @@ #lang racket/base -(require "../racket.rkt") +(require sugar/unstable/class + sugar/unstable/dict + sugar/unstable/js + "../helper.rkt") (require xenomorph) (provide (all-defined-out)) @@ -24,6 +27,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/hmtx.js (test-module + (require racket/class) ;; same as hmtx but doesn't require resolution of function to get length (define hmtx-test (+Rhmtx (dictify diff --git a/fontland/fontland/table/loca.rkt b/fontland/fontland/table/loca.rkt index c2ca1f17..da7628da 100644 --- a/fontland/fontland/table/loca.rkt +++ b/fontland/fontland/table/loca.rkt @@ -1,7 +1,11 @@ #lang racket/base -(require "../racket.rkt") - -(require xenomorph) +(require xenomorph + sugar/unstable/class + sugar/unstable/js + sugar/unstable/dict + racket/class + racket/list + "../helper.rkt") (provide (all-defined-out)) (define 16bit-style 0) @@ -20,7 +24,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/loca.js (when (= 16bit-style (· res version)) ;; in a 16bits-style loca table, actual 32bit offset values are divided by 2 (to fit into 16 bits) ;; 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) (define/augride (pre-encode this-val stream) @@ -36,7 +40,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/loca.js 32bit-style 16bit-style)) (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 (λ (o) (· o head indexToLocFormat)) diff --git a/fontland/fontland/table/maxp.rkt b/fontland/fontland/table/maxp.rkt index 77ef9e95..c309dd18 100644 --- a/fontland/fontland/table/maxp.rkt +++ b/fontland/fontland/table/maxp.rkt @@ -1,12 +1,13 @@ #lang racket/base -(require "../racket.rkt") - -(require xenomorph) +(require xenomorph + sugar/unstable/class + sugar/unstable/dict + "../helper.rkt") (provide (all-defined-out)) (define-subclass Struct (Rmaxp)) -(define maxp (make-object Rmaxp +(define maxp (+Rmaxp (dictify 'version int32be 'numGlyphs uint16be ;; The number of glyphs in the font 'maxPoints uint16be ;; Maximum points in a non-composite glyph @@ -26,6 +27,9 @@ (test-module + (require sugar/unstable/js + sugar/unstable/port + racket/class) (define ip (open-input-file charter-path)) (define dir (deserialize (read (open-input-file charter-directory-path)))) (define maxp-offset (· dir tables maxp offset)) diff --git a/fontland/fontland/table/post.rkt b/fontland/fontland/table/post.rkt index 897aade4..3bcbdd3d 100644 --- a/fontland/fontland/table/post.rkt +++ b/fontland/fontland/table/post.rkt @@ -1,7 +1,9 @@ #lang racket/base -(require "../racket.rkt") - -(require xenomorph) +(require xenomorph + sugar/unstable/class + sugar/unstable/dict + sugar/unstable/js + "../helper.rkt") (provide (all-defined-out)) #| @@ -12,7 +14,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/post.js (define-subclass VersionedStruct (Rpost)) -(define post (make-object Rpost +(define post (+Rpost fixed32be (dictify '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))))))) (test-module + (require racket/class) (define ip (open-input-file charter-path)) (define dir (deserialize (read (open-input-file charter-directory-path)))) (define offset (· dir tables post offset)) diff --git a/fontland/fontland/table/prep.rkt b/fontland/fontland/table/prep.rkt index 3e9477e9..80c82a62 100644 --- a/fontland/fontland/table/prep.rkt +++ b/fontland/fontland/table/prep.rkt @@ -1,5 +1,9 @@ #lang racket/base -(require "../racket.rkt") +(require xenomorph + sugar/unstable/class + sugar/unstable/dict + sugar/unstable/js + "../helper.rkt") (require xenomorph) (provide (all-defined-out)) @@ -10,12 +14,13 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/prep.js (define-subclass Struct (Rprep)) -(define prep (make-object Rprep +(define prep (+Rprep (dictify 'controlValueProgram (+Array uint8)))) (test-module + (require sugar/unstable/port) (define ip (open-input-file charter-path)) (define dir (deserialize (read (open-input-file charter-directory-path)))) (define offset (· dir tables prep offset)) diff --git a/fontland/fontland/tables.rkt b/fontland/fontland/tables.rkt index 0dbf5cbc..1e2aafbf 100644 --- a/fontland/fontland/tables.rkt +++ b/fontland/fontland/tables.rkt @@ -1,22 +1,21 @@ #lang racket/base -(require "racket.rkt") - +(require (for-syntax racket/base racket/string) "helper.rkt") (provide (all-defined-out)) -(require (for-syntax racket/string)) #| approximates https://github.com/mbutterick/fontkit/blob/master/src/tables/index.js |# -(define-macro (define-table-codecs ID TABLE-ID ...) - (with-pattern ([(TABLE-ID-STRING ...) (pattern-case-filter #'(TABLE-ID ...) - [STX (datum->syntax caller-stx - (string-append "table/" (string-replace (format "~a.rkt" (syntax->datum #'STX)) "/" "")))])]) - #'(begin - (r+p TABLE-ID-STRING ...) - (test-module (require (submod TABLE-ID-STRING test) ...)) - (define ID (make-hasheq (map cons (list 'TABLE-ID ...) (list TABLE-ID ...))))))) +(define-syntax (define-table-codecs stx) + (syntax-case stx () + [(_ ID TABLE-ID ...) + (with-syntax ([(TABLE-ID-STRING ...) (map (λ (s) (datum->syntax stx (string-append "table/" (string-replace (format "~a.rkt" (syntax->datum s)) "/" "")))) + (syntax->list #'(TABLE-ID ...)))]) + #'(begin + (r+p TABLE-ID-STRING ...) + (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)