minor refactor

fontland/fontland/cff-glyph.rkt

@@ -18,6 +18,28 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
     [(< (length s) 33900) 1131]
     [else 32768]))
 
+(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-syntax-rule (case= ID [(NUMS ...) . BODY] ... [else . ELSEBODY])
+  (cond
+    [(memq ID (list NUMS ...)) . BODY] ...
+    [else . ELSEBODY]))
+
 (define (getPath this)
   (define stream (ttf-font-port (glyph-font this)))
   ;;;(define pos (pos stream))
@@ -52,38 +74,17 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
   #;(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)
+  (define (check-width)
     (unless width
       (set! width (+ (shift stack) (hash-ref privateDict 'nominalWidthX)))))
 
-  (define (parseStems)
-    (when (not (zero? (modulo (length stack) 2)))
-      (checkWidth))
-
+  (define (parse-stems)
+    (when (odd? (length stack)) (check-width))
     (set! nStems (+ nStems (arithmetic-shift (length stack) -1)))
-    (set! stack null)
-    (length stack))
+    (set! stack null))
 
   (define (moveTo x y)
-    (when open
-      (path-closePath path))
+    (when open (path-closePath path))
     (path-moveTo path x y)
     (set! open #true))
                       
@@ -94,406 +95,366 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
           (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))])
+             (case= op
+                    [(1 ;; hstem
+                      3 ;; vstem
+                      18 ;; hstemhm
+                      23) ;; vstemhm
+                     (parse-stems)]
+                    [(4) ;; vmoveto
+                     (when (> (length stack) 1)
+                       (check-width))
+                     (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)
+                          (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 (> (length stack) 2)
+                       (check-width))
+
                      (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))])
+                     (moveTo x y)]
+
+                    [(22) ;; hmoveto
+                     (when (> (length stack) 1)
+                       (check-width))
+
+                     (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)))
-                     (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))])]
+                     (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 (odd? (length stack))
+                       (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 (odd? (length stack))
+                       (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)
+                         (match-define (list c1x c1y)
+                           (if phase
+                               (list (+ x (shift stack)) y)
+                               (list x (+ y (shift stack)))))
+                         (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))
+                         (loop)))]
+
+                    [(12)
+                     (define op (read-byte stream))
+                     (println "warning: check truthiness")
+                     (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)) (- (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 (> 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))
+                                    (loop (sub1 j))))]
+                               [else
+                                (let loop ([j j])
+                                  (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))
+                                    (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))])]
             [(< op 247) (push stack (- op 139))]
             [(< op 251)
-             (define b1 (read-byte stream))
-             (push stack (+ (* (- op 247) 256) b1 108))]
+             (push stack (+ (* (- op 247) 256) (read-byte stream) 108))]
             [(< op 255)
-             (define b1 (read-byte stream))
-             (push stack (- (* (- 251 op) 256) b1 108))]
+             (push stack (- (* (- 251 op) 256) (read-byte stream) 108))]
             [else
              (push stack (/ (decode int32be stream) 65536))])
           (loop)))))
 
   (parse)
 
-  (when open
-    (path-closePath path))
+  (when open (path-closePath path))
 
   (set-cff-glyph-_usedSubrs! this usedSubrs)
   (set-cff-glyph-_usedGsubrs! this usedGsubrs)

fontland/fontland/table/cff/cff-dict.rkt

@@ -15,7 +15,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
 
 (define (op->key op)
   (match (car op)
-    [(list* 0th 1st _) (bitwise-ior (arithmetic-shift 0th 8) 1st)]
+    [(list* x0 x1 _) (bitwise-ior (arithmetic-shift x0 8) x1)]
     [val val]))
 
 (define CFFDict%
@@ -25,14 +25,13 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
 
     (field [(@fields fields)
             (for/hash ([field (in-list @ops)])
-              (values (op->key field) field))])
+                      (values (op->key field) field))])
     
     (define (decode-operands type stream ret operands)
       (match type
-        [(? list?)
-         (for/list ([op (in-list operands)]
-                    [subtype (in-list type)])
-           (decode-operands subtype stream ret (list op)))]
+        [(? list?) (for/list ([op (in-list operands)]
+                              [subtype (in-list type)])
+                             (decode-operands subtype stream ret (list op)))]
         [(? xenomorphic?) (send type x:decode stream ret operands)]
         [(or 'number 'offset 'sid) (car operands)]
         ['boolean (if (car operands) #t #f)]
@@ -43,7 +42,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
         [(? list?)
          (for/list ([op (in-list operands)]
                     [subtype (in-list type)])
-           (car (encode-operands subtype stream ctx op)))]
+                   (car (encode-operands subtype stream ctx op)))]
         [(? xenomorphic?) type (send type x:encode operands stream ctx)]
         [_ (match operands
              [(? number?) (list operands)]
@@ -57,7 +56,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
     (define/augment (x:decode stream parent)
       (define end (+ (pos stream) (hash-ref parent 'length)))
       (define ret (make-hash))
-      (define operands null)
 
       ;; define hidden properties
       (hash-set! ret x:parent-key parent)
@@ -65,61 +63,47 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
 
       ;; fill in defaults
       (for ([(key field) (in-hash @fields)])
-        (hash-set! ret (second field) (fourth field)))
+           (hash-set! ret (second field) (fourth field)))
 
-      (let loop ()
+      (let loop ([operands null])
         (when (< (pos stream) end)
           (define b (read-byte stream))
-          (cond
-            [(< b 28)
-             (when (= b 12)
-               (set! b (bitwise-ior (arithmetic-shift b 8) (read-byte stream))))
-             (define field (hash-ref @fields b #false))
-             (unless field
-               (error 'cff-dict-decode (format "unknown operator: ~a" b)))
-
-             (define val (decode-operands (third field) stream ret operands))
-
-             (unless (void? val)
-               ;; ignoring PropertyDescriptor nonsense
-               (hash-set! ret (second field) val))
-             (set! operands null)]
-            [else
-             (set! operands (append operands (list (decode CFFOperand stream b))))])
-          (loop)))
-
+          (let bloop ([b b])
+            (cond
+              [(< b 28)
+               (let ([b (if (= b 12)
+                            (bitwise-ior (arithmetic-shift b 8) (read-byte stream))
+                            b)])
+                 (define field (hash-ref @fields b #false))
+                 (unless field
+                   (error 'cff-dict-decode (format "unknown operator: ~a" b)))
+
+                 (define val (decode-operands (third field) stream ret operands))
+                 (unless (void? val)
+                   (hash-set! ret (second field) val))
+                 (loop null))]
+              [else
+               (loop (append operands (list (decode CFFOperand stream b))))]))))
+      
       ret)
 
-    (define/augment (x:size dict parent [includePointers #true])
-      
+    (define/augment (x:size dict parent [include-pointers #true])
       (define ctx
         (mhasheq x:parent-key parent
                  x:val-key dict
                  x:pointer-size-key 0
                  x:start-offset-key (hash-ref parent x:start-offset-key 0)))
 
-      (define len 0)
-
-      (for* ([k (in-list (sort (dict-keys @fields) <))]
-             [field (in-value (dict-ref @fields k))]
-             [val (in-value (dict-ref dict (list-ref field 1) #false))]
-             #:unless (let ([ res (or (not val) (equal? val (list-ref field 3)))])
-                        res))
-        
-        (define operands (encode-operands (list-ref field 2) #f ctx val))
-        (set! len (+ len
-                     (for/sum ([op (in-list operands)])
-                       (size CFFOperand op))))
-
-        (define key (if (list? (list-ref field 0))
-                        (list-ref field 0)
-                        (list (list-ref field 0))))
-        (set! len (+ len (length key))))
-      
-      (when includePointers
-        (set! len (+ len (hash-ref ctx x:pointer-size-key))))
-
-      len)
+      (+ (for*/sum ([k (in-list (sort (dict-keys @fields) <))]
+                    [field (in-value (dict-ref @fields k))]
+                    [val (in-value (dict-ref dict (list-ref field 1) #false))]
+                    #:unless (or (not val) (equal? val (list-ref field 3))))
+                   (define operands (encode-operands (list-ref field 2) #false ctx val))
+                   (define operand-size (for/sum ([op (in-list operands)])
+                                                 (size CFFOperand op)))
+                   (define key (if (list? (car field)) (car field) (list (car field))))
+                   (+ operand-size (length key)))
+         (if include-pointers (hash-ref ctx x:pointer-size-key) 0)))
 
     (define/augment (x:encode dict stream parent)
       (define ctx (mhasheq
@@ -132,28 +116,21 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
       (hash-set! ctx x:pointer-offset-key (+ (pos stream) (x:size dict ctx #false)))
 
       (for ([field (in-list @ops)])
-        #;(pos stream)
-        #;field
-        (define val (dict-ref dict (list-ref field 1) #false))
-        (cond
-          [(or (not val) (equal? val (list-ref field 3)))]
-          [else
-           (define operands (encode-operands (list-ref field 2) stream ctx val))
-           (for ([op (in-list operands)])
-             (send CFFOperand x:encode op stream))
-
-           (define key (if (list? (list-ref field 0))
-                           (list-ref field 0)
-                           (list (list-ref field 0))))
-           (for ([op (in-list key)])
-             (encode uint8 op stream))]))
-
-      (define i 0)
-      (let loop ()
+           (define val (dict-ref dict (list-ref field 1) #false))
+           (cond
+             [(or (not val) (equal? val (list-ref field 3)))]
+             [else
+              (define operands (encode-operands (list-ref field 2) stream ctx val))
+              (for ([op (in-list operands)])
+                   (send CFFOperand x:encode op stream))
+              (define key (if (list? (car field)) (car field) (list (car field))))
+              (for ([op (in-list key)])
+                   (encode uint8 op stream))]))
+
+      (let loop ([i 0])
         (when (< i (length (hash-ref ctx x:pointers-key)))
           (match (list-ref (hash-ref ctx x:pointers-key) i)
             [(x:ptr type val parent) (send type x:encode val stream parent)])
-          (set! i (add1 i))
-          (loop))))))
+          (loop (add1 i)))))))
 
 (define (CFFDict [name 'unknown] [ops null]) (make-object CFFDict% name ops))

fontland/fontland/table/cff/cff-font.rkt

@@ -21,7 +21,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFFont.js
       (hash-set! cff-font 'stream stream)
           
       (for ([(k v) (in-hash (decode CFFTop stream))])
-        (hash-set! cff-font k v))
+           (hash-set! cff-font k v))
           
       ;; because fontkit depends on overloading 'version key, and we don't
       (hash-set! cff-font 'version (hash-ref cff-font 'x:version))
@@ -42,10 +42,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFFont.js
     [else (list-ref (hash-ref this 'stringIndex) (- sid (length standardStrings)))]))
 
 (define (CFFFont-postscriptName this)
-  (cond
-    [(< (hash-ref this 'version) 2)
-     (list-ref (hash-ref this 'nameIndex) 0)]
-    [else #false]))
+  (and (< (hash-ref this 'version) 2) (car (hash-ref this 'nameIndex))))
 
 (define CFFFont (make-object CFFFont%))
 
@@ -56,26 +53,21 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFFont.js
 
 (define (fdForGlyph this gid)
   (cond
-    [(not (hash-has-key? (hash-ref this 'topDict) 'FDSelect))
-     #false]
+    [(not (hash-has-key? (hash-ref this 'topDict) 'FDSelect)) #false]
     [else
      (match (hash-ref* this 'topDict 'FDSelect 'version)
        [0 (list-ref (hash-ref* this 'topDict 'FDSelect) gid)]
        [(or 3 4)
         (define ranges (hash-ref* this 'topDict 'FDSelect 'ranges))
-        (define low 0)
-        (define high (sub1 (length (ranges))))
-
-        (let loop ()
+        (let loop ([low 0][high (sub1 (length ranges))])
           (when (<= low high)
             (define mid (arithmetic-shift (+ low high) -1))
             (cond
               [(< gid (hash-ref (list-ref ranges mid) 'first))
-               (set! high (sub1 mid))]
+               (loop low (sub1 mid))]
               [(and (< mid high) (> gid (hash-ref (list-ref ranges (add1 mid)) 'first)))
-               (set! low (add1 mid))]
-              [else (hash-ref (list-ref ranges mid) 'fd)])
-            (loop)))]
+               (loop (add1 mid) high)]
+              [else (hash-ref (list-ref ranges mid) 'fd)])))]
        [default (error 'unknown-select-version)])]))
 
 (define (privateDictForGlyph this gid)
@@ -87,11 +79,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFFont.js
      (if (list-ref (hash-ref* this 'topDict 'FDArray) fd)
          (hash-ref (list-ref (hash-ref* 'topDict 'FDArray) fd) 'Private)
          #false)]
-    [(< (hash-ref this 'version) 2)
-     (hash-ref* this 'topDict 'Private)]
-    [else
-     (hash-ref (list-ref (hash-ref* this 'topDict 'FDArray) 0) 'Private)]))
-
+    [(< (hash-ref this 'version) 2) (hash-ref* this 'topDict 'Private)]
+    [else (hash-ref (list-ref (hash-ref* this 'topDict 'FDArray) 0) 'Private)]))
 
 (module+ test
   (require rackunit racket/serialize racket/stream fontland/helper)
@@ -111,7 +100,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFFont.js
   (check-equal? (length (hash-ref cff-font 'globalSubrIndex)) 820)
   (check-equal?
    (for/list ([h (in-list (hash-ref cff-font 'globalSubrIndex))])
-     (hash-ref h 'offset))
+             (hash-ref h 'offset))
    '(60105 60130 60218 60264 60303 60330 60361 60366 60387 60427 60433 60447 60454 60469 60500 60506 60512 60516 60545 60566 60581 60624 60637 60667 60679 60705 60715 60755 60776 60781 60839 60891 60897 60907 60914 60920 60938 60950 60976 60992 61005 61011 61032 61051 61067 61097 61111 61172 61272 61284 61359 61430 61489 61522 61526 61531 61535 61543 61565 61570 61575 61579 61601 61615 61629 61649 61654 61664 61842 61849 61858 61865 61895 61913 61920 61964 61977 61996 62074 62094 62102 62128 62132 62149 62160 62170 62197 62216 62225 62230 62237 62247 62256 62285 62332 62339 62347 62350 62375 62435 62479 62511 62539 62561 62585 62605 62621 62632 62711 62717 62733 62743 62783 62809 62818 62868 62905 62955 62965 62971 63034 63050 63059 63191 63237 63358 63394 63460 63465 63592 63716 63740 63866 63924 63947 64051 64075 64099 64120 64184 64245 64260 64374 64493 64515 64543 64585 64592 64597 64611 64622 64735 64738 64789 64797 64882 64920 65027 65054 65057 65069 65077 65113 65125 65222 65254 65275 65377 65480 65516 65524 65530 65550 65565 65569 65576 65673 65691 65760 65836 65854 65866 65873 65881 65895 65924 65929 65949 65970 66060 66093 66113 66132 66146 66151 66160 66165 66174 66185 66192 66210 66231 66255 66280 66288 66296 66301 66386 66395 66400 66446 66455 66537 66545 66550 66555 66636 66712 66722 66729 66748 66774 66788 66797 66810 66818 66841 66847 66853 66872 66877 66882 66887 66962 66988 66997 67008 67021 67027 67034 67040 67047 67110 67180 67218 67256 67325 67355 67369 67376 67390 67399 67403 67471 67478 67499 67520 67524 67550 67565 67579 67584 67651 67671 67679 67684 67749 67759 67772 67783 67790 67817 67883 67944 67967 67986 68049 68056 68090 68113 68132 68139 68149 68154 68159 68222 68226 68259 68262 68323 68326 68335 68372 68413 68420 68427 68435 68441 68446 68451 68462 68477 68489 68530 68535 68548 68553 68560 68567 68622 68638 68694 68748 68759 68764 68816 68862 68880 68885 68900 68907 68959 68988 69002 69011 69016 69028 69037 69089 69099 69115 69131 69143 69152 69160 69168 69174 69180 69202 69213 69218 69268 69318 69325 69374 69383 69402 69415 69422 69427 69434 69446 69488 69514 69529 69535 69582 69587 69603 69647 69667 69678 69684 69690 69700 69705 69710 69752 69795 69816 69860 69888 69898 69912 69921 69932 69936 69943 69948 69991 70002 70028 70041 70051 70057 70099 70130 70151 70166 70207 70219 70257 70279 70290 70300 70309 70316 70325 70333 70341 70346 70352 70357 70364 70401 70438 70475 70480 70487 70491 70497 70502 70532 70545 70552 70557 70562 70599 70616 70647 70651 70658 70665 70670 70706 70712 70737 70754 70766 70778 70786 70798 70804 70812 70817 70823 70858 70893 70904 70908 70913 70926 70933 70947 70954 70962 70968 70976 70981 70987 70996 71002 71007 71012 71018 71041 71074 71079 71111 71143 71175 71192 71196 71207 71215 71220 71226 71234 71247 71254 71261 71291 71308 71314 71322 71339 71345 71350 71354 71379 71395 71404 71413 71417 71422 71436 71458 71463 71479 71491 71501 71509 71521 71528 71535 71541 71547 71555 71561 71568 71575 71582 71588 71594 71599 71626 71640 71666 71692 71696 71704 71722 71735 71750 71759 71766 71781 71792 71797 71802 71808 71813 71818 71840 71865 71890 71894 71905 71910 71916 71927 71935 71942 71949 71956 71961 71966 71977 72001 72014 72036 72044 72056 72070 72076 72082 72087 72093 72100 72112 72135 72151 72155 72163 72172 72177 72182 72195 72217 72239 72261 72277 72297 72304 72324 72337 72350 72355 72365 72370 72377 72387 72394 72398 72405 72412 72417 72423 72429 72446 72460 72465 72485 72495 72514 72523 72530 72535 72546 72566 72586 72604 72624 72642 72651 72660 72666 72678 72684 72689 72698 72707 72714 72722 72730 72735 72740 72746 72752 72758 72774 72793 72799 72812 72825 72834 72839 72858 72862 72868 72877 72886 72895 72904 72913 72922 72931 72940 72946 72953 72960 72967 72973 72978 72985 73000 73007 73025 73043 73048 73066 73073 73089 73100 73111 73118 73124 73135 73140 73146 73152 73158 73163 73168 73173 73186 73200 73217 73234 73249 73264 73279 73286 73302 73318 73332 73348 73358 73374 73384 73390 73395 73403 73413 73422 73428 73438 73445 73452 73459 73465 73473 73479 73486 73491 73497 73505 73513 73521 73528 73533 73538 73545 73552 73559 73566 73572 73587 73592 73604 73619 73634 73649 73664 73679 73694 73709 73722 73735 73743 73748 73753 73758 73771 73784 73798 73804 73814 73827 73839 73843 73851 73860 73865 73872 73881 73890 73899 73908 73914 73920 73926 73932 73938 73943 73948 73953 73963 73976 73989 74002 74015 74028 74037 74050 74063 74076 74087 74098 74104 74110 74117 74123 74130 74137 74144 74149 74156 74161 74166 74171 74176 74188 74200 74212 74224 74236 74248 74260 74266 74278 74282 74294 74306 74313 74321 74328 74336 74342 74350 74357 74364 74370 74377 74385 74390 74396 74402 74408 74414 74420 74425 74430 74435 74440 74445 74450 74455 74466 74477 74488 74498 74509 74520 74531 74542 74553 74564 74575 74584 74593 74602 74611 74616 74621 74626 74631 74636 74641 74646))
   (check-equal? (length (hash-ref cff-font 'stringIndex)) 2404)
   #;(check-equal? (hash-ref (hash-ref cff-font 'topDict) 'version) 2401)
@@ -142,6 +131,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFFont.js
   (check-equal? (hash-ref private 'ExpansionFactor) 0.06)
   (check-equal?
    (for/list ([h (in-list (take (hash-ref top-dict 'CharStrings) 100))])
-     (hash-ref h 'offset))
+             (hash-ref h 'offset))
    '(83610 83750 83753 83755 83776 83778 83810 83858 83890 83951 84023 84046 84068 84096 84132 84169 84233 84270 84292 84322 84380 84411 84439 84478 84498 84547 84575 84679 84711 84751 84784 84823 84919 84956 84964 84978 85011 85013 85101 85188 85300 85302 85396 85398 85407 85422 85436 85451 85547 85561 85587 85647 85784 85790 85824 85864 85933 85935 85960 85970 85972 86003 86027 86091 86106 86161 86176 86228 86238 86253 86273 86288 86347 86363 86385 86401 86423 86463 86496 86511 86541 86568 86578 86594 86627 86651 86680 86731 86733 86766 86769 86861 86887 86900 86919 86986 87017 87061 87098 87108))
   )

fontland/fontland/table/cff/cff-index.rkt

@@ -51,29 +51,25 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFIndex.js
                   (values (cons val vals) end))]))
 
     (define/augride (x:size arr parent)
-      (define size 2)
-      (cond
-        [(zero? (length arr)) size]
-        [else
-         (define type (or @type (x:buffer)))
-
-         ;; find maximum offset to determinine offset type
-         (define offset 1)
-         (for ([(item i) (in-indexed arr)])
-           (set! offset (+ offset (send type x:size item parent))))
-
-         (define offsetType
-           (cond
-             [(<= offset #xff) uint8]
-             [(<= offset #xffff) uint16be]
-             [(<= offset #xffffff) uint24be]
-             [(<= offset #xffffffff) uint32be]
-             [else (error 'CFFIndex-size (format "bad offset: ~a" offset))]))
-
-         (set! size (+ size 1 (* (send offsetType x:size) (add1 (length arr)))))
-         (set! size (+ size (sub1 offset)))
-
-         size]))
+      (+ 2
+         (cond
+           [(zero? (length arr)) 0]
+           [else (define type (or @type (x:buffer)))
+
+                 ;; find maximum offset to determinine offset type
+                 (define offset
+                   (add1 (for/sum ([item (in-list arr)])
+                                  (send type x:size item parent))))
+
+                 (define offset-type
+                   (cond
+                     [(<= offset #xff) uint8]
+                     [(<= offset #xffff) uint16be]
+                     [(<= offset #xffffff) uint24be]
+                     [(<= offset #xffffffff) uint32be]
+                     [else (error 'CFFIndex-size (format "bad offset: ~a" offset))]))
+
+                 (+ (* (send offset-type x:size) (add1 (length arr))) offset)])))
 
     (define/augride (x:encode arr stream parent)
       (send uint16be x:encode (length arr) stream)
@@ -83,39 +79,34 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFIndex.js
          (define type (or @type (x:buffer)))
 
          ;; find maximum offset to detminine offset type
-         (define sizes null)
-         (define offset 1)
-         (for ([item (in-list arr)])
-           (define s (send type x:size item parent))
-           (set! sizes (append sizes (list s)))
-           (set! offset (+ offset s)))
+         (define-values (sizes offset)
+           (for/fold ([sizes null]
+                      [offset 1]
+                      #:result (values (reverse sizes) offset))
+                     ([item (in-list arr)])
+             (define s (send type x:size item parent))
+             (values (cons s sizes) (+ offset s))))
 
          (define offsetType
            (cond
-             [(<= offset #xff)
-              uint8]
-             [(<= offset #xffff)
-              uint16be]
-             [(<= offset #xffffff)
-              uint24be]
-             [(<= offset #xffffffff)
-              uint32be]
-             [else
-              (error 'cff-index-encode-bad-offset!)]))
+             [(<= offset #xff) uint8]
+             [(<= offset #xffff) uint16be]
+             [(<= offset #xffffff) uint24be]
+             [(<= offset #xffffffff) uint32be]
+             [else (error 'cff-index-encode-bad-offset!)]))
 
          ;; write offset size
          (send uint8 x:encode (size offsetType) stream)
 
          ;; write elements
-         (set! offset 1)
-         (send offsetType x:encode offset stream)
-
-         (for ([size (in-list sizes)])
-           (set! offset (+ offset size))
-           (send offsetType x:encode offset stream))
+         (for/fold ([offset 1])
+                   ([size (in-list (cons 0 sizes))])
+           (define next-offset (+ offset size))
+           (send offsetType x:encode next-offset stream)
+           next-offset)
 
          (for ([item (in-list arr)])
-           (send type x:encode item stream parent))]))))
+              (send type x:encode item stream parent))]))))
 
 (define (CFFIndex [type #f])
   (new CFFIndex% [type type]))

fontland/fontland/table/cff/cff-operand.rkt

@@ -13,9 +13,9 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFOperand.js
 
 (define FLOAT_ENCODE_LOOKUP
   (hash "." 10
-          "E" 11
-          "E-" 12
-          "-" 14))
+        "E" 11
+        "E-" 12
+        "-" 14))
 
 (define CFFOperand%
   (class x:base%
@@ -25,7 +25,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFOperand.js
       (cond
         [(<= 32 value 246) (- value 139)]
         [(<= 247 value 250) (+ (* (- value 247) 256) (read-byte stream) 108)]
-        [(<= 251 value 254) (- (* (- (- value 251)) 256) (read-byte stream) 108)]
+        [(<= 251 value 254) (- (* (- 251 value) 256) (read-byte stream) 108)]
         [(= value 28) (decode int16be stream)]
         [(= value 29) (decode int32be stream)]
         [(= value 30)
@@ -35,7 +35,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFOperand.js
                    ([i (in-naturals)]
                     #:break break?)
            (define b (read-byte stream))
-
            (define n1 (arithmetic-shift b -4))
            
            (cond
@@ -53,10 +52,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFOperand.js
       ;; if the value needs to be forced to the largest size (32 bit)
       ;; e.g. for unknown pointers, set to 32768
       (define value (cond
-                      [(or (and (hash? value-arg) (hash-ref value-arg 'forceLarge #f))
-                           (and (Ptr? value-arg) (Ptr-forceLarge value-arg)))
-                       32768]
-                      [(Ptr? value-arg) (Ptr-val value-arg)]
+                      [(Ptr? value-arg) (if (Ptr-forceLarge value-arg) 32768 (Ptr-val value-arg))]
                       [else value-arg]))
 
       (cond
@@ -81,30 +77,28 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFOperand.js
         [(not (integer? val)) ;; floating point
          (encode uint8 30 stream)
          (define str (list->vector (regexp-match* #rx"." (number->string val))))
-         (define n2 'nothing)
-         (for ([i (in-range 0 (vector-length str) 2)])
-           (define c1 (vector-ref str i))
-           (define n1 (hash-ref FLOAT_ENCODE_LOOKUP c1 (string->number c1)))
-
-           (cond
-             [(= i (sub1 (vector-length str)))
-              (set! n2 FLOAT_EOF)]
-             [else
-              (define c2 (vector-ref str (add1 i)))
-              (set! n2 (hash-ref FLOAT_ENCODE_LOOKUP c2 (string->number c2)))])
-
-           (encode uint8 (bitwise-ior (arithmetic-shift n1 4) (bitwise-and n2 15)) stream))
-                    
+         (define n2
+           (for/last ([i (in-range 0 (vector-length str) 2)])
+                     (define c1 (vector-ref str i))
+                     (define n1 (hash-ref FLOAT_ENCODE_LOOKUP c1 (string->number c1)))
+                     (define n2
+                       (cond
+                         [(= i (sub1 (vector-length str))) FLOAT_EOF]
+                         [else
+                          (define c2 (vector-ref str (add1 i)))
+                          (hash-ref FLOAT_ENCODE_LOOKUP c2 (string->number c2))]))
+                     (encode uint8 (bitwise-ior (arithmetic-shift n1 4) (bitwise-and n2 15)) stream)
+                     n2))                    
          (unless (= n2 FLOAT_EOF)
            (encode uint8 (arithmetic-shift FLOAT_EOF 4) stream))]
         [(<= -107 value 107)
          (encode uint8 (+ val 139) stream)]
         [(<= 108 value 1131)
          (let ([val (- val 108)])
-         (encode uint8 (+ (arithmetic-shift val -8) 247) stream)
-         (encode uint8 (bitwise-and val #xff) stream))]
+           (encode uint8 (+ (arithmetic-shift val -8) 247) stream)
+           (encode uint8 (bitwise-and val #xff) stream))]
         [(<= -1131 value -108)
-         (let ([val (- (- val) 108)])
+         (let ([val (- (+ val 108))])
            (encode uint8 (+ (arithmetic-shift val -8) 251) stream)
            (encode uint8 (bitwise-and val #xff) stream))]
         [(<= -32768 value 32767)

fontland/fontland/table/cff/cff-struct.rkt

@@ -1,7 +1,3 @@
 #lang racket/base
-(require)
 (provide (all-defined-out))
-
-(struct Ptr (val [forceLarge #:auto]) #:transparent #:mutable #:auto-value #true
-  ;; use prop:procedure instead of JS `valueOf`
-  #:property prop:procedure (λ (ptr) (Ptr-val ptr)))
+(struct Ptr (val [forceLarge #:auto]) #:transparent #:mutable #:auto-value #true)

fontland/fontland/table/cff/cff-top.rkt

@@ -1,5 +1,11 @@
 #lang debug racket/base
-(require xenomorph racket/list sugar/unstable/dict racket/class racket/dict
+(require xenomorph
+         racket/list
+         racket/vector
+         racket/match
+         sugar/unstable/dict
+         racket/class
+         racket/dict
          "cff-index.rkt"
          "cff-dict.rkt"
          "cff-charsets.rkt"
@@ -18,6 +24,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFTop.js
     (super-new)
     (init-field [(@predefinedOps predefinedOps)]
                 [(@type type) #f])
+    (field [op-vec (list->vector @predefinedOps)])
 
     (define/override (pre-encode val)
       ;; because fontkit depends on overloading 'version key, and we don't
@@ -28,14 +35,14 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFTop.js
     (define/augment (x:decode stream parent operands)
       (define idx (car operands))
       (cond
-        [(and (< idx (length @predefinedOps)) (list-ref @predefinedOps idx))]
+        [(and (< idx (vector-length op-vec)) (vector-ref op-vec idx))]
         [else (decode @type stream #:parent parent operands)]))
 
     (define/augment (x:size value ctx)
       (error 'predefined-op-size-not-finished))
 
     (define/augment (x:encode value stream ctx)
-      (or (index-of @predefinedOps value)
+      (or (vector-member value op-vec)
           (send @type x:encode value stream ctx)))))
 
 (define (PredefinedOp predefinedOps type) (make-object PredefinedOp% predefinedOps type))
@@ -90,9 +97,9 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFTop.js
 (define (base-tproc t) (length (hash-ref (hash-ref t 'parent) 'CharStrings)))
 
 (define CFFCustomCharset
-  (let ([tproc (λ (t) (sub1 (base-tproc t)))])
-    (x:versioned-struct
-     uint8
+  (x:versioned-struct
+   uint8
+   (let ([tproc (λ (t) (sub1 (base-tproc t)))])
      (dictify
       0 (dictify 'glyphs (x:array uint16be tproc))
       1 (dictify 'ranges (RangeArray Range1 tproc))
@@ -114,9 +121,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFTop.js
   (x:versioned-struct
    uint8
    #:pre-encode
-   (λ (val)
-     ;; because fontkit depends on overloading 'version key, and we don't
-     (dict-set val 'x:version (dict-ref val 'version)))
+   ;; because fontkit depends on overloading 'version key, and we don't
+   (λ (val) (dict-set val 'x:version (dict-ref val 'version)))
    (dictify
     0 (dictify 'fds (x:array uint8 base-tproc))
     3 (dictify 'nRanges uint16be
@@ -133,8 +139,10 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFTop.js
     (super-new)
     
     (define/augment (x:decode stream parent operands)
-      (hash-set! parent 'length (list-ref operands 0))
-      (send ptr x:decode stream parent (list (list-ref operands 1))))
+      (match operands
+        [(list op1 op2)
+         (hash-set! parent 'length op1)
+         (send ptr x:decode stream parent (list op2))]))
 
     (define/augment (x:size dict ctx)
       (list (send CFFPrivateDict x:size dict ctx #false)
@@ -198,10 +206,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFTop.js
 (define CFFTop
   (x:versioned-struct
    #:pre-encode
-   (λ (val)
-     ;; because fontkit depends on overloading 'version key, and we don't
-     (hash-set! val 'x:version (hash-ref val 'version))
-     val)
+   ;; because fontkit depends on overloading 'version key, and we don't
+   (λ (val) (hash-set! val 'x:version (hash-ref val 'version)) val)
    fixed16be
    (dictify
     1 (dictify 'hdrSize uint8
@@ -209,8 +215,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFTop.js
                'nameIndex (CFFIndex (x:string #:length 'length))
                'topDictIndex (CFFIndex CFFTopDict)
                'stringIndex (CFFIndex (x:string #:length 'length))
-               'globalSubrIndex (CFFIndex)
-               )
+               'globalSubrIndex (CFFIndex))
     
     #|
 2 (dictify 'hdrSize uint8

fontland/fontland/test/glyphs.rkt

@@ -11,7 +11,7 @@ https://github.com/mbutterick/fontkit/blob/master/test/glyphs.js
 (define-runtime-path source-otf "data/SourceSansPro/SourceSansPro-Regular.otf")
 
 (define font (open-font source-otf))
-(define glyph (get-glyph font 5))
+ (define glyph (get-glyph font 5))
 
 (test-case
  "should get a TTFGlyph"