flushing sound
parent
b7cf862ae4
commit
7f5e3dae3e
@ -1,81 +0,0 @@
|
|||||||
#lang racket/base
|
|
||||||
(require "racket.rkt")
|
|
||||||
|
|
||||||
(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)
|
|
||||||
(unless (= (abs dir) 1)
|
|
||||||
(raise-argument-error 'GlyphIterator:move "1 or -1" 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/last ([i (in-range (abs count))])
|
|
||||||
(send this move (if (negative? count) -1 1)))))
|
|
||||||
|
|
||||||
(test-module
|
|
||||||
(define gi (+GlyphIterator '(a b c)))
|
|
||||||
(check-equal? (· gi index) 0)
|
|
||||||
(check-equal? (send gi cur) 'a)
|
|
||||||
(check-equal? (send gi move 1) 'b)
|
|
||||||
(check-equal? (send gi move 1) 'c)
|
|
||||||
(check-false (send gi move 1))
|
|
||||||
(check-false (send gi cur))
|
|
||||||
(check-equal? (send gi increment -3) 'a)
|
|
||||||
(check-equal? (send gi cur) 'a)
|
|
||||||
(check-equal? (send gi peek 1) 'b)
|
|
||||||
(check-equal? (send gi peek 2) 'c)
|
|
||||||
(check-equal? (send gi peek 3) #f)
|
|
||||||
(check-equal? (send gi cur) 'a)
|
|
||||||
|
|
||||||
|
|
||||||
)
|
|
@ -1,33 +0,0 @@
|
|||||||
#lang racket/base
|
|
||||||
(require "racket.rkt")
|
|
||||||
|
|
||||||
(require fontland "gpos-processor.rkt" rackunit xenomorph racket/serialize describe)
|
|
||||||
|
|
||||||
(define fira-path "assets/fira.ttf")
|
|
||||||
(define f (openSync fira-path))
|
|
||||||
(define gpos (· f GPOS))
|
|
||||||
|
|
||||||
(define proc (+GPOSProcessor f gpos))
|
|
||||||
|
|
||||||
(check-equal? (dump (· proc features))
|
|
||||||
'((cpsp (lookupCount . 1) (lookupListIndexes 0) (featureParams . 0))
|
|
||||||
(mkmk (lookupCount . 5) (lookupListIndexes 8 9 10 11 12) (featureParams . 0))
|
|
||||||
(mark (lookupCount . 3) (lookupListIndexes 5 6 7) (featureParams . 0))
|
|
||||||
(kern (lookupCount . 4) (lookupListIndexes 1 2 3 4) (featureParams . 0))))
|
|
||||||
|
|
||||||
(check-equal? (dump (· proc script))
|
|
||||||
'((count . 0)
|
|
||||||
(defaultLangSys (featureIndexes 0 14 28 42)
|
|
||||||
(reserved . 0)
|
|
||||||
(reqFeatureIndex . 65535)
|
|
||||||
(featureCount . 4))
|
|
||||||
(langSysRecords)))
|
|
||||||
(check-equal? (dump (· proc scriptTag)) 'DFLT)
|
|
||||||
(check-equal? (dump (· proc language))
|
|
||||||
'((featureIndexes 0 14 28 42)
|
|
||||||
(reserved . 0)
|
|
||||||
(reqFeatureIndex . 65535)
|
|
||||||
(featureCount . 4)))
|
|
||||||
(check-equal? (dump (· proc languageTag)) #f)
|
|
||||||
(check-equal? (dump (· proc lookups)) empty)
|
|
||||||
(check-equal? (dump (· proc direction)) 'ltr)
|
|
@ -1,26 +0,0 @@
|
|||||||
#lang racket/base
|
|
||||||
(require "racket.rkt")
|
|
||||||
|
|
||||||
(require fontland "gsub-processor.rkt" rackunit xenomorph racket/serialize describe)
|
|
||||||
|
|
||||||
(define fira-path "assets/fira.ttf")
|
|
||||||
(define f (openSync fira-path))
|
|
||||||
(define gsub (· f GSUB))
|
|
||||||
|
|
||||||
(define proc (+GSUBProcessor f gsub))
|
|
||||||
|
|
||||||
(check-equal? (map car (dump (· proc features)))
|
|
||||||
'(c2sc pnum liga tnum onum ss01 dlig lnum sups zero ss02 aalt subs ss03 ordn calt dnom smcp salt case numr frac mgrk))
|
|
||||||
|
|
||||||
(check-equal? (dict-ref (dump (· proc language)) 'featureIndexes)
|
|
||||||
'(0 14 28 42 56 70 84 98 112 136 150 164 178 192 206 220 234 248 262 276 290 304 318))
|
|
||||||
|
|
||||||
(check-equal? (dump (· proc scriptTag)) 'DFLT)
|
|
||||||
|
|
||||||
(check-equal? (dict-ref (dump (· proc language)) 'featureIndexes)
|
|
||||||
'(0 14 28 42 56 70 84 98 112 136 150 164 178 192 206 220 234 248 262 276 290 304 318))
|
|
||||||
|
|
||||||
(check-equal? (dump (· proc languageTag)) #f)
|
|
||||||
(check-equal? (dump (· proc lookups)) empty)
|
|
||||||
(check-equal? (dump (· proc direction)) 'ltr)
|
|
||||||
|
|
@ -1,150 +0,0 @@
|
|||||||
#lang racket/base
|
|
||||||
(require "racket.rkt")
|
|
||||||
|
|
||||||
(require "ot-processor.rkt" "glyphinfo.rkt" br/cond)
|
|
||||||
(provide (all-defined-out))
|
|
||||||
|
|
||||||
#|
|
|
||||||
approximates
|
|
||||||
https://github.com/mbutterick/fontkit/blob/master/src/opentype/GSUBProcessor.js
|
|
||||||
|#
|
|
||||||
|
|
||||||
(define-subclass OTProcessor (GSUBProcessor)
|
|
||||||
|
|
||||||
(define/override (applyLookup lookupType table)
|
|
||||||
#;(report lookupType 'GSUBProcessor:applyLookup)
|
|
||||||
(case lookupType
|
|
||||||
[(1) ;; Single Substitution
|
|
||||||
#;(report 'single-substitution)
|
|
||||||
(define index (send this coverageIndex (· table coverage)))
|
|
||||||
(cond
|
|
||||||
[(= index -1) #f]
|
|
||||||
[else (define glyph (· this glyphIterator cur))
|
|
||||||
(send glyph id
|
|
||||||
(case (· table version)
|
|
||||||
[(1) (bitwise-and (+ (· glyph id) (· table deltaGlyphID)) #xffff)]
|
|
||||||
[(2) (send (· table substitute) get index)]))
|
|
||||||
#t])]
|
|
||||||
[(2) ;; Multiple Substitution
|
|
||||||
#;(report 'multiple-substitution)
|
|
||||||
(define index (send this coverageIndex (· table coverage)))
|
|
||||||
(cond
|
|
||||||
[(= index -1) #f]
|
|
||||||
[else (define sequence (send (· table sequences) get index))
|
|
||||||
(send (· this glyphIterator cur) id (list-ref sequence 0))
|
|
||||||
(set-field! ligatureComponent (· this glyphIterator cur) 0)
|
|
||||||
|
|
||||||
(define features (· this glyphIterator cur features))
|
|
||||||
(define curGlyph (· this glyphIterator cur))
|
|
||||||
(define replacement (for/list ([(gid i) (in-indexed (cdr sequence))])
|
|
||||||
(define glyph (+GlyphInfo (· this font) gid #f features))
|
|
||||||
(set-field! shaperInfo glyph (· curGlyph shaperInfo))
|
|
||||||
(set-field! isLigated glyph (· curGlyph isLigated))
|
|
||||||
(set-field! ligatureComponent glyph (add1 i))
|
|
||||||
(set-field! substituted glyph #t)
|
|
||||||
glyph))
|
|
||||||
|
|
||||||
(set-field! glyphs this (let-values ([(head tail) (split-at (· this glyphs) (add1 (· this glyphIterator index)))])
|
|
||||||
(append head replacement tail)))
|
|
||||||
#t])]
|
|
||||||
|
|
||||||
[(3) ;; Alternate substitution
|
|
||||||
#;(report 'alternate-substitution)
|
|
||||||
(define index (send this coverageIndex (· table coverage)))
|
|
||||||
(cond
|
|
||||||
[(= index -1) #f]
|
|
||||||
[else (define USER_INDEX 0)
|
|
||||||
(send (· this glyphIterator cur) id (list-ref (send (· table alternateSet) get index) USER_INDEX))
|
|
||||||
#t])]
|
|
||||||
|
|
||||||
[(4) ;; Ligature substitution
|
|
||||||
#;(report '---------------------------)
|
|
||||||
#;(report 'ligature-substitution)
|
|
||||||
#;(report* lookupType (· table coverage glyphs))
|
|
||||||
(define index (send this coverageIndex (· table coverage)))
|
|
||||||
#;(report index 'forker)
|
|
||||||
(cond
|
|
||||||
[(= index -1) #f]
|
|
||||||
[(for*/or ([ligature (in-list (send (· table ligatureSets) get index))]
|
|
||||||
[matched (in-value (send this sequenceMatchIndices 1 (· ligature components)))]
|
|
||||||
#:when matched)
|
|
||||||
(define curGlyph (· this glyphIterator cur))
|
|
||||||
|
|
||||||
;; Concatenate all of the characters the new ligature will represent
|
|
||||||
(define characters
|
|
||||||
(append (· curGlyph codePoints)
|
|
||||||
(append* (for/list ([index (in-list matched)])
|
|
||||||
index
|
|
||||||
(get-field codePoints (list-ref (· this glyphs) index))))))
|
|
||||||
|
|
||||||
characters
|
|
||||||
;; Create the replacement ligature glyph
|
|
||||||
(define ligatureGlyph (+GlyphInfo (· this font) (· ligature glyph) characters (· curGlyph features)))
|
|
||||||
(· ligatureGlyph id)
|
|
||||||
(set-field! shaperInfo ligatureGlyph (· curGlyph shaperInfo))
|
|
||||||
(set-field! isLigated ligatureGlyph #t)
|
|
||||||
(set-field! substituted ligatureGlyph #t)
|
|
||||||
|
|
||||||
(define isMarkLigature
|
|
||||||
(and (· curGlyph isMark)
|
|
||||||
(for/and ([match-idx (in-list matched)])
|
|
||||||
(· (list-ref (· this glyphs) match-idx) isMark))))
|
|
||||||
|
|
||||||
(set-field! ligatureID ligatureGlyph (cond
|
|
||||||
[isMarkLigature #f]
|
|
||||||
[else (define id (· this ligatureID))
|
|
||||||
(increment-field! ligatureID this)
|
|
||||||
id]))
|
|
||||||
|
|
||||||
(define lastLigID (· curGlyph ligatureID))
|
|
||||||
(define lastNumComps (length (· curGlyph codePoints)))
|
|
||||||
(define curComps lastNumComps)
|
|
||||||
(define idx (add1 (· this glyphIterator index)))
|
|
||||||
|
|
||||||
;; Set ligatureID and ligatureComponent on glyphs that were skipped in the matched sequence.
|
|
||||||
;; This allows GPOS to attach marks to the correct ligature components.
|
|
||||||
(for ([matchIndex (in-list matched)])
|
|
||||||
;; Don't assign new ligature components for mark ligatures (see above)
|
|
||||||
(cond
|
|
||||||
[isMarkLigature (set! idx matchIndex)]
|
|
||||||
[else (while (< idx matchIndex)
|
|
||||||
(define ligatureComponent (+ curComps (- lastNumComps) (min (or (get-field ligatureComponent (list-ref (· this glyphs) idx)) 1) lastNumComps)))
|
|
||||||
(set-field! ligatureID (list-ref (· this glyphs) idx) (· ligatureGlyph ligatureID))
|
|
||||||
(set-field! ligatureComponent (list-ref (· this glyphs) idx) ligatureComponent)
|
|
||||||
(increment! idx))])
|
|
||||||
|
|
||||||
(define lastLigID (· (list-ref (· this glyphs) idx) ligatureID))
|
|
||||||
(define lastNumComps (length (· (list-ref (· this glyphs) idx) codePoints)))
|
|
||||||
(increment! curComps lastNumComps)
|
|
||||||
(increment! idx)) ;; skip base glyph
|
|
||||||
|
|
||||||
;; Adjust ligature components for any marks following
|
|
||||||
(when (and lastLigID (not isMarkLigature))
|
|
||||||
(for ([i (in-range idx (length (· this glyphs)))]
|
|
||||||
#:when (= (· (list-ref (· this glyphs) idx) ligatureID) lastLigID))
|
|
||||||
(define ligatureComponent (+ curComps (- lastNumComps) (min (or (get-field ligatureComponent (list-ref (· this glyphs) i)) 1) lastNumComps)))
|
|
||||||
(set-field! ligatureComponent (list-ref (· this glyphs) i) ligatureComponent)))
|
|
||||||
|
|
||||||
;; Delete the matched glyphs, and replace the current glyph with the ligature glyph
|
|
||||||
#;(report (for/list ([g (· this glyphs)]) (· g id)) 'step-a)
|
|
||||||
#;(report matched)
|
|
||||||
#;(report (· this glyphIterator index))
|
|
||||||
(set-field! glyphs this (for*/list ([(glyph idx) (in-indexed (· this glyphs))]
|
|
||||||
[midx (in-list matched)]
|
|
||||||
#:unless (= idx midx))
|
|
||||||
(if (= idx (· this glyphIterator index))
|
|
||||||
ligatureGlyph
|
|
||||||
glyph)))
|
|
||||||
(set-field! glyphs (· this glyphIterator) (· this glyphs)) ; update glyph iterator to keep it in sync <sigh>
|
|
||||||
#;(report (for/list ([g (· this glyphs)]) (· g id)) 'step-c)
|
|
||||||
#;(report (· this glyphIterator index))
|
|
||||||
#t)]
|
|
||||||
[else #f])]
|
|
||||||
[(5) ;; Contextual Substitution
|
|
||||||
(send this applyContext table)]
|
|
||||||
[(6) ;; Chaining Contextual Substitution
|
|
||||||
(send this applyChainingContext table)]
|
|
||||||
[(7) ;; Extension Substitution
|
|
||||||
(send this applyLookup (· table lookupType) (· table extension))]
|
|
||||||
[else (error 'unimplemented-gsub-lookup)])))
|
|
||||||
|
|
@ -1,131 +0,0 @@
|
|||||||
#lang racket/base
|
|
||||||
(require "racket.rkt")
|
|
||||||
|
|
||||||
(require (prefix-in Script- "script.rkt") "glyph.rkt" "glyphrun.rkt" "glyph-position.rkt" "ot-layout-engine.rkt")
|
|
||||||
(provide (all-defined-out))
|
|
||||||
|
|
||||||
#|
|
|
||||||
approximates
|
|
||||||
https://github.com/mbutterick/fontkit/blob/master/src/layout/LayoutEngine.js
|
|
||||||
|#
|
|
||||||
|
|
||||||
(define-subclass object% (LayoutEngine font)
|
|
||||||
(field [unicodeLayoutEngine #f]
|
|
||||||
[kernProcessor #f]
|
|
||||||
[engine
|
|
||||||
;; Choose an advanced layout engine.
|
|
||||||
;; We try the AAT morx table first since more
|
|
||||||
;; scripts are currently supported because
|
|
||||||
;; the shaping logic is built into the font.
|
|
||||||
(cond
|
|
||||||
[(· this font has-morx-table?) (error 'morx-layout-unimplemented)]
|
|
||||||
[(or (· this font has-gsub-table?) (· this font has-gpos-table?))
|
|
||||||
#;(report/file 'starting-layout-engine)
|
|
||||||
(+OTLayoutEngine (· this font))]
|
|
||||||
[else #f])])
|
|
||||||
|
|
||||||
(as-methods
|
|
||||||
layout
|
|
||||||
substitute
|
|
||||||
position
|
|
||||||
hideDefaultIgnorables
|
|
||||||
isDefaultIgnorable))
|
|
||||||
|
|
||||||
(define/contract (layout this str-or-glyphs [features #f]
|
|
||||||
;; Attempt to detect the script if not provided.
|
|
||||||
[script (if (string? str-or-glyphs)
|
|
||||||
(Script-forString str-or-glyphs)
|
|
||||||
(Script-forCodePoints (append-map (λ (g) (· g codePoints)) str-or-glyphs)))]
|
|
||||||
[language #f])
|
|
||||||
(((or/c string? (listof Glyph?))) ((option/c list?) (option/c symbol?) (option/c symbol?)) . ->*m . GlyphRun?)
|
|
||||||
|
|
||||||
(define glyphs
|
|
||||||
;; Map string to glyphs if needed
|
|
||||||
(if (string? str-or-glyphs)
|
|
||||||
(send (· this font) glyphsForString str-or-glyphs)
|
|
||||||
str-or-glyphs))
|
|
||||||
|
|
||||||
#;(report*/file 'starting-layout-in-layout-engine glyphs)
|
|
||||||
(cond
|
|
||||||
[(empty? glyphs) (+GlyphRun glyphs empty)] ; Return early if there are no glyphs
|
|
||||||
[else
|
|
||||||
;; Setup the advanced layout engine
|
|
||||||
(when (and (· this engine) #;(·? engine setup))
|
|
||||||
(send (· this engine) setup glyphs features script language))
|
|
||||||
|
|
||||||
;; Substitute and position the glyphs
|
|
||||||
(set! glyphs (send this substitute glyphs features script language))
|
|
||||||
#;(report*/file 'end-sub glyphs)
|
|
||||||
#;(error 'stop)
|
|
||||||
#;(report/file 'ready-position)
|
|
||||||
#;(report (for/list ((g (in-list glyphs))) (· g id)) 'shecky)
|
|
||||||
(define positions (send this position glyphs features script language))
|
|
||||||
#;(report (for/list ((p (in-list positions))) (list (· p xAdvance) (· p xOffset))))
|
|
||||||
#;(report/file 'fired-position)
|
|
||||||
|
|
||||||
;; Let the layout engine clean up any state it might have
|
|
||||||
(when (and (· this engine) #;(·? this engine cleanup))
|
|
||||||
(· this engine cleanup))
|
|
||||||
(+GlyphRun glyphs positions)]))
|
|
||||||
|
|
||||||
|
|
||||||
(define (substitute this glyphs features script language)
|
|
||||||
#;((is-a?/c GlyphRun) . ->m . void?)
|
|
||||||
;; Call the advanced layout engine to make substitutions
|
|
||||||
(when (and (· this engine) #;(· this engine substitute))
|
|
||||||
(set! glyphs (send (· this engine) substitute glyphs features script language)))
|
|
||||||
#;(report/file glyphs)
|
|
||||||
glyphs)
|
|
||||||
|
|
||||||
|
|
||||||
(define/contract (position this glyphs features script language)
|
|
||||||
((listof Glyph?) (option/c list?) (option/c symbol?) (option/c symbol?) . ->m . (listof GlyphPosition?))
|
|
||||||
|
|
||||||
(define positions (for/list ([glyph (in-list glyphs)])
|
|
||||||
(make-object GlyphPosition (· glyph advanceWidth))))
|
|
||||||
|
|
||||||
;; Call the advanced layout engine. Returns the features applied.
|
|
||||||
(define positioned
|
|
||||||
(and (· this engine) #;(· this engine position)
|
|
||||||
(send (· this engine) position glyphs positions features script language)))
|
|
||||||
|
|
||||||
;; if there is no GPOS table, use unicode properties to position marks.
|
|
||||||
;; todo: unicode layout
|
|
||||||
#;(unless positioned
|
|
||||||
(unless (· this unicodeLayoutEngine)
|
|
||||||
(set! unicodeLayoutEngine (+UnicodeLayoutEngine (· this font))))
|
|
||||||
(send unicodeLayoutEngine positionGlyphs glyphs positions))
|
|
||||||
|
|
||||||
;; if kerning is not supported by GPOS, do kerning with the TrueType/AAT kern table
|
|
||||||
;; todo: old style kern table
|
|
||||||
#;(when (and (or (not positioned) (not (· positioned kern))) (· this font kern))
|
|
||||||
(unless kernProcessor
|
|
||||||
(set! kernProcessor (+KernProcessor (· this font))))
|
|
||||||
(send kernProcessor process glyphs positions))
|
|
||||||
|
|
||||||
positions
|
|
||||||
)
|
|
||||||
|
|
||||||
|
|
||||||
(define/contract (hideDefaultIgnorables this glyphRun)
|
|
||||||
((is-a?/c GlyphRun) . ->m . void?)
|
|
||||||
(define space (send (· this font) glyphForCodePoint #x20))
|
|
||||||
(define-values (new-glyphs new-positions)
|
|
||||||
(for/lists (ngs nps)
|
|
||||||
([glyph (in-list (· glyphRun glyphs))]
|
|
||||||
[pos (in-list (· glyphRun positions))])
|
|
||||||
(cond
|
|
||||||
[(send this isDefaultIgnorable (car (· glyph codePoints)))
|
|
||||||
(define new-pos pos)
|
|
||||||
(set-field! xAdvance new-pos 0)
|
|
||||||
(set-field! yAdvance new-pos 0)
|
|
||||||
(values space new-pos)]
|
|
||||||
[else (values glyph pos)])))
|
|
||||||
(set-field! glyphs glyphRun new-glyphs)
|
|
||||||
(set-field! positions glyphRun new-positions))
|
|
||||||
|
|
||||||
|
|
||||||
(define/contract (isDefaultIgnorable this codepoint)
|
|
||||||
(index? . ->m . boolean?)
|
|
||||||
#f ; todo: everything
|
|
||||||
)
|
|
@ -1,86 +0,0 @@
|
|||||||
#lang racket/base
|
|
||||||
(require "racket.rkt")
|
|
||||||
|
|
||||||
(require "gsub-processor.rkt" "gpos-processor.rkt" "glyphinfo.rkt" (prefix-in Shapers- "shapers.rkt") "shaping-plan.rkt")
|
|
||||||
(provide (all-defined-out))
|
|
||||||
|
|
||||||
#|
|
|
||||||
https://github.com/mbutterick/fontkit/blob/master/src/opentype/OTLayoutEngine.js
|
|
||||||
|#
|
|
||||||
|
|
||||||
(define-subclass object% (OTLayoutEngine font)
|
|
||||||
(field [glyphInfos #f]
|
|
||||||
[shaper #f]
|
|
||||||
[plan #f]
|
|
||||||
[GSUBProcessor #f]
|
|
||||||
[GPOSProcessor #f])
|
|
||||||
|
|
||||||
#;(report/file 'starting-ot-layout-engine)
|
|
||||||
(when (· font has-gsub-table?)
|
|
||||||
(set-field! GSUBProcessor this (+GSUBProcessor font (or (· font GSUB) (error 'no-gsub-table)))))
|
|
||||||
|
|
||||||
|
|
||||||
(when (· font has-gpos-table?)
|
|
||||||
(set-field! GPOSProcessor this (+GPOSProcessor font (or (· font GPOS) (error 'no-gpos-table)))))
|
|
||||||
|
|
||||||
|
|
||||||
(define/public (setup glyphs features script language)
|
|
||||||
;; Map glyphs to GlyphInfo objects so data can be passed between
|
|
||||||
;; GSUB and GPOS without mutating the real (shared) Glyph objects.
|
|
||||||
(set! glyphInfos (map (λ (glyph) (+GlyphInfo (· this font) (· glyph id) (· glyph codePoints))) glyphs))
|
|
||||||
|
|
||||||
;; Choose a shaper based on the script, and setup a shaping plan.
|
|
||||||
;; This determines which features to apply to which glyphs.
|
|
||||||
(set! shaper (Shapers-choose script))
|
|
||||||
(set! plan (+ShapingPlan (· this font) script language))
|
|
||||||
#;(report/file shaper)
|
|
||||||
(send (make-object shaper) plan (· this plan) (· this glyphInfos) features))
|
|
||||||
|
|
||||||
(define/public (substitute glyphs . _)
|
|
||||||
(cond
|
|
||||||
[(· this GSUBProcessor)
|
|
||||||
#;(report/file (· this glyphInfos))
|
|
||||||
(define new-glyphinfos
|
|
||||||
(send (· this plan) process (· this GSUBProcessor) (· this glyphInfos)))
|
|
||||||
(set! glyphInfos new-glyphinfos) ; update OTLayoutEngine state for positioning pass
|
|
||||||
#;(report/file new-glyphinfos)
|
|
||||||
;; Map glyph infos back to normal Glyph objects
|
|
||||||
#;(report/file (for/list ([glyphInfo (in-list new-glyphinfos)])
|
|
||||||
(send (· this font) getGlyph (· glyphInfo id) (· glyphInfo codePoints))))
|
|
||||||
(for/list ([glyphInfo (in-list new-glyphinfos)])
|
|
||||||
(send (· this font) getGlyph (· glyphInfo id) (· glyphInfo codePoints)))]
|
|
||||||
[else glyphs]))
|
|
||||||
|
|
||||||
(define/public (position glyphs positions . _)
|
|
||||||
#;(report*/file glyphs positions shaper)
|
|
||||||
(define static-shaper (make-object shaper))
|
|
||||||
(when (eq? (· static-shaper zeroMarkWidths) 'BEFORE_GPOS)
|
|
||||||
(zeroMarkAdvances positions))
|
|
||||||
|
|
||||||
(when GPOSProcessor
|
|
||||||
#;(report/file GPOSProcessor)
|
|
||||||
(send (· this plan) process GPOSProcessor glyphInfos positions))
|
|
||||||
|
|
||||||
(when (eq? (· static-shaper zeroMarkWidths) 'AFTER_GPOS)
|
|
||||||
(zeroMarkAdvances positions))
|
|
||||||
|
|
||||||
;; Reverse the glyphs and positions if the script is right-to-left
|
|
||||||
(when (eq? (· this plan direction) 'rtl)
|
|
||||||
(set! glyphs (reverse glyphs))
|
|
||||||
(set! positions (reverse positions)))
|
|
||||||
|
|
||||||
#;(report/file (and GPOSProcessor (· GPOSProcessor features)))
|
|
||||||
(and GPOSProcessor (· GPOSProcessor features)))
|
|
||||||
|
|
||||||
|
|
||||||
(define/public (zeroMarkAdvances positions)
|
|
||||||
(set! positions
|
|
||||||
(for/list ([glyphInfo (in-list glyphInfos)]
|
|
||||||
[position (in-list positions)])
|
|
||||||
(when (· glyphInfo isMark)
|
|
||||||
(dict-set*! position
|
|
||||||
'xAdvance 0
|
|
||||||
'yAdvance 0))
|
|
||||||
position)))
|
|
||||||
|
|
||||||
)
|
|
@ -1,97 +0,0 @@
|
|||||||
#lang racket/base
|
|
||||||
(require "racket.rkt")
|
|
||||||
|
|
||||||
(require (prefix-in Script- "script.rkt"))
|
|
||||||
(provide (all-defined-out))
|
|
||||||
|
|
||||||
#|
|
|
||||||
approximates
|
|
||||||
https://github.com/mbutterick/fontkit/blob/master/src/opentype/ShapingPlan.js
|
|
||||||
|#
|
|
||||||
|
|
||||||
; * ShapingPlans are used by the OpenType shapers to store which
|
|
||||||
; * features should by applied, and in what order to apply them.
|
|
||||||
; * The features are applied in groups called stages. A feature
|
|
||||||
; * can be applied globally to all glyphs, or locally to only
|
|
||||||
; * specific glyphs.
|
|
||||||
|
|
||||||
(define-subclass object% (ShapingPlan font script language)
|
|
||||||
(field [direction (Script-direction script)]
|
|
||||||
[stages empty]
|
|
||||||
[globalFeatures (mhasheq)]
|
|
||||||
[allFeatures (mhasheq)])
|
|
||||||
|
|
||||||
;; Adds the given features to the last stage.
|
|
||||||
;; Ignores features that have already been applied.
|
|
||||||
(define/public (_addFeatures features)
|
|
||||||
#;(report*/file 'stages-before stages)
|
|
||||||
(match-define (list head-stages ... last-stage) stages)
|
|
||||||
(set! stages
|
|
||||||
`(,@head-stages
|
|
||||||
,(append last-stage
|
|
||||||
(for/list ([feature (in-list features)]
|
|
||||||
#:unless (dict-ref (· this allFeatures) feature #f))
|
|
||||||
(dict-set! (· this allFeatures) feature #t)
|
|
||||||
feature))))
|
|
||||||
#;(report*/file 'stages-after stages)
|
|
||||||
stages)
|
|
||||||
|
|
||||||
;; Adds the given features to the global list
|
|
||||||
(define/public (_addGlobal features)
|
|
||||||
(for ([feature (in-list features)])
|
|
||||||
(dict-set! (· this globalFeatures) feature #t)))
|
|
||||||
|
|
||||||
;; Add features to the last stage
|
|
||||||
(define/public (add arg [global #t])
|
|
||||||
(when (zero? (length (· this stages)))
|
|
||||||
(push-end-field! stages this empty))
|
|
||||||
|
|
||||||
(when (string? arg)
|
|
||||||
(set! arg (list arg)))
|
|
||||||
|
|
||||||
(cond
|
|
||||||
[(list? arg)
|
|
||||||
(_addFeatures arg)
|
|
||||||
(when global (_addGlobal arg))]
|
|
||||||
[(dict? arg)
|
|
||||||
(define features (append (or (· arg global) empty)
|
|
||||||
(or (· arg local) empty)))
|
|
||||||
(_addFeatures features)
|
|
||||||
(when (· arg global)
|
|
||||||
(_addGlobal (· arg global)))]
|
|
||||||
[else (raise-argument-error 'ShapingPlan:add "valid arg" arg)]))
|
|
||||||
|
|
||||||
;; Add a new stage
|
|
||||||
(define/public (addStage arg global)
|
|
||||||
(cond
|
|
||||||
[(procedure? arg)
|
|
||||||
(push-end-field! stages this arg)
|
|
||||||
(push-end-field! stages this empty)]
|
|
||||||
[else (push-end-field! stages this empty)
|
|
||||||
(add arg global)]))
|
|
||||||
|
|
||||||
;; Assigns the global features to the given glyphs
|
|
||||||
(define/public (assignGlobalFeatures glyphs)
|
|
||||||
#;(report*/file glyphs (· this globalFeatures))
|
|
||||||
(for* ([glyph (in-list glyphs)]
|
|
||||||
[feature (in-dict-keys (· this globalFeatures))])
|
|
||||||
(dict-set! (· glyph features) feature #t)))
|
|
||||||
|
|
||||||
;; Executes the planned stages using the given OTProcessor
|
|
||||||
(define/public (process processor glyphs [positions #f])
|
|
||||||
#;(report*/file 'shaping-plan-process processor)
|
|
||||||
(send processor selectScript (· this script) (· this language))
|
|
||||||
|
|
||||||
#;(report/file stages)
|
|
||||||
(for/fold ([glyphs glyphs])
|
|
||||||
([stage (in-list stages)])
|
|
||||||
(cond
|
|
||||||
[(and (procedure? stage) (not positions))
|
|
||||||
(stage (· this font) glyphs positions)]
|
|
||||||
[(> (length stage) 0)
|
|
||||||
#;(report*/file 'shaping-plan:applying-features processor)
|
|
||||||
#;(report/file positions)
|
|
||||||
#;(report/file (send processor applyFeatures stage glyphs positions))
|
|
||||||
(send processor applyFeatures stage glyphs positions)]))))
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue