diff --git a/pitfall/fontkit/glyph-iterator.rkt b/pitfall/fontkit/glyph-iterator.rkt new file mode 100644 index 00000000..05763069 --- /dev/null +++ b/pitfall/fontkit/glyph-iterator.rkt @@ -0,0 +1,61 @@ +#lang fontkit/racket +(require br/cond) +(provide (all-defined-out)) + +#| +approximates +https://github.com/mbutterick/fontkit/blob/master/src/opentype/GlyphIterator.js +|# + +(define-subclass object% + (GlyphIterator glyphs [flags (mhasheq)]) + (field [index #f]) + (reset flags) + + (define/public (reset flags) + (set-field! flags this flags) + (set-field! index this 0)) + + (define/public (cur) + (and (< (· this index) (length (· this glyphs))) + (list-ref (· this glyphs) (· this index)))) + + (define/public (shouldIgnore glyph flags) + (or (and (· flags ignoreMarks) (· glyph isMark)) + (and (· flags ignoreBaseGlyphs) (not (· glyph isMark))) + (and (· flags ignoreLigatures) (· glyph isLigature)))) + + (define/public (move dir) + (increment-field! index this dir) + (while (and (<= 0 (· this index)) + (< (· this index) (length (· this glyphs))) + (send this shouldIgnore (list-ref (· this glyphs) (· this index)) (· this flags))) + (increment-field! index this dir)) + + (if (or (> 0 (· this index)) + (>= (· this index) (length (· this glyphs)))) + #f + (list-ref (· this glyphs) (· this index)))) + + (define/public (next) (move 1)) + + (define/public (prev) (move -1)) + + (define/public (peek [count 1]) + (define idx (· this index)) + (define res (send this increment count)) + (set-field! index this idx) + res) + + (define/public (peekIndex [count 1]) + (define idx (· this index)) + (send this increment count) + (define res (· this index)) + (set-field! index this idx) + res) + + (define/public (increment [count 1]) + (for ([i (in-range (abs count))]) + (send this move (if (negative? count) -1 1))) + (list-ref (· this glyphs) (· this index)))) + diff --git a/pitfall/fontkit/gpos-processor.rkt b/pitfall/fontkit/gpos-processor.rkt index 353cd3a5..70d630d8 100644 --- a/pitfall/fontkit/gpos-processor.rkt +++ b/pitfall/fontkit/gpos-processor.rkt @@ -8,8 +8,81 @@ https://github.com/mbutterick/fontkit/blob/master/src/opentype/GPOSProcessor.js (define-subclass OTProcessor (GPOSProcessor) + (define/override (applyLookup lookupType table) + (report/file 'starting-applyLookup) + (case lookupType + [(1) ;; Single positioning value + (report/file 'single-positioning-value) + (define index (send this coverageIndex (· table coverage))) + (report/file index) + (cond + [(= index -1) #f] + [else (case (· table version) + [(1) (send this applyPositionValue 0 (· table value))] + [(2) (send this applyPositionValue 0 (send (· table values) get index))]) + #t])] + [(2) ;; Pair Adjustment Positioning + (report/file 'pair-adjustment) + (define nextGlyph (· this glyphIterator peek)) + (report/file nextGlyph) + (cond + [(not nextGlyph) #f] + [else + (define index (send this coverageIndex (· table coverage))) + (report/file index) + (cond + [(= index -1) #f] + [else + (case (· table version) + [(1) ;; Adjustments for glyph pairs + (report/file 'glyph-pair) + (define set (send (· table pairSets) get index)) + (for/first ([pair (in-list set)] + #:when (= (· pair secondGlyph) (· nextGlyph id))) + (send this applyPositionValue 0 (· pair value1)) + (send this applyPositionValue 0 (· pair value2)))] + [(2) ;; Class pair adjustment + (report/file 'class-pair) + (define class1 (send this getClassId (· this glyphIterator cur id) (· table classDef1))) + (define class2 (send this getClassId (· nextGlyph id) (· table classDef2))) + (cond + [(or (= class1 -1) (= class2 -1)) #f] + [else (define pair (send (send (· table classRecords) get class1) get class2)) + (send this applyPositionValue 0 (· pair value1)) + (send this applyPositionValue 0 (· pair value2)) + #t])])])])] + [(3) ;; Cursive Attachment Positioning + (report/file 'cursive-attachment-positioning-unimplemented) + (error)] + [(4) ;; Mark to base positioning + (report/file 'mark-to-base-positioning-unimplemented) + (error)] + [(5) ;; Mark to ligature positioning + (report/file 'mark-to-ligature-positioning-unimplemented) + (error)] + [(6) ;; Mark to mark positioning + (report/file 'mark-to-mark-positioning-unimplemented) + (error)] + [(7) ;; Contextual positioning + (report/file 'contextual-positioning-unimplemented) + (error)] + [(8) ;; Chaining contextual positioning + (report/file 'chaining-contextual-positioning-unimplemented) + (error)] + [(9) ;; Extension positioning + (report/file 'extension-contextual-positioning-unimplemented) + (error)] + [else + (raise-argument-error 'GPOSProcessor:applyLookup "supported GPOS table" lookupType)])) + + + + (define/override (applyFeatures userFeatures glyphs advances) - (error 'gpos-processor-applyFeatures-not-implemented) - (super applyFeatures userFeatures glyphs advances)) - + (super applyFeatures userFeatures glyphs advances) + (for ([i (in-range (length (· this glyphs)))]) + (send this fixCursiveAttachment i)) + (send this fixMarkAttachment)) + + ) \ No newline at end of file diff --git a/pitfall/fontkit/ot-processor.rkt b/pitfall/fontkit/ot-processor.rkt index f1502c11..96761795 100644 --- a/pitfall/fontkit/ot-processor.rkt +++ b/pitfall/fontkit/ot-processor.rkt @@ -1,5 +1,5 @@ #lang fontkit/racket -(require (prefix-in Script- "script.rkt")) +(require (prefix-in Script- "script.rkt") br/cond "glyph-iterator.rkt") (provide (all-defined-out)) #| @@ -16,7 +16,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/opentype/OTProcessor.js [languageTag #f] [features (mhash)] [lookups (mhash)] - [direction #f]) ; appears below + [direction #f] + [glyphIterator #f]) ; appears below ;; initialize to default script + language (selectScript) @@ -32,7 +33,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/opentype/OTProcessor.js (for*/first ([entry (in-list (· this table scriptList))] [s (in-list scripts)] #:when (eq? (· entry tag) s)) - entry)))) + entry)))) (define/public (selectScript [script #f] [language #f]) @@ -56,9 +57,9 @@ https://github.com/mbutterick/fontkit/blob/master/src/opentype/OTProcessor.js (when (and (not language) (not (equal? language (· this languageTag)))) (for/first ([lang (in-list (· this script langSysRecords))] #:when (equal? (· lang tag) language)) - (set-field! language this (· lang langSys)) - (set-field! languageTag this (· lang tag)) - (set! changed #t))) + (set-field! language this (· lang langSys)) + (set-field! languageTag this (· lang tag)) + (set! changed #t))) (when (not (· this language)) (set-field! language this (· this script defaultLangSys))) @@ -68,10 +69,62 @@ https://github.com/mbutterick/fontkit/blob/master/src/opentype/OTProcessor.js (set-field! features this (mhash)) (when (· this language) (for ([featureIndex (in-list (· this language featureIndexes))]) - (define record (list-ref (· this table featureList) featureIndex)) - (dict-set! (· this features) (· record tag) (· record feature))))))) + (define record (list-ref (· this table featureList) featureIndex)) + (dict-set! (· this features) (· record tag) (· record feature))))))) + + (define/public (lookupsForFeatures [userFeatures empty] [exclude #f]) + (report*/file 'ot-proc:lookupsForFeatures) + (sort (for*/list ([tag (in-list userFeatures)] + [feature (in-value (dict-ref (report/file (· this features)) tag #f))] + #:when feature + [lookupIndex (in-list (· feature lookupListIndexes))] + #:unless (and exclude (index-of exclude lookupIndex))) + (report*/file tag lookupIndex) + (mhasheq 'feature tag + 'index lookupIndex + 'lookup (send (· this table lookupList) get lookupIndex))) + < #:key (λ (i) (report*/file (· i index))))) + (define/public (applyFeatures userFeatures glyphs advances) - (error 'ot-processor-applyFeatures-not-implemented))) + (report/file 'ot-proc:applyFeatures-part1) + (define lookups (send this lookupsForFeatures userFeatures)) + (report/file 'ot-proc:applyFeatures-part2) + (send this applyLookups lookups glyphs advances)) + + (define/public (applyLookups lookups glyphs positions) + (set-field! glyphs this glyphs) + (set-field! positions this positions) + (report/file 'ot-proc:applyLookups) + (set-field! glyphIterator this (+GlyphIterator glyphs)) + (for* ([lookup-entry (in-list lookups)]) + (define feature (dict-ref lookup-entry 'feature)) + (define lookup (dict-ref lookup-entry 'lookup)) + (send (· this glyphIterator) reset (· lookup flags)) + (while (< (· this glyphIterator index) (length glyphs)) + (when (dict-has-key? (· this glyphIterator cur features) feature) + (for/first ([table (in-list (· lookup subTables))]) + (send this applyLookup (· lookup lookupType) table))) + (send (· this glyphIterator) next)))) + + (abstract applyLookup) + + (define/public (applyLookupList lookupRecords) + (report/file 'applyLookupList-not-implemented) + (error)) + + (define/public (coverageIndex coverage [glyph #f]) + (unless glyph + (set! glyph (· this glyphIterator cur id))) + + (or (case (· coverage version) + [(1) (index-of (· coverage glyphs) glyph)] + [(2) (for/first ([range (in-list (· coverage rangeRecords))] + #:when (<= (· range start) glyph (· range end))) + (+ (· range startCoverageIndex) glyph (- (· range start))))] + [else #f]) -1)) + + + ) \ No newline at end of file