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,15 +95,15 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
           (define op (read-byte stream))
           (cond
             [(< op 32)
-             (case op
+             (case= op
                     [(1 ;; hstem
                       3 ;; vstem
                       18 ;; hstemhm
                       23) ;; vstemhm
-                (parseStems)]
+                     (parse-stems)]
                     [(4) ;; vmoveto
                      (when (> (length stack) 1)
-                  (checkWidth))
+                       (check-width))
                      (set! y (+ y (shift stack)))
                      (moveTo x y)]
                     [(5) ;; rlineto
@@ -153,7 +154,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
                        [(>= (hash-ref cff 'version) 2) (void)]
                        [else
                         (when (> (length stack) 0)
-                     (checkWidth))
+                          (check-width))
                         (when open
                           (path-closePath path)
                           (set! open #false))])]
@@ -166,12 +167,12 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
 
                     [(19 ;; hintmask
                       20) ;; cntrmask
-                (parseStems)
+                     (parse-stems)
                      (pos stream (+ (pos stream) (arithmetic-shift (+ nStems 7) -3)))]
 
                     [(21) ;; rmoveto
                      (when (> (length stack) 2)
-                  (checkWidth))
+                       (check-width))
 
                      (set! x (+ x (shift stack)))
                      (set! y (+ y (shift stack)))
@@ -179,7 +180,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
 
                     [(22) ;; hmoveto
                      (when (> (length stack) 1)
-                  (checkWidth))
+                       (check-width))
 
                      (set! x (+ x (shift stack)))
                      (moveTo x y)]
@@ -217,7 +218,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
                      (path-bezierCurveTo path c1x c1y c2x c2y x y)]
 
                     [(26) ;; vvcurveto
-                (when (not (zero? (modulo (length stack) 2)))
+                     (when (odd? (length stack))
                        (set! x (+ x (shift stack))))
 
                      (let loop ()
@@ -232,7 +233,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
                          (loop)))]
 
                     [(27) ;; hhcurveto
-                (when (not (zero? (modulo (length stack) 2)))
+                     (when (odd? (length stack))
                        (set! y (+ y (shift stack))))
 
                      (let loop ()
@@ -267,71 +268,47 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
                      (define phase (= op 31))
                      (let loop ()
                        (when (>= (length stack) 4)
-                    (cond
-                      [phase
-                       (define c1x (+ x (shift stack)))
-                       (define c1y y)
+                         (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))]
-                      [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))])
+                         (set! phase (not phase))
                          (loop)))]
 
                     [(12)
                      (define op (read-byte stream))
                      (println "warning: check truthiness")
-                (case op
+                     (case= op
                             [(3) ;; and
-                   (define a (pop stack))
-                   (define b (pop stack))
-                   (push stack (if (and a b) 1 0))]
+                             (push stack (if (and (pop stack) (pop stack)) 1 0))]
                             [(4) ;; or
-                   (define a (pop stack))
-                   (define b (pop stack))
-                   (push stack (if (or a b) 1 0))]
+                             (push stack (if (or (pop stack) (pop stack)) 1 0))]
 
                             [(5) ;; not
-                   (define a (pop stack))
-                   (push stack (if a 0 1))]
+                             (push stack (if (pop stack) 0 1))]
 
                             [(9) ;; abs
-                   (define a (pop stack))
-                   (push stack (abs a))]
+                             (push stack (abs (pop stack)))]
 
                             [(10) ;; add
-                   (define a (pop stack))
-                   (define b (pop stack))
-                   (push stack (+ a b))]
+                             (push stack (+ (pop stack) (pop stack)))]
 
                             [(11) ;; sub
-                   (define a (pop stack))
-                   (define b (pop stack))
-                   (push stack (- a b))]
+                             (push stack (- (pop stack) (pop stack)))]
 
                             [(12) ;; div
-                   (define a (pop stack))
-                   (define b (pop stack))
-                   (push stack (/ a b 1.0))]
+                             (push stack (/ (pop stack) (pop stack) 1.0))]
 
                             [(14) ;; neg
-                   (define a (pop stack))
-                   (push stack (- a))]
+                             (push stack (- (pop stack)))]
 
                             [(15) ;; eq
-                   (define a (pop stack))
-                   (define b (pop stack))
-                   (push stack (if (- a b) 1 0))]
+                             (push stack (if (- (pop stack) (pop stack)) 1 0))]
 
                             [(18) ;; drop
                              (pop stack)]
@@ -342,8 +319,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
                              (set! trans (list-set trans idx val))]
 
                             [(21) ;; get
-                   (define idx (pop stack))
-                   (push stack (or (list-ref trans idx) 0))]
+                             (push stack (or (list-ref trans (pop stack)) 0))]
 
                             [(22) ;; ifelse
                              (define s1 (pop stack))
@@ -356,13 +332,10 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
                              (push stack (random))]
 
                             [(24) ;; mul
-                   (define a (pop stack))
-                   (define b (pop stack))
-                   (push stack (* a b))]
+                             (push stack (* (pop stack) (pop stack)))]
 
                             [(26) ;; sqrt
-                   (define a (pop stack))
-                   (push stack (sqrt a))]
+                             (push stack (sqrt (pop stack)))]
 
                             [(26) ;; dup
                              (define a (pop stack))
@@ -374,39 +347,30 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
                              (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))])
-
+                             (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 ()
+                                (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 (+ i 1) (list-ref stack i))))
                                     (set! stack (list-set stack 0 t))
-                          (set! j (sub1 j))
-                          (loop)))]
+                                    (loop (sub1 j))))]
                                [else
-                      (let loop ()
+                                (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))))])]
+                                    (set! stack (list-set stack (- n 1) t))
+                                    (loop (add1 j))))])]
                             [(34) ;; hflex
                              (define c1x (+ x (shift stack)))
                              (define c1y y)
@@ -481,19 +445,16 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
                     [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%
@@ -29,8 +29,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
     
     (define (decode-operands type stream ret operands)
       (match type
-        [(? list?)
-         (for/list ([op (in-list operands)]
+        [(? 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)]
@@ -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)
@@ -67,59 +65,45 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
       (for ([(key field) (in-hash @fields)])
            (hash-set! ret (second field) (fourth field)))
 
-      (let loop ()
+      (let loop ([operands null])
         (when (< (pos stream) end)
           (define b (read-byte stream))
+          (let bloop ([b b])
             (cond
               [(< b 28)
-             (when (= b 12)
-               (set! b (bitwise-ior (arithmetic-shift b 8) (read-byte stream))))
+               (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)
-               ;; ignoring PropertyDescriptor nonsense
                    (hash-set! ret (second field) val))
-             (set! operands null)]
+                 (loop null))]
               [else
-             (set! operands (append operands (list (decode CFFOperand stream b))))])
-          (loop)))
+               (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) <))]
+      (+ (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 (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)
+                    #: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,8 +116,6 @@ 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)))]
@@ -141,19 +123,14 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
               (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))))
+              (define key (if (list? (car field)) (car field) (list (car field))))
               (for ([op (in-list key)])
                    (encode uint8 op stream))]))
 
-      (define i 0)
-      (let loop ()
+      (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

@@ -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)

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

@@ -51,18 +51,17 @@ 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)
+      (+ 2
          (cond
-        [(zero? (length arr)) size]
-        [else
-         (define type (or @type (x:buffer)))
+           [(zero? (length arr)) 0]
+           [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 offset
+                   (add1 (for/sum ([item (in-list arr)])
+                                  (send type x:size item parent))))
 
-         (define offsetType
+                 (define offset-type
                    (cond
                      [(<= offset #xff) uint8]
                      [(<= offset #xffff) uint16be]
@@ -70,10 +69,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFIndex.js
                      [(<= 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]))
+                 (+ (* (send offset-type x:size) (add1 (length arr))) offset)])))
 
     (define/augride (x:encode arr stream parent)
       (send uint16be x:encode (length arr) stream)
@@ -83,36 +79,31 @@ 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-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))
-           (set! sizes (append sizes (list s)))
-           (set! offset (+ offset s)))
+             (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))]))))

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

@@ -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,20 +77,18 @@ 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 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)))
-              (set! n2 FLOAT_EOF)]
+                         [(= i (sub1 (vector-length str))) 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))
-                    
+                          (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)
@@ -104,7 +98,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFOperand.js
            (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
+   (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)))
+   (λ (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)
+   (λ (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"