|
|
#lang debug racket
|
|
|
(require racket/match
|
|
|
xenomorph
|
|
|
fontland/struct
|
|
|
fontland/table-stream
|
|
|
fontland/table/cff/cff-font
|
|
|
fontland/path)
|
|
|
(provide (all-defined-out))
|
|
|
|
|
|
#|
|
|
|
approximates
|
|
|
https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
|
|
|
|#
|
|
|
|
|
|
(define (bias this s)
|
|
|
(cond
|
|
|
[(< (length s) 1240) 107]
|
|
|
[(< (length s) 33900) 1131]
|
|
|
[else 32768]))
|
|
|
|
|
|
(define (getPath this)
|
|
|
(define stream (ttf-font-port (glyph-font this)))
|
|
|
;;;(define pos (pos stream))
|
|
|
|
|
|
(define cff (get-table (glyph-font this) 'CFF_))
|
|
|
(define str (list-ref (hash-ref (hash-ref cff 'topDict) 'CharStrings) (glyph-id this)))
|
|
|
(define end (+ (hash-ref str 'offset) (hash-ref str 'length)))
|
|
|
(pos stream (hash-ref str 'offset))
|
|
|
|
|
|
(define path (Path))
|
|
|
(define stack null)
|
|
|
(define trans null)
|
|
|
|
|
|
(define width #false)
|
|
|
(define nStems 0)
|
|
|
(define x 0)
|
|
|
(define y 0)
|
|
|
(define usedGsubrs (make-hash))
|
|
|
(define usedSubrs (make-hash))
|
|
|
(define open #false)
|
|
|
|
|
|
(define gsubrs (hash-ref cff 'globalSubrIndex null))
|
|
|
(define gsubrsBias (bias this gsubrs))
|
|
|
|
|
|
(define privateDict (privateDictForGlyph cff (glyph-id this)))
|
|
|
(define subrs (hash-ref privateDict 'Subrs null))
|
|
|
(define subrsBias (bias this subrs))
|
|
|
|
|
|
;; skip variations shit
|
|
|
#;(define vstore (and (hash-ref* cff 'topDict 'vstore)
|
|
|
(hash-ref* cff 'topDict 'vstore)))
|
|
|
#;(define vsindex (hash-ref privateDict 'vsindex))
|
|
|
#;(define variationProcessor )
|
|
|
|
|
|
(define-syntax-rule (shift ID)
|
|
|
(begin0
|
|
|
(car ID)
|
|
|
(set! ID (cdr ID))))
|
|
|
|
|
|
(define-syntax-rule (push ID VAL ...)
|
|
|
(begin
|
|
|
(set! ID (append ID (list VAL ...)))
|
|
|
ID))
|
|
|
|
|
|
(define-syntax-rule (pop ID)
|
|
|
(cond
|
|
|
[(> (length ID) 0)
|
|
|
(define-values (head last) (split-at-right ID 1))
|
|
|
(set! ID head)
|
|
|
(car last)]))
|
|
|
|
|
|
(define (checkWidth)
|
|
|
(unless width
|
|
|
(set! width (+ (shift stack) (hash-ref privateDict 'nominalWidthX)))))
|
|
|
|
|
|
(define (parseStems)
|
|
|
(when (not (zero? (modulo (length stack) 2)))
|
|
|
(checkWidth))
|
|
|
|
|
|
(set! nStems (+ nStems (arithmetic-shift (length stack) -1)))
|
|
|
(set! stack null)
|
|
|
(length stack))
|
|
|
|
|
|
(define (moveTo x y)
|
|
|
(when open
|
|
|
(path-closePath path))
|
|
|
(path-moveTo path x y)
|
|
|
(set! open #true))
|
|
|
|
|
|
(define (parse)
|
|
|
(let/ec return
|
|
|
(let loop ()
|
|
|
(when (< (pos stream) end)
|
|
|
(define op (read-byte stream))
|
|
|
(cond
|
|
|
[(< op 32)
|
|
|
(case op
|
|
|
[(1 ;; hstem
|
|
|
3 ;; vstem
|
|
|
18 ;; hstemhm
|
|
|
23) ;; vstemhm
|
|
|
(parseStems)]
|
|
|
[(4) ;; vmoveto
|
|
|
(when (> (length stack) 1)
|
|
|
(checkWidth))
|
|
|
(set! y (+ y (shift stack)))
|
|
|
(moveTo x y)]
|
|
|
[(5) ;; rlineto
|
|
|
(let loop ()
|
|
|
(when (>= (length stack) 2)
|
|
|
(set! x (+ x (shift stack)))
|
|
|
(set! y (+ y (shift stack)))
|
|
|
(path-lineTo path x y)
|
|
|
(loop)))]
|
|
|
[(6 ;; hlineto
|
|
|
7) ;; vlineto
|
|
|
(define phase (= op 6))
|
|
|
(let loop ()
|
|
|
(when (>= (length stack) 1)
|
|
|
(if phase
|
|
|
(set! x (+ x (shift stack)))
|
|
|
(set! y (+ y (shift stack))))
|
|
|
(path-lineTo path x y)
|
|
|
(set! phase (not phase))
|
|
|
(loop)))]
|
|
|
[(8) ;; rrcurveto
|
|
|
(let loop ()
|
|
|
(when (> (length stack) 0)
|
|
|
(define c1x (+ x (shift stack)))
|
|
|
(define c1y (+ y (shift stack)))
|
|
|
(define c2x (+ c1x (shift stack)))
|
|
|
(define c2y (+ c1y (shift stack)))
|
|
|
(path-bezierCurveTo path c1x c1y c2x c2y x y)))]
|
|
|
|
|
|
[(10) ;; callsubr
|
|
|
(define index (+ (pop stack) subrsBias))
|
|
|
(define subr (list-ref subrs index))
|
|
|
(when subr
|
|
|
(hash-set! usedSubrs index #true)
|
|
|
(define p (pos stream))
|
|
|
(define e end)
|
|
|
(pos stream (hash-ref subr 'offset))
|
|
|
(set! end (+ (hash-ref subr 'offset) (hash-ref subr 'length)))
|
|
|
(parse)
|
|
|
(pos stream p)
|
|
|
(set! end e))]
|
|
|
[(11) ;; return
|
|
|
(cond
|
|
|
[(>= (hash-ref cff 'version) 2) (void)]
|
|
|
[else (return)])]
|
|
|
[(14) ;; endchar
|
|
|
(cond
|
|
|
[(>= (hash-ref cff 'version) 2) (void)]
|
|
|
[else
|
|
|
(when (> (length stack) 0)
|
|
|
(checkWidth))
|
|
|
(when open
|
|
|
(path-closePath path)
|
|
|
(set! open #false))])]
|
|
|
[(15) ;; vsindex
|
|
|
(when (< (hash-ref cff 'version) 2)
|
|
|
(error 'vsindex-operator-not-supported))]
|
|
|
|
|
|
[(16) ;; blend
|
|
|
(error 'blend-operator-not-supported)]
|
|
|
|
|
|
[(19 ;; hintmask
|
|
|
20) ;; cntrmask
|
|
|
(parseStems)
|
|
|
(pos stream (+ (pos stream) (arithmetic-shift (+ nStems 7) -3)))]
|
|
|
|
|
|
[(21) ;; rmoveto
|
|
|
(when (> (length stack) 2)
|
|
|
(checkWidth))
|
|
|
|
|
|
(set! x (+ x (shift stack)))
|
|
|
(set! y (+ y (shift stack)))
|
|
|
(moveTo x y)]
|
|
|
|
|
|
[(22) ;; hmoveto
|
|
|
(when (> (length stack) 1)
|
|
|
(checkWidth))
|
|
|
|
|
|
(set! x (+ x (shift stack)))
|
|
|
(moveTo x y)]
|
|
|
|
|
|
[(24) ;; rcurveline
|
|
|
(let loop ()
|
|
|
(when (>= (length stack) 8)
|
|
|
(define c1x (+ x (shift stack)))
|
|
|
(define c1y (+ y (shift stack)))
|
|
|
(define c2x (+ c1x (shift stack)))
|
|
|
(define c2y (+ c1y (shift stack)))
|
|
|
(set! x (+ c2x (shift stack)))
|
|
|
(set! y (+ c2y (shift stack)))
|
|
|
(path-bezierCurveTo path c1x c1y c2x c2y x y)
|
|
|
(loop)))
|
|
|
|
|
|
(set! x (+ x (shift stack)))
|
|
|
(set! y (+ y (shift stack)))
|
|
|
(path-lineTo path x y)]
|
|
|
|
|
|
[(25) ;; rlinecurve
|
|
|
(let loop ()
|
|
|
(when (>= (length stack) 8)
|
|
|
(set! x (+ x (shift stack)))
|
|
|
(set! y (+ y (shift stack)))
|
|
|
(path-lineTo path x y)
|
|
|
(loop)))
|
|
|
|
|
|
(define c1x (+ x (shift stack)))
|
|
|
(define c1y (+ y (shift stack)))
|
|
|
(define c2x (+ c1x (shift stack)))
|
|
|
(define c2y (+ c1y (shift stack)))
|
|
|
(set! x (+ c2x (shift stack)))
|
|
|
(set! y (+ c2y (shift stack)))
|
|
|
(path-bezierCurveTo path c1x c1y c2x c2y x y)]
|
|
|
|
|
|
[(26) ;; vvcurveto
|
|
|
(when (not (zero? (modulo (length stack) 2)))
|
|
|
(set! x (+ x (shift stack))))
|
|
|
|
|
|
(let loop ()
|
|
|
(when (>= (length stack) 4)
|
|
|
(define c1x x)
|
|
|
(define c1y (+ y (shift stack)))
|
|
|
(define c2x (+ c1x (shift stack)))
|
|
|
(define c2y (+ c1y (shift stack)))
|
|
|
(set! x c2x)
|
|
|
(set! y (+ c2y (shift stack)))
|
|
|
(path-bezierCurveTo path c1x c1y c2x c2y x y)
|
|
|
(loop)))]
|
|
|
|
|
|
[(27) ;; hhcurveto
|
|
|
(when (not (zero? (modulo (length stack) 2)))
|
|
|
(set! y (+ y (shift stack))))
|
|
|
|
|
|
(let loop ()
|
|
|
(when (>= (length stack) 4)
|
|
|
(define c1x (+ x (shift stack)))
|
|
|
(define c1y y)
|
|
|
(define c2x (+ c1x (shift stack)))
|
|
|
(define c2y (+ c1y (shift stack)))
|
|
|
(set! x (+ c2x (shift stack)))
|
|
|
(set! y c2y)
|
|
|
(path-bezierCurveTo path c1x c1y c2x c2y x y)
|
|
|
(loop)))]
|
|
|
|
|
|
[(28) ;; shortint
|
|
|
(push stack (decode int16be stream))]
|
|
|
|
|
|
[(29) ;; callgsubr
|
|
|
(define index (+ (pop stack) gsubrsBias))
|
|
|
(define subr (list-ref gsubrs index))
|
|
|
(when subr
|
|
|
(hash-set! usedGsubrs index #true)
|
|
|
(define p (pos stream))
|
|
|
(define e end)
|
|
|
(pos stream (hash-ref subr 'offset))
|
|
|
(set! end (+ (hash-ref subr 'offset) (hash-ref subr 'length)))
|
|
|
(parse)
|
|
|
(pos stream p)
|
|
|
(set! end e))]
|
|
|
|
|
|
[(30 ;; vhcurveto
|
|
|
31) ;; hvcurveto
|
|
|
(define phase (= op 31))
|
|
|
(let loop ()
|
|
|
(when (>= (length stack) 4)
|
|
|
(cond
|
|
|
[phase
|
|
|
(define c1x (+ x (shift stack)))
|
|
|
(define c1y y)
|
|
|
(define c2x (+ c1x (shift stack)))
|
|
|
(define c2y (+ c1y (shift stack)))
|
|
|
(set! y (+ c2y (shift stack)))
|
|
|
(set! x (+ c2x (if (= (length stack) 1) (shift stack) 0)))
|
|
|
(path-bezierCurveTo path c1x c1y c2x c2y x y)
|
|
|
(set! phase (not phase))]
|
|
|
[else
|
|
|
(define c1x x)
|
|
|
(define c1y (+ y (shift stack)))
|
|
|
(define c2x (+ c1x (shift stack)))
|
|
|
(define c2y (+ c1y (shift stack)))
|
|
|
(set! x (+ c2x (shift stack)))
|
|
|
(set! y (+ c2y (if (= (length stack) 1) (shift stack) 0)))
|
|
|
(path-bezierCurveTo path c1x c1y c2x c2y x y)
|
|
|
(set! phase (not phase))])
|
|
|
(loop)))]
|
|
|
|
|
|
[(12)
|
|
|
(define op (read-byte stream))
|
|
|
(println "warning: check truthiness")
|
|
|
(case op
|
|
|
[(3) ;; and
|
|
|
(define a (pop stack))
|
|
|
(define b (pop stack))
|
|
|
(push stack (if (and a b) 1 0))]
|
|
|
[(4) ;; or
|
|
|
(define a (pop stack))
|
|
|
(define b (pop stack))
|
|
|
(push stack (if (or a b) 1 0))]
|
|
|
|
|
|
[(5) ;; not
|
|
|
(define a (pop stack))
|
|
|
(push stack (if a 0 1))]
|
|
|
|
|
|
[(9) ;; abs
|
|
|
(define a (pop stack))
|
|
|
(push stack (abs a))]
|
|
|
|
|
|
[(10) ;; add
|
|
|
(define a (pop stack))
|
|
|
(define b (pop stack))
|
|
|
(push stack (+ a b))]
|
|
|
|
|
|
[(11) ;; sub
|
|
|
(define a (pop stack))
|
|
|
(define b (pop stack))
|
|
|
(push stack (- a b))]
|
|
|
|
|
|
[(12) ;; div
|
|
|
(define a (pop stack))
|
|
|
(define b (pop stack))
|
|
|
(push stack (/ a b 1.0))]
|
|
|
|
|
|
[(14) ;; neg
|
|
|
(define a (pop stack))
|
|
|
(push stack (- a))]
|
|
|
|
|
|
[(15) ;; eq
|
|
|
(define a (pop stack))
|
|
|
(define b (pop stack))
|
|
|
(push stack (if (- a b) 1 0))]
|
|
|
|
|
|
[(18) ;; drop
|
|
|
(pop stack)]
|
|
|
|
|
|
[(20) ;; put
|
|
|
(define val (pop stack))
|
|
|
(define idx (pop stack))
|
|
|
(set! trans (list-set trans idx val))]
|
|
|
|
|
|
[(21) ;; get
|
|
|
(define idx (pop stack))
|
|
|
(push stack (or (list-ref trans idx) 0))]
|
|
|
|
|
|
[(22) ;; ifelse
|
|
|
(define s1 (pop stack))
|
|
|
(define s2 (pop stack))
|
|
|
(define v1 (pop stack))
|
|
|
(define v2 (pop stack))
|
|
|
(push stack (if (<= v1 v2) s1 s2))]
|
|
|
|
|
|
[(23) ;; random
|
|
|
(push stack (random))]
|
|
|
|
|
|
[(24) ;; mul
|
|
|
(define a (pop stack))
|
|
|
(define b (pop stack))
|
|
|
(push stack (* a b))]
|
|
|
|
|
|
[(26) ;; sqrt
|
|
|
(define a (pop stack))
|
|
|
(push stack (sqrt a))]
|
|
|
|
|
|
[(26) ;; dup
|
|
|
(define a (pop stack))
|
|
|
(push stack a a)]
|
|
|
|
|
|
[(28) ;; exch
|
|
|
(define a (pop stack))
|
|
|
(define b (pop stack))
|
|
|
(push stack b a)]
|
|
|
|
|
|
[(29) ;; index
|
|
|
(define idx (pop stack))
|
|
|
(cond
|
|
|
[(< idx 0)
|
|
|
(set! idx 0)]
|
|
|
[(> idx (- (length stack) 1))
|
|
|
(set! idx (- (length stack) 1))])
|
|
|
|
|
|
(push stack (list-ref stack idx))]
|
|
|
|
|
|
[(30) ;; roll
|
|
|
(define n (pop stack))
|
|
|
(define j (pop stack))
|
|
|
|
|
|
(cond
|
|
|
[(>= j 0)
|
|
|
(let loop ()
|
|
|
(when (> j 0)
|
|
|
(define t (list-ref stack (- n 1)))
|
|
|
(for [(i (in-range (- n 2) (sub1 0) -1))]
|
|
|
(set! stack
|
|
|
(list-set stack (+ i 1) (list-ref stack i))))
|
|
|
|
|
|
(set! stack (list-set stack 0 t))
|
|
|
(set! j (sub1 j))
|
|
|
(loop)))]
|
|
|
[else
|
|
|
(let loop ()
|
|
|
(when (< j 0)
|
|
|
(define t (list-ref stack 0))
|
|
|
(for ([i (in-range (add1 n))])
|
|
|
(set! stack (list-set stack i (list-ref stack (+ i 1)))))
|
|
|
|
|
|
(set! stack (list-set stack (- n 1) t))))])]
|
|
|
[(34) ;; hflex
|
|
|
(define c1x (+ x (shift stack)))
|
|
|
(define c1y y)
|
|
|
(define c2x (+ c1x (shift stack)))
|
|
|
(define c2y (+ c1y (shift stack)))
|
|
|
(define c3x (+ c2x (shift stack)))
|
|
|
(define c3y c2y)
|
|
|
(define c4x (+ c3x (shift stack)))
|
|
|
(define c4y c3y)
|
|
|
(define c5x (+ c4x (shift stack)))
|
|
|
(define c5y c4y)
|
|
|
(define c6x (+ c5x (shift stack)))
|
|
|
(define c6y c5y)
|
|
|
(set! x c6x)
|
|
|
(set! y c6y)
|
|
|
(path-bezierCurveTo path c1x c1y c2x c2y c3x c3y)
|
|
|
(path-bezierCurveTo path c4x c4y c5x c5y c6x c6y)]
|
|
|
|
|
|
[(35) ;; flex
|
|
|
(define pts null)
|
|
|
(for ([i (in-range (add1 5))])
|
|
|
(set! x (+ x (shift stack)))
|
|
|
(set! y (+ y (shift stack)))
|
|
|
(push pts x y))
|
|
|
|
|
|
(apply path-bezierCurveTo path (take pts 6))
|
|
|
(apply path-bezierCurveTo path (drop pts 6))
|
|
|
(shift stack) ;; fd
|
|
|
]
|
|
|
|
|
|
[(36) ;; hflex1
|
|
|
(define c1x (+ x (shift stack)))
|
|
|
(define c1y (+ y (shift stack)))
|
|
|
(define c2x (+ c1x (shift stack)))
|
|
|
(define c2y (+ c1y (shift stack)))
|
|
|
(define c3x (+ c2x (shift stack)))
|
|
|
(define c3y c2y)
|
|
|
(define c4x (+ c3x (shift stack)))
|
|
|
(define c4y c3y)
|
|
|
(define c5x (+ c4x (shift stack)))
|
|
|
(define c5y (+ c4y (shift stack)))
|
|
|
(define c6x (+ c5x (shift stack)))
|
|
|
(define c6y c5y)
|
|
|
(set! x c6x)
|
|
|
(set! y c6y)
|
|
|
|
|
|
(path-bezierCurveTo path c1x c1y c2x c2y c3x c3y)
|
|
|
(path-bezierCurveTo path c4x c4y c5x c5y c6x c6y)]
|
|
|
|
|
|
[(37) ;; flex1
|
|
|
(define startx x)
|
|
|
(define starty y)
|
|
|
|
|
|
(define pts null)
|
|
|
(for ([i (in-range 0 (add1 4))])
|
|
|
(set! x (+ x (shift stack)))
|
|
|
(set! y (+ y (shift stack)))
|
|
|
(push pts x y))
|
|
|
|
|
|
(cond
|
|
|
[(> (abs (- x startx)) (abs (- y starty))) ;; horzontal
|
|
|
(set! x (shift stack))
|
|
|
(set! y starty)]
|
|
|
[else
|
|
|
(set! x startx)
|
|
|
(set! y (shift stack))])
|
|
|
|
|
|
(push pts x y)
|
|
|
(apply path-bezierCurveTo path (take pts 6))
|
|
|
(apply path-bezierCurveTo path (drop pts 6))]
|
|
|
[else (error (format "unknown op: 12 ~a" op))])]
|
|
|
[else (error (format "unknown op: ~a" op))])]
|
|
|
[(< op 247) (push stack (- op 139))]
|
|
|
[(< op 251)
|
|
|
(define b1 (read-byte stream))
|
|
|
(push stack (+ (* (- op 247) 256) b1 108))]
|
|
|
[(< op 255)
|
|
|
(define b1 (read-byte stream))
|
|
|
(push stack (- (* (- op 251) 256) b1 108))]
|
|
|
[else
|
|
|
(push stack (/ (decode int32be stream) 65536))])
|
|
|
(loop)))))
|
|
|
|
|
|
(parse)
|
|
|
|
|
|
(when open
|
|
|
(path-closePath path))
|
|
|
|
|
|
(set-cff-glyph-_usedSubrs! this usedSubrs)
|
|
|
(set-cff-glyph-_usedGsubrs! this usedGsubrs)
|
|
|
(set-cff-glyph-path! this path)
|
|
|
path)
|