You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
typesetting/pitfall/fontkit/GPOS.rkt

201 lines
8.1 KiB
Racket

7 years ago
#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
7 years ago
'xPlaDevice (+Pointer uint16be Device (mhash 'type 'global 'relativeTo 'rel))
'yPlaDevice (+Pointer uint16be Device (mhash 'type 'global 'relativeTo 'rel))
'xAdvDevice (+Pointer uint16be Device (mhash 'type 'global 'relativeTo 'rel))
'yAdvDevice (+Pointer uint16be Device (mhash 'type 'global 'relativeTo 'rel))))
7 years ago
(define-subclass object% (ValueRecord [key 'valueFormat])
7 years ago
(define/public (buildStruct parent)
7 years ago
;; set `struct` to the first dict in the chain of ancestors
;; with the target key
(define struct (let loop ([x parent])
(cond
7 years ago
[(and x (dict? x) (dict-ref x key #f)) x]
[(· x parent) => loop]
[else #f])))
7 years ago
(report struct)
(and struct
(let ()
7 years ago
(define format (dict-ref struct key))
(define fields
(append
7 years ago
(dictify 'rel (λ _ (dict-ref struct '_startOffset)))
(for/list ([(key val) (in-dict format)]
#:when val)
7 years ago
(cons key (dict-ref types key)))))
(+Struct fields))))
7 years ago
(define/public (size val ctx)
7 years ago
(send (buildStruct ctx) size val ctx))
(define/public (decode stream parent)
7 years ago
(report* stream parent (buildStruct parent))
7 years ago
(define res (send (buildStruct parent) decode stream parent))
7 years ago
(dict-remove! res 'rel)
7 years ago
res)
(define/public (encode . args)
7 years ago
(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
7 years ago
'xDeviceTable (+Pointer uint16be Device)
'yDeviceTable (+Pointer uint16be Device)))))
7 years ago
(define EntryExitRecord (+Struct
7 years ago
(dictify 'entryAnchor (+Pointer uint16be Anchor (mhash 'type 'parent))
'exitAnchor (+Pointer uint16be Anchor (mhash 'type 'parent)))))
7 years ago
(define MarkRecord (+Struct
(dictify 'class uint16be
'markAnchor uint16be)))
(define MarkArray (+Array MarkRecord uint16be))
7 years ago
(define BaseRecord (+Array (+Pointer uint16be Anchor) (λ (t) (ref* t 'parent 'classCount))))
7 years ago
(define BaseArray (+Array BaseRecord uint16be))
7 years ago
(define ComponentRecord (+Array (+Pointer uint16be Anchor) (λ (t) (ref* t 'parent 'parent 'classCount))))
7 years ago
(define LigatureAttach (+Array ComponentRecord uint16be))
7 years ago
(define LigatureArray (+Array (+Pointer uint16be LigatureAttach) uint16be))
7 years ago
(define-subclass VersionedStruct (GPOSLookup-VersionedStruct))
(define GPOSLookup
(+GPOSLookup-VersionedStruct
'lookupType
7 years ago
(dictify
;; Single Adjustment
1 (+VersionedStruct uint16be
(dictify
;; Single positioning value
1 (dictify
'coverage (+Pointer uint16be Coverage)
7 years ago
'valueFormat ValueFormat
'value (+ValueRecord))
2 (dictify
7 years ago
'coverage (+Pointer uint16be Coverage)
7 years ago
'valueFormat ValueFormat
'valueCount uint16be
'values (+LazyArray (+ValueRecord) 'valueCount))))
;; Pair Adjustment Positioning
2 (+VersionedStruct uint16be
(dictify
;; Adjustments for glyph pairs
1 (dictify
7 years ago
'coverage (+Pointer uint16be Coverage)
7 years ago
'valueFormat1 ValueFormat
'valueFormat2 ValueFormat
'pairSetCount uint16be
7 years ago
'pairSets (+LazyArray (+Pointer uint16be PairSet) 'pairSetCount))
7 years ago
;; Class pair adjustment
2 (dictify
7 years ago
'coverage (+Pointer uint16be Coverage)
7 years ago
'valueFormat1 ValueFormat
'valueFormat2 ValueFormat
7 years ago
'classDef1 (+Pointer uint16be ClassDef)
'classDef2 (+Pointer uint16be ClassDef)
7 years ago
'class1Count uint16be
'class2Count uint16be
'classRecords (+LazyArray (+LazyArray Class2Record 'class2Count) 'class1Count))))
;; Cursive Attachment Positioning
3 (dictify
'format uint16be
7 years ago
'coverage (+Pointer uint16be Coverage)
7 years ago
'entryExitCount uint16be
'entryExitRecords (+Array EntryExitRecord 'entryExitCount))
;; MarkToBase Attachment Positioning
4 (dictify
'format uint16be
7 years ago
'markCoverage (+Pointer uint16be Coverage)
'baseCoverage (+Pointer uint16be Coverage)
7 years ago
'classCount uint16be
7 years ago
'markArray (+Pointer uint16be MarkArray)
'baseArray (+Pointer uint16be BaseArray))
7 years ago
;; MarkToLigature Attachment Positioning
5 (dictify
'format uint16be
7 years ago
'markCoverage (+Pointer uint16be Coverage)
'ligatureCoverage (+Pointer uint16be Coverage)
7 years ago
'classCount uint16be
7 years ago
'markArray (+Pointer uint16be MarkArray)
'ligatureArray (+Pointer uint16be LigatureArray))
7 years ago
;; MarkToMark Attachment Positioning
6 (dictify
'format uint16be
7 years ago
'mark1Coverage (+Pointer uint16be Coverage)
'mark2Coverage (+Pointer uint16be Coverage)
7 years ago
'classCount uint16be
7 years ago
'mark1Array (+Pointer uint16be MarkArray)
'mark2Array (+Pointer uint16be BaseArray))
7 years ago
7 Context ;; Contextual positioning
8 ChainingContext ;; Chaining contextual positioning
;; Extension positioning
9 (dictify
'posFormat uint16be
'lookupType uint16be ;; cannot also be 9
7 years ago
'extension (+Pointer uint32be (λ () (error 'circular-reference-unfixed))))
7 years ago
)))
;; Fix circular reference
7 years ago
(ref*-set! GPOSLookup 'versions 9 'extension 'type GPOSLookup)
7 years ago
(define gpos-common-dict (dictify 'scriptList (+Pointer uint16be ScriptList)
7 years ago
'featureList (+Pointer uint16be FeatureList)
7 years ago
'lookupList (+Pointer uint16be (LookupList GPOSLookup))))
7 years ago
(define-subclass VersionedStruct (GPOS-MainVersionedStruct))
(define GPOS (+GPOS-MainVersionedStruct uint32be
7 years ago
(dictify
#x00010000 gpos-common-dict
;; ignore variations
#;#x00010001 #;(append gpos-common-dict (dictify 'featureVariations (+Pointer uint32be FeatureVariations))))))
(test-module)