From ff8e2f867b76377da3390a1a4b625ee511d610dd Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 21 Jun 2017 11:47:49 -0700 Subject: [PATCH] start GPOS --- pitfall/fontkit/GPOS-test.rkt | 7 ++ pitfall/fontkit/GPOS.rkt | 195 +++++++++++++++++++++++++++++++++ pitfall/fontkit/font.rkt | 5 +- pitfall/fontkit/opentype.rkt | 62 +++++++++++ pitfall/restructure/base.rkt | 14 +++ pitfall/restructure/helper.rkt | 15 +-- pitfall/restructure/main.rkt | 3 +- pitfall/restructure/struct.rkt | 4 +- pitfall/sugar/contract.rkt | 24 +++- 9 files changed, 309 insertions(+), 20 deletions(-) create mode 100644 pitfall/fontkit/GPOS-test.rkt create mode 100644 pitfall/fontkit/GPOS.rkt create mode 100644 pitfall/fontkit/opentype.rkt create mode 100644 pitfall/restructure/base.rkt diff --git a/pitfall/fontkit/GPOS-test.rkt b/pitfall/fontkit/GPOS-test.rkt new file mode 100644 index 00000000..a7ed5081 --- /dev/null +++ b/pitfall/fontkit/GPOS-test.rkt @@ -0,0 +1,7 @@ +#lang fontkit/racket +(require "font.rkt" "directory.rkt" "gpos.rkt") + +(define f (openSync fira-path)) +(define ds (send f _getTableStream 'GPOS)) + +(send GPOS decode ds) \ No newline at end of file diff --git a/pitfall/fontkit/GPOS.rkt b/pitfall/fontkit/GPOS.rkt new file mode 100644 index 00000000..5e24af49 --- /dev/null +++ b/pitfall/fontkit/GPOS.rkt @@ -0,0 +1,195 @@ +#lang fontkit/racket +(require restructure br/cond "opentype.rkt") +(provide (all-defined-out)) + +#| +approximates +https://github.com/mbutterick/fontkit/blob/master/src/tables/GPOS.js +|# + +(define ValueFormat (+Bitfield uint16be '(xPlacement yPlacement xAdvance yAdvance xPlaDevice yPlaDevice xAdvDevice yAdvDevice))) + +(define types + (mhash + 'xPlacement int16be + 'yPlacement int16be + 'xAdvance int16be + 'yAdvance int16be + 'xPlaDevice uint16be ;; pointer + 'yPlaDevice uint16be ;; pointer + 'xAdvDevice uint16be ;; pointer + 'yAdvDevice uint16be)) ;; pointer + +(define-subclass RestructureBase (ValueRecord [key 'valueFormat]) + + (define/public (buildStruct parent) + (define struct parent) + (while (and (not (hash-ref struct (· this key))) (hash-ref struct parent)) + (hash-set! struct (hash-ref struct parent))) + + (cond + [(not (hash-ref struct (· this key))) (void)] + [else (define fields (mhash)) + (hash-set! fields 'rel (λ () (hash-ref struct (error '_startOffset-not-available)))) + + (define format (hash-ref struct (· this key))) + (for ([key (in-list format)]) + (when (hash-ref format key) + (hash-set! fields key (hash-ref types key)))) + (+Struct fields)])) + + (define/override (size val ctx) + (send (buildStruct ctx) size val ctx)) + + + (define/override (decode stream parent) + (define res (send (buildStruct parent) decode stream parent)) + (hash-remove! res 'rel) + res) + + (define/override (encode . args) + (error 'GPOS-encode-not-implemented))) + +(define PairValueRecord (+Struct + (dictify + 'secondGlyph uint16be + 'value1 (+ValueRecord 'valueFormat1) + 'value2 (+ValueRecord 'valueFormat2)))) + +(define PairSet (+Array PairValueRecord uint16be)) + +(define Class2Record (+Struct + (dictify + 'value1 (+ValueRecord 'valueFormat1) + 'value2 (+ValueRecord 'valueFormat2)))) + +(define Anchor (+VersionedStruct uint16be + (dictify + ;; Design units only + 1 (dictify 'xCoordinate int16be + 'yCoordinate int16be) + + ;; Design units plus contour point + 2 (dictify 'xCoordinate int16be + 'yCoordinate int16be + 'anchorPoint uint16be) + ;; Design units plus Device tables + 3 (dictify 'xCoordinate int16be + 'yCoordinate int16be + 'xDeviceTable uint16be ; pointer + 'yDeviceTable uint16be)))) ; pointer + +(define EntryExitRecord (+Struct + (dictify 'entryAnchor uint16be ; pointer + 'exitAnchor uint16be))) ; pointer + +(define MarkRecord (+Struct + (dictify 'class uint16be + 'markAnchor uint16be))) + +(define MarkArray (+Array MarkRecord uint16be)) + +(define BaseRecord (+Array uint16be)) ; pointer + +(define BaseArray (+Array BaseRecord uint16be)) + +(define ComponentRecord (+Array uint16be)) ; pointer +(define LigatureAttach (+Array ComponentRecord uint16be)) +(define LigatureArray (+Array uint16be uint16be)) ; pointer + +(define-subclass VersionedStruct (GPOSLookup-VersionedStruct)) +(define GPOSLookup + (+GPOSLookup-VersionedStruct + (λ (parent) (· parent lookupType)) + (dictify + ;; Single Adjustment + 1 (+VersionedStruct uint16be + (dictify + ;; Single positioning value + 1 (dictify + 'coverage uint16be ; pointer + 'valueFormat ValueFormat + 'value (+ValueRecord)) + 2 (dictify + 'coverage uint16be ; pointer + 'valueFormat ValueFormat + 'valueCount uint16be + 'values (+LazyArray (+ValueRecord) 'valueCount)))) + ;; Pair Adjustment Positioning + 2 (+VersionedStruct uint16be + (dictify + ;; Adjustments for glyph pairs + 1 (dictify + 'coverage uint16be ; pointer + 'valueFormat1 ValueFormat + 'valueFormat2 ValueFormat + 'pairSetCount uint16be + 'pairSets (+LazyArray uint16be 'pairSetCount)) ; pointer + + ;; Class pair adjustment + 2 (dictify + 'coverage uint16be ; pointer + 'valueFormat1 ValueFormat + 'valueFormat2 ValueFormat + 'classDef1 uint16be ; pointer + 'classDef2 uint16be ; pointer + 'class1Count uint16be + 'class2Count uint16be + 'classRecords (+LazyArray (+LazyArray Class2Record 'class2Count) 'class1Count)))) + + ;; Cursive Attachment Positioning + 3 (dictify + 'format uint16be + 'coverage uint16be ; pointer + 'entryExitCount uint16be + 'entryExitRecords (+Array EntryExitRecord 'entryExitCount)) + + ;; MarkToBase Attachment Positioning + 4 (dictify + 'format uint16be + 'markCoverage uint16be ; pointer + 'baseCoverage uint16be ; pointer + 'classCount uint16be + 'markArray uint16be ; pointer + 'baseArray uint16be) ; pointer + + ;; MarkToLigature Attachment Positioning + 5 (dictify + 'format uint16be + 'markCoverage uint16be ; pointer + 'ligatureCoverage uint16be ; pointer + 'classCount uint16be + 'markArray uint16be ; pointer + 'ligatureArray uint16be) + + ;; MarkToMark Attachment Positioning + 6 (dictify + 'format uint16be + 'mark1Coverage uint16be ; pointer + 'mark2Coverage uint16be ; pointer + 'classCount uint16be + 'mark1Array uint16be ; pointer + 'mark2Array uint16be) ; pointer + + 7 Context ;; Contextual positioning + 8 ChainingContext ;; Chaining contextual positioning + + ;; Extension positioning + 9 (dictify + 'posFormat uint16be + 'lookupType uint16be ;; cannot also be 9 + 'extension uint32be) ; pointer + ))) + +;; Fix circular reference +;; GPOSLookup.versions[9].extension.type = GPOSLookup; + +(define gpos-common-dict (dictify 'scriptList uint16be ; pointer + 'featureList uint16be ; pointer + 'lookupList uint16be)) ; pointer + +(define-subclass VersionedStruct (GPOS-VersionedStruct)) +(define GPOS (+GPOS-VersionedStruct uint32be + (dictify + #x00010000 gpos-common-dict + #x00010001 (append gpos-common-dict (dictify 'featureVariations uint32be))))) ; pointer \ No newline at end of file diff --git a/pitfall/fontkit/font.rkt b/pitfall/fontkit/font.rkt index e123ea8a..8102c686 100644 --- a/pitfall/fontkit/font.rkt +++ b/pitfall/fontkit/font.rkt @@ -282,8 +282,9 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js -(define/contract (openSync filename [postscriptName #f]) - ((string?) ((option/c string?)) . ->* . TTFFont?) +(define/contract (openSync str-or-path [postscriptName #f]) + (((or/c path? string?)) ((option/c string?)) . ->* . TTFFont?) + (define filename (if (path? str-or-path) (path->string str-or-path) str-or-path)) (define buffer (file->bytes filename)) (create buffer filename postscriptName)) diff --git a/pitfall/fontkit/opentype.rkt b/pitfall/fontkit/opentype.rkt new file mode 100644 index 00000000..aeaabe56 --- /dev/null +++ b/pitfall/fontkit/opentype.rkt @@ -0,0 +1,62 @@ +#lang fontkit/racket +(require restructure) +(provide (all-defined-out)) + +(define LookupRecord (+Struct + (dictify + 'sequenceIndex uint16be + 'lookupListIndex uint16be))) + +(define Context + (+VersionedStruct + uint16be + (dictify + ;; Simple context + 1 (dictify + 'coverage uint16be ; pointer + 'ruleSetCount uint16be + 'ruleSets (+Array uint16be 'ruleSetCount)) ; pointer + + ;; Class-based context + 2 (dictify + 'coverage uint16be ; pointer + 'classDef uint16be ; pointer + 'classSetCnt uint16be + 'classSet (+Array uint16be 'classSetCnt)) ; pointer + + 3 (dictify + 'glyphCount uint16be + 'lookupCount uint16be + 'coverages (+Array uint16be 'glyphCount) ; pointer + 'lookupRecords (+Array LookupRecord 'lookupCount))))) + + +(define ChainingContext + (+VersionedStruct + uint16be + (dictify + ;; Simple context glyph substitution + 1 (dictify + 'coverage uint16be ; pointer + 'chainCount uint16be + 'chainRuelSets (+Array uint16be 'chainCount)) ; pointer + + ;; Class-based chaining context + 2 (dictify + 'coverage uint16be ; pointer + 'backtrackClassDef uint16be ; pointer + 'inputClassDef uint16be ; pointer + 'lookaheadClassDef uint16be ; pointer + 'chainCount uint16be + 'chainClassSet (+Array uint16be 'chainCount)) ; pointer + + ;; Coverage-based chaining context + 3 (dictify + 'backtrackGlyphCount uint16be + 'backtrackCoverage (+Array uint16be 'backtrackGlyphCount) ; pointer + 'inputGlyphCount uint16be + 'inputCoverage (+Array uint16be 'inputGlyphCount) ; pointer + 'lookaheadGlyphCount uint16be + 'lookaheadCoverage (+Array uint16be 'lookaheadGlyphCount) ; pointer + 'lookupCount uint16be + 'lookupRecords (+Array LookupRecord 'lookupCount))))) diff --git a/pitfall/restructure/base.rkt b/pitfall/restructure/base.rkt new file mode 100644 index 00000000..b9b88483 --- /dev/null +++ b/pitfall/restructure/base.rkt @@ -0,0 +1,14 @@ +#lang racket/base +(require racket/class) +(provide (all-defined-out)) + +(define RestructureBase + (class object% + (super-new) + (abstract decode) + (abstract encode) + (abstract size) + (define/public (process . args) (void)) + (define/public (preEncode . args) (void)))) + +(define (RestructureBase? x) (is-a? x RestructureBase)) \ No newline at end of file diff --git a/pitfall/restructure/helper.rkt b/pitfall/restructure/helper.rkt index 360a76fa..8f68c134 100644 --- a/pitfall/restructure/helper.rkt +++ b/pitfall/restructure/helper.rkt @@ -1,17 +1,6 @@ #lang racket/base -(require (for-syntax racket/base br/syntax) racket/class br/define) -(provide (all-defined-out)) - -(define RestructureBase - (class object% - (super-new) - (abstract decode) - (abstract encode) - (abstract size) - (define/public (process . args) (void)) - (define/public (preEncode . args) (void)))) - -(define (RestructureBase? x) (is-a? x RestructureBase)) +(require (for-syntax racket/base br/syntax) racket/class br/define "base.rkt") +(provide (all-defined-out) (all-from-out "base.rkt")) (define-macro (test-module . EXPRS) diff --git a/pitfall/restructure/main.rkt b/pitfall/restructure/main.rkt index 0bb766a8..6619c8c4 100644 --- a/pitfall/restructure/main.rkt +++ b/pitfall/restructure/main.rkt @@ -1,6 +1,7 @@ #lang restructure/racket -(r+p "number.rkt" +(r+p "base.rkt" + "number.rkt" "struct.rkt" "string.rkt" "array.rkt" diff --git a/pitfall/restructure/struct.rkt b/pitfall/restructure/struct.rkt index 6e427304..702dc2fb 100644 --- a/pitfall/restructure/struct.rkt +++ b/pitfall/restructure/struct.rkt @@ -108,8 +108,8 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (define-subclass Struct (VersionedStruct version-resolver [versions (dictify)]) (unless ((disjoin integer? procedure? RestructureBase?) version-resolver) (raise-argument-error 'VersionedStruct "integer, function, or Restructure object" version-resolver)) - (unless (and (dict? versions) (andmap dict? (map cdr versions))) - (raise-argument-error 'VersionedStruct "dict of dicts" versions)) + (unless (and (dict? versions) (andmap (λ (val) (or (dict? val) (Struct? val))) (map cdr versions))) + (raise-argument-error 'VersionedStruct "dict of dicts or Structs" versions)) (inherit-field fields key-index) (field [forced-version #f]) diff --git a/pitfall/sugar/contract.rkt b/pitfall/sugar/contract.rkt index bc694cfd..6d4fbbca 100644 --- a/pitfall/sugar/contract.rkt +++ b/pitfall/sugar/contract.rkt @@ -1,5 +1,25 @@ #lang racket/base -(require racket/contract) +(require racket/contract racket/class) (provide (all-defined-out)) -(define (option/c x) (or/c #f x)) \ No newline at end of file +(define (option/c x) (or/c #f x)) + +(module+ main + + (define-syntax-rule (define/public/contract (ID . ARGS) CONTRACT . BODY) + (define/public (ID . ARGS) + (define/contract (ID . ARGS) + CONTRACT . BODY) + (ID . ARGS))) + + (define c% (class object% + (super-new) + + (define/public/contract (add x y) + (integer? integer? . -> . integer?) + (+ x y)))) + + + (define c (make-object c%)) + + (send c add 12 21)) \ No newline at end of file