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 (let/ec return
(for ([i (in-naturals)] (for ([i (in-naturals)]
#:break (>= (pos stream) end)) #:break (>= (pos stream) end))
(define op (read-byte stream)) (define op (read-byte stream))
(cond (cond
[(< op 32) [(< op 32)
(case= op (case= op
[(1 ;; hstem [(1 ;; hstem
3 ;; vstem 3 ;; vstem
18 ;; hstemhm 18 ;; hstemhm
23) ;; vstemhm 23) ;; vstemhm
(parse-stems)] (parse-stems)]
[(4) ;; vmoveto [(4) ;; vmoveto
(when (> (stack-length stack) 1) (when (> (stack-length stack) 1)
(check-width)) (check-width))
(set! y (+ y (shift stack))) (set! y (+ y (shift stack)))
(moveTo x y)] (moveTo x y)]
[(5) ;; rlineto [(5) ;; rlineto
(let loop () (let loop ()
(when (>= (stack-length stack) 2) (when (>= (stack-length stack) 2)
(set! x (+ x (shift stack))) (set! x (+ x (shift stack)))
(set! y (+ y (shift stack))) (set! y (+ y (shift stack)))
(path-lineTo path x y) (path-lineTo path x y)
(loop)))] (loop)))]
[(6 ;; hlineto [(6 ;; hlineto
7) ;; vlineto 7) ;; vlineto
(let loop ([phase (= op 6)]) (let loop ([phase (= op 6)])
(when (>= (stack-length stack) 1) (when (>= (stack-length stack) 1)
(if phase (if phase
(set! x (+ x (shift stack))) (set! x (+ x (shift stack)))
(set! y (+ y (shift stack)))) (set! y (+ y (shift stack))))
(path-lineTo path x y) (path-lineTo path x y)
(loop (not phase))))] (loop (not phase))))]
[(8) ;; rrcurveto [(8) ;; rrcurveto
(let loop () (let loop ()
(when (positive? (stack-length stack)) (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 c1x (+ x (shift 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 c2x (+ c1x (shift stack)))
(define c2y (+ c1y (shift stack))) (define c2y (+ c1y (shift stack)))
(set! x (+ c2x (shift stack)))
(set! y (+ c2y (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) (path-bezierCurveTo path c1x c1y c2x c2y x y)
(loop (not phase))] (loop)))
[else (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 c1x x)
(define c1y (+ y (shift stack))) (define c1y (+ y (shift stack)))
(define c2x (+ c1x (shift stack))) (define c2x (+ c1x (shift stack)))
(define c2y (+ c1y (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! 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) (path-bezierCurveTo path c1x c1y c2x c2y x y)
(loop (not phase))])))] (loop)))]
[(12) [(28) ;; shortint
(println "warning: check truthiness") (push stack (decode int16be stream))]
(case= (read-byte stream) [(29) ;; callgsubr
[(3) ;; and (define index (+ (pop stack) gsubrs-bias))
(push stack (if (and (pop stack) (pop stack)) 1 0))] (define subr (vector-ref gsubrs index))
[(4) ;; or (when subr
(push stack (if (or (pop stack) (pop stack)) 1 0))] (hash-set! used-gsubrs index #true)
[(5) ;; not (define old-pos (pos stream))
(push stack (if (pop stack) 0 1))] (define old-end end)
[(9) ;; abs (pos stream (index-item-offset subr))
(push stack (abs (pop stack)))] (set! end (+ (index-item-offset subr) (index-item-length subr)))
[(10) ;; add (parse)
(push stack (+ (pop stack) (pop stack)))] (pos stream old-pos)
[(11) ;; sub (set! end old-end))]
(push stack (- (pop stack) (pop stack)))] [(30 ;; vhcurveto
[(12) ;; div 31) ;; hvcurveto
(push stack (/ (pop stack) (pop stack) 1.0))] (let loop ([phase (= op 31)])
[(14) ;; neg (when (>= (stack-length stack) 4)
(push stack (- (pop stack)))] (cond
[(15) ;; eq [phase
(push stack (if (- (pop stack) (pop stack)) 1 0))] (define c1x (+ x (shift stack)))
[(18) ;; drop (define c1y y)
(pop stack)] (define c2x (+ c1x (shift stack)))
[(20) ;; put (define c2y (+ c1y (shift stack)))
(define val (pop stack)) (set! y (+ c2y (shift stack)))
(define idx (pop stack)) (set! x (+ c2x (if (= (stack-length stack) 1) (shift stack) 0)))
(set! trans (list-set trans idx val))] (path-bezierCurveTo path c1x c1y c2x c2y x y)
[(21) ;; get (loop (not phase))]
(push stack (or (list-ref trans (pop stack)) 0))] [else
[(22) ;; ifelse (define c1x x)
(define s1 (pop stack)) (define c1y (+ y (shift stack)))
(define s2 (pop stack)) (define c2x (+ c1x (shift stack)))
(define v1 (pop stack)) (define c2y (+ c1y (shift stack)))
(define v2 (pop stack)) (set! x (+ c2x (shift stack)))
(push stack (if (<= v1 v2) s1 s2))] (set! y (+ c2y (if (= (stack-length stack) 1) (shift stack) 0)))
[(23) ;; random (path-bezierCurveTo path c1x c1y c2x c2y x y)
(push stack (random))] (loop (not phase))])))]
[(24) ;; mul [(12)
(push stack (* (pop stack) (pop stack)))] (println "warning: check truthiness")
[(26) ;; sqrt (set! op (read-byte stream))
(push stack (sqrt (pop stack)))] (case= op
[(26) ;; dup [(3) ;; and
(define a (pop stack)) (push stack (if (and (pop stack) (pop stack)) 1 0))]
(push stack a a)] [(4) ;; or
[(28) ;; exch (push stack (if (or (pop stack) (pop stack)) 1 0))]
(define a (pop stack)) [(5) ;; not
(define b (pop stack)) (push stack (if (pop stack) 0 1))]
(push stack b a)] [(9) ;; abs
[(29) ;; index (push stack (abs (pop stack)))]
(define idx [(10) ;; add
(min (max 0 (pop stack)) (- (stack-length stack) 1))) (push stack (+ (pop stack) (pop stack)))]
(push stack (list-ref stack idx))] [(11) ;; sub
[(30) ;; roll (push stack (- (pop stack) (pop stack)))]
(define n (pop stack)) [(12) ;; div
(define j (pop stack)) (push stack (/ (pop stack) (pop stack) 1.0))]
(cond [(14) ;; neg
[(>= j 0) (push stack (- (pop stack)))]
(let loop ([j j]) [(15) ;; eq
(when (positive? j) (push stack (if (- (pop stack) (pop stack)) 1 0))]
(define t (list-ref stack (- n 1))) [(18) ;; drop
(for [(i (in-range (- n 2) (sub1 0) -1))] (pop stack)]
(set! stack (list-set stack (+ i 1) (list-ref stack i)))) [(20) ;; put
(set! stack (list-set stack 0 t)) (define val (pop stack))
(loop (sub1 j))))] (define idx (pop stack))
[else (set! trans (list-set trans idx val))]
(let loop ([j j]) [(21) ;; get
(when (negative? j) (push stack (or (list-ref trans (pop stack)) 0))]
(define t (list-ref stack 0)) [(22) ;; ifelse
(for ([i (in-range (add1 n))]) (define s1 (pop stack))
(set! stack (list-set stack i (list-ref stack (+ i 1))))) (define s2 (pop stack))
(set! stack (list-set stack (- n 1) t)) (define v1 (pop stack))
(loop (add1 j))))])] (define v2 (pop stack))
[(34) ;; hflex (push stack (if (<= v1 v2) s1 s2))]
(define c1x (+ x (shift stack))) [(23) ;; random
(define c1y y) (push stack (random))]
(define c2x (+ c1x (shift stack))) [(24) ;; mul
(define c2y (+ c1y (shift stack))) (push stack (* (pop stack) (pop stack)))]
(define c3x (+ c2x (shift stack))) [(26) ;; sqrt
(define c3y c2y) (push stack (sqrt (pop stack)))]
(define c4x (+ c3x (shift stack))) [(26) ;; dup
(define c4y c3y) (define a (pop stack))
(define c5x (+ c4x (shift stack))) (push stack a a)]
(define c5y c4y) [(28) ;; exch
(define c6x (+ c5x (shift stack))) (define a (pop stack))
(define c6y c5y) (define b (pop stack))
(set! x c6x) (push stack b a)]
(set! y c6y) [(29) ;; index
(path-bezierCurveTo path c1x c1y c2x c2y c3x c3y) (define idx
(path-bezierCurveTo path c4x c4y c5x c5y c6x c6y)] (min (max 0 (pop stack)) (- (stack-length stack) 1)))
[(35) ;; flex (push stack (list-ref stack idx))]
(define pts null) [(30) ;; roll
(for ([i (in-range (add1 5))]) (define n (pop stack))
(set! x (+ x (shift stack))) (define j (pop stack))
(set! y (+ y (shift stack))) (cond
(push pts x y)) [(>= j 0)
(apply path-bezierCurveTo path (take pts 6)) (let loop ([j j])
(apply path-bezierCurveTo path (drop pts 6)) (when (positive? j)
(shift stack)] ;; fd (define t (list-ref stack (- n 1)))
[(36) ;; hflex1 (for [(i (in-range (- n 2) (sub1 0) -1))]
(define c1x (+ x (shift stack))) (set! stack (list-set stack (+ i 1) (list-ref stack i))))
(define c1y (+ y (shift stack))) (set! stack (list-set stack 0 t))
(define c2x (+ c1x (shift stack))) (loop (sub1 j))))]
(define c2y (+ c1y (shift stack))) [else
(define c3x (+ c2x (shift stack))) (let loop ([j j])
(define c3y c2y) (when (negative? j)
(define c4x (+ c3x (shift stack))) (define t (list-ref stack 0))
(define c4y c3y) (for ([i (in-range (add1 n))])
(define c5x (+ c4x (shift stack))) (set! stack (list-set stack i (list-ref stack (+ i 1)))))
(define c5y (+ c4y (shift stack))) (set! stack (list-set stack (- n 1) t))
(define c6x (+ c5x (shift stack))) (loop (add1 j))))])]
(define c6y c5y) [(34) ;; hflex
(set! x c6x) (define c1x (+ x (shift stack)))
(set! y c6y) (define c1y y)
(path-bezierCurveTo path c1x c1y c2x c2y c3x c3y) (define c2x (+ c1x (shift stack)))
(path-bezierCurveTo path c4x c4y c5x c5y c6x c6y)] (define c2y (+ c1y (shift stack)))
[(37) ;; flex1 (define c3x (+ c2x (shift stack)))
(define startx x) (define c3y c2y)
(define starty y) (define c4x (+ c3x (shift stack)))
(define pts null) (define c4y c3y)
(for ([i (in-range 0 (add1 4))]) (define c5x (+ c4x (shift stack)))
(set! x (+ x (shift stack))) (define c5y c4y)
(set! y (+ y (shift stack))) (define c6x (+ c5x (shift stack)))
(push pts x y)) (define c6y c5y)
(cond (set! x c6x)
[(> (abs (- x startx)) (abs (- y starty))) ;; horzontal (set! y c6y)
(set! x (shift stack)) (path-bezierCurveTo path c1x c1y c2x c2y c3x c3y)
(set! y starty)] (path-bezierCurveTo path c4x c4y c5x c5y c6x c6y)]
[else [(35) ;; flex
(set! x startx) (define pts null)
(set! y (shift stack))]) (for ([i (in-range (add1 5))])
(push pts x y) (set! x (+ x (shift stack)))
(apply path-bezierCurveTo path (take pts 6)) (set! y (+ y (shift stack)))
(apply path-bezierCurveTo path (drop pts 6))] (push pts x y))
[else (error (format "unknown op: 12 ~a" op))])] (apply path-bezierCurveTo path (take pts 6))
[else (error (format "unknown op: ~a" op))])] (apply path-bezierCurveTo path (drop pts 6))
[else (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 (push stack (cond
[(< op 247) (- op 139)] [(< op 247) (- op 139)]
[(< op 251) (+ (* (- op 247) 256) (read-byte stream) 108)] [(< op 251) (+ (* (- op 247) 256) (read-byte stream) 108)]
[(< op 255) (- (* (- 251 op) 256) (read-byte stream) 108)] [(< op 255) (- (* (- 251 op) 256) (read-byte stream) 108)]
[else (/ (decode int32be stream) 65536.0)]))])))) [else (/ (decode int32be stream) 65536.0)]))]))))
(when open (path-closePath path)) (when open (path-closePath path))
(set-cff-glyph-_usedSubrs! this used-subrs) (set-cff-glyph-_usedSubrs! this used-subrs)

Loading…
Cancel
Save