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/Untitled.rkt

161 lines
8.9 KiB
Racket

#lang fontkit/racket
(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/file '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))
(set-field! id glyph
(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))
(set-field! id (· this glyphIterator cur) (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 'altnernate-substitution)
(define index (send this coverageIndex (· table coverage)))
(cond
[(= index -1) #f]
[else (define USER_INDEX 0)
(set-field! id (· this glyphIterator cur) (list-ref (send (· table alternateSet) get index) USER_INDEX))
#t])]
[(4) ;; Ligature substitution
(report 'ligature-substitution)
(define index (report* (· table coverage) (send this coverageIndex (· table coverage))))
(cond
[(= index -1) #f]
[(for* ([ligature (in-list (send (· table ligatureSets) get index))]
[matched (in-value (send this sequenceMatchIndices 1 (report* ligature (· ligature components))))]
#:when matched)
(report*/file matched (· this glyphs) index)
(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)])
(get-field codePoints (list-ref (· this glyphs) index))))))
;; Create the replacement ligature glyph
(define ligatureGlyph (+GlyphInfo (· this font) (· ligature glyph) characters (· curGlyph features)))
(set-field! shaperInfo ligatureGlyph (· curGlyph shaperInfo))
(set-field! ligated ligatureGlyph #t)
(set-field! substituted ligatureGlyph #t)
(report 'from-harfbuzz)
;; From Harfbuzz:
;; - If it *is* a mark ligature, we don't allocate a new ligature id, and leave
;; the ligature to keep its old ligature id. This will allow it to attach to
;; a base ligature in GPOS. Eg. if the sequence is: LAM,LAM,SHADDA,FATHA,HEH,
;; and LAM,LAM,HEH for a ligature, they will leave SHADDA and FATHA with a
;; ligature id and component value of 2. Then if SHADDA,FATHA form a ligature
;; later, we don't want them to lose their ligature id/component, otherwise
;; GPOS will fail to correctly position the mark ligature on top of the
;; LAM,LAM,HEH ligature. See https://bugzilla.gnome.org/show_bug.cgi?id=676343
;;
;; - If a ligature is formed of components that some of which are also ligatures
;; themselves, and those ligature components had marks attached to *their*
;; components, we have to attach the marks to the new ligature component
;; positions! Now *that*'s tricky! And these marks may be following the
;; last component of the whole sequence, so we should loop forward looking
;; for them and update them.
;;
;; Eg. the sequence is LAM,LAM,SHADDA,FATHA,HEH, and the font first forms a
;; 'calt' ligature of LAM,HEH, leaving the SHADDA and FATHA with a ligature
;; id and component == 1. Now, during 'liga', the LAM and the LAM-HEH ligature
;; form a LAM-LAM-HEH ligature. We need to reassign the SHADDA and FATHA to
;; the new ligature with a component value of 2.
;;
;; This in fact happened to a font... See
;; https://bugzilla.gnome.org/show_bug.cgi?id=437633
(define isMarkLigature
(and (· curGlyph isMark)
(for/and ([match-idx (in-list matched)])
(· (list-ref (· this glyphs) match-idx) isMark))))
(report isMarkLigature)
(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)))
(report/file 'set-ligature-id)
;; 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)])
(report/file matchIndex)
;; 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
(set-field! glyphs this (drop-right (· this glyphs) (length matched)))
(set-field! glyphs this (list-set (· this glyphs) (· this glyphIterator index) ligatureGlyph))
#t)]
[else #f])])))