a mutation

main
Matthew Butterick 5 years ago
parent 6942780f64
commit 94943055c3

@ -99,322 +99,323 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
(let/ec return
(for ([i (in-naturals)]
#:break (>= (pos stream) end))
(define op (read-byte stream))
(cond
[(< op 32)
(case= op
[(1 ;; hstem
3 ;; vstem
18 ;; hstemhm
23) ;; vstemhm
(parse-stems)]
[(4) ;; vmoveto
(when (> (stack-length stack) 1)
(check-width))
(set! y (+ y (shift stack)))
(moveTo x y)]
[(5) ;; rlineto
(let loop ()
(when (>= (stack-length stack) 2)
(set! x (+ x (shift stack)))
(set! y (+ y (shift stack)))
(path-lineTo path x y)
(loop)))]
[(6 ;; hlineto
7) ;; vlineto
(let loop ([phase (= op 6)])
(when (>= (stack-length stack) 1)
(if phase
(set! x (+ x (shift stack)))
(set! y (+ y (shift stack))))
(path-lineTo path x y)
(loop (not phase))))]
[(8) ;; rrcurveto
(let loop ()
(when (positive? (stack-length stack))
(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)))]
[(10) ;; callsubr
(define index (+ (pop stack) subrs-bias))
(define subr (vector-ref subrs index))
(when subr
(hash-set! used-subrs index #true)
(define p (pos stream))
(define e end)
(pos stream (index-item-offset subr))
(set! end (+ (index-item-offset subr) (index-item-length subr)))
(parse)
(pos stream p)
(set! end e))]
[(11) ;; return
(when (< (hash-ref cff 'version) 2)
(return))]
[(14) ;; endchar
(when (< (hash-ref cff 'version) 2)
(when (> (stack-length stack) 0)
(check-width))
(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
(parse-stems)
(pos stream (+ (pos stream) (arithmetic-shift (+ nStems 7) -3)))]
[(21) ;; rmoveto
(when (> (stack-length stack) 2)
(check-width))
(set! x (+ x (shift stack)))
(set! y (+ y (shift stack)))
(moveTo x y)]
[(22) ;; hmoveto
(when (> (stack-length stack) 1)
(check-width))
(set! x (+ x (shift stack)))
(moveTo x y)]
[(24) ;; rcurveline
(let loop ()
(when (>= (stack-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 (>= (stack-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 (odd? (stack-length stack))
(set! x (+ x (shift stack))))
(let loop ()
(when (>= (stack-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 (odd? (stack-length stack))
(set! y (+ y (shift stack))))
(let loop ()
(when (>= (stack-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) gsubrs-bias))
(define subr (vector-ref gsubrs index))
(when subr
(hash-set! used-gsubrs index #true)
(define old-pos (pos stream))
(define old-end end)
(pos stream (index-item-offset subr))
(set! end (+ (index-item-offset subr) (index-item-length subr)))
(parse)
(pos stream old-pos)
(set! end old-end))]
[(30 ;; vhcurveto
31) ;; hvcurveto
(let loop ([phase (= op 31)])
(when (>= (stack-length stack) 4)
(cond
[phase
(define op (read-byte stream))
(cond
[(< op 32)
(case= op
[(1 ;; hstem
3 ;; vstem
18 ;; hstemhm
23) ;; vstemhm
(parse-stems)]
[(4) ;; vmoveto
(when (> (stack-length stack) 1)
(check-width))
(set! y (+ y (shift stack)))
(moveTo x y)]
[(5) ;; rlineto
(let loop ()
(when (>= (stack-length stack) 2)
(set! x (+ x (shift stack)))
(set! y (+ y (shift stack)))
(path-lineTo path x y)
(loop)))]
[(6 ;; hlineto
7) ;; vlineto
(let loop ([phase (= op 6)])
(when (>= (stack-length stack) 1)
(if phase
(set! x (+ x (shift stack)))
(set! y (+ y (shift stack))))
(path-lineTo path x y)
(loop (not phase))))]
[(8) ;; rrcurveto
(let loop ()
(when (positive? (stack-length stack))
(define c1x (+ x (shift stack)))
(define c1y y)
(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)))]
[(10) ;; callsubr
(define index (+ (pop stack) subrs-bias))
(define subr (vector-ref subrs index))
(when subr
(hash-set! used-subrs index #true)
(define p (pos stream))
(define e end)
(pos stream (index-item-offset subr))
(set! end (+ (index-item-offset subr) (index-item-length subr)))
(parse)
(pos stream p)
(set! end e))]
[(11) ;; return
(when (< (hash-ref cff 'version) 2)
(return))]
[(14) ;; endchar
(when (< (hash-ref cff 'version) 2)
(when (> (stack-length stack) 0)
(check-width))
(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
(parse-stems)
(pos stream (+ (pos stream) (arithmetic-shift (+ nStems 7) -3)))]
[(21) ;; rmoveto
(when (> (stack-length stack) 2)
(check-width))
(set! x (+ x (shift stack)))
(set! y (+ y (shift stack)))
(moveTo x y)]
[(22) ;; hmoveto
(when (> (stack-length stack) 1)
(check-width))
(set! x (+ x (shift stack)))
(moveTo x y)]
[(24) ;; rcurveline
(let loop ()
(when (>= (stack-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)))
(set! x (+ c2x (if (= (stack-length stack) 1) (shift stack) 0)))
(path-bezierCurveTo path c1x c1y c2x c2y x y)
(loop (not phase))]
[else
(loop)))
(set! x (+ x (shift stack)))
(set! y (+ y (shift stack)))
(path-lineTo path x y)]
[(25) ;; rlinecurve
(let loop ()
(when (>= (stack-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 (odd? (stack-length stack))
(set! x (+ x (shift stack))))
(let loop ()
(when (>= (stack-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 (odd? (stack-length stack))
(set! y (+ y (shift stack))))
(let loop ()
(when (>= (stack-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 (if (= (stack-length stack) 1) (shift stack) 0)))
(set! y c2y)
(path-bezierCurveTo path c1x c1y c2x c2y x y)
(loop (not phase))])))]
[(12)
(println "warning: check truthiness")
(case= (read-byte stream)
[(3) ;; and
(push stack (if (and (pop stack) (pop stack)) 1 0))]
[(4) ;; or
(push stack (if (or (pop stack) (pop stack)) 1 0))]
[(5) ;; not
(push stack (if (pop stack) 0 1))]
[(9) ;; abs
(push stack (abs (pop stack)))]
[(10) ;; add
(push stack (+ (pop stack) (pop stack)))]
[(11) ;; sub
(push stack (- (pop stack) (pop stack)))]
[(12) ;; div
(push stack (/ (pop stack) (pop stack) 1.0))]
[(14) ;; neg
(push stack (- (pop stack)))]
[(15) ;; eq
(push stack (if (- (pop stack) (pop stack)) 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
(push stack (or (list-ref trans (pop stack)) 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
(push stack (* (pop stack) (pop stack)))]
[(26) ;; sqrt
(push stack (sqrt (pop stack)))]
[(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
(min (max 0 (pop stack)) (- (stack-length stack) 1)))
(push stack (list-ref stack idx))]
[(30) ;; roll
(define n (pop stack))
(define j (pop stack))
(cond
[(>= j 0)
(let loop ([j j])
(when (positive? j)
(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))
(loop (sub1 j))))]
[else
(let loop ([j j])
(when (negative? j)
(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))
(loop (add1 j))))])]
[(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))])]
[else
(loop)))]
[(28) ;; shortint
(push stack (decode int16be stream))]
[(29) ;; callgsubr
(define index (+ (pop stack) gsubrs-bias))
(define subr (vector-ref gsubrs index))
(when subr
(hash-set! used-gsubrs index #true)
(define old-pos (pos stream))
(define old-end end)
(pos stream (index-item-offset subr))
(set! end (+ (index-item-offset subr) (index-item-length subr)))
(parse)
(pos stream old-pos)
(set! end old-end))]
[(30 ;; vhcurveto
31) ;; hvcurveto
(let loop ([phase (= op 31)])
(when (>= (stack-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 (= (stack-length stack) 1) (shift stack) 0)))
(path-bezierCurveTo path c1x c1y c2x c2y x y)
(loop (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 (= (stack-length stack) 1) (shift stack) 0)))
(path-bezierCurveTo path c1x c1y c2x c2y x y)
(loop (not phase))])))]
[(12)
(println "warning: check truthiness")
(set! op (read-byte stream))
(case= op
[(3) ;; and
(push stack (if (and (pop stack) (pop stack)) 1 0))]
[(4) ;; or
(push stack (if (or (pop stack) (pop stack)) 1 0))]
[(5) ;; not
(push stack (if (pop stack) 0 1))]
[(9) ;; abs
(push stack (abs (pop stack)))]
[(10) ;; add
(push stack (+ (pop stack) (pop stack)))]
[(11) ;; sub
(push stack (- (pop stack) (pop stack)))]
[(12) ;; div
(push stack (/ (pop stack) (pop stack) 1.0))]
[(14) ;; neg
(push stack (- (pop stack)))]
[(15) ;; eq
(push stack (if (- (pop stack) (pop stack)) 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
(push stack (or (list-ref trans (pop stack)) 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
(push stack (* (pop stack) (pop stack)))]
[(26) ;; sqrt
(push stack (sqrt (pop stack)))]
[(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
(min (max 0 (pop stack)) (- (stack-length stack) 1)))
(push stack (list-ref stack idx))]
[(30) ;; roll
(define n (pop stack))
(define j (pop stack))
(cond
[(>= j 0)
(let loop ([j j])
(when (positive? j)
(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))
(loop (sub1 j))))]
[else
(let loop ([j j])
(when (negative? j)
(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))
(loop (add1 j))))])]
[(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))])]
[else
(push stack (cond
[(< op 247) (- op 139)]
[(< op 251) (+ (* (- op 247) 256) (read-byte stream) 108)]
[(< op 255) (- (* (- 251 op) 256) (read-byte stream) 108)]
[else (/ (decode int32be stream) 65536.0)]))]))))
(push stack (cond
[(< op 247) (- op 139)]
[(< op 251) (+ (* (- op 247) 256) (read-byte stream) 108)]
[(< op 255) (- (* (- 251 op) 256) (read-byte stream) 108)]
[else (/ (decode int32be stream) 65536.0)]))]))))
(when open (path-closePath path))
(set-cff-glyph-_usedSubrs! this used-subrs)

Loading…
Cancel
Save