arr is wrong

fontland/fontland/cff-glyph.rkt

@@ -27,9 +27,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
   (define end (+ (hash-ref str 'offset) (hash-ref str 'length)))
   (pos stream (hash-ref str 'offset))
 
-  #R (pos stream)
-  #R end
-  
   (define path (Path))
   (define stack null)
   (define trans null)
@@ -38,8 +35,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
   (define nStems 0)
   (define x 0)
   (define y 0)
-  (define usedGsubrs (cff-glyph-_usedGsubrs this))
-  (define usedSubrs (cff-glyph-_usedSubrs this))
+  (define usedGsubrs (make-hash))
+  (define usedSubrs (make-hash))
   (define open #false)
 
   (define gsubrs (hash-ref cff 'globalSubrIndex null))
@@ -70,7 +67,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
       [(> (length ID) 0)
        (define-values (head last) (split-at-right ID 1))
        (set! ID head)
-       last]))
+       (car last)]))
 
   (define (checkWidth)
     (unless width
@@ -91,12 +88,10 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
     (set! open #true))
                       
   (define (parse)
-    #R 'in-parse
     (let/ec return
       (let loop ()
         (when  (< (pos stream) end)
           (define op (read-byte stream))
-          #R op
           (cond
             [(< op 32)
              (case op
@@ -124,10 +119,10 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
                   (when (>= (length stack) 1)
                     (if phase
                         (set! x (+ x (shift stack)))
-                        (set! y (+ y (shift stack)))))
-                  (loop))
-                (path-lineTo path x y)
-                (set! phase (not phase))]
+                        (set! y (+ y (shift stack))))
+                    (path-lineTo path x y)
+                    (set! phase (not phase))
+                    (loop)))]
                [(8) ;; rrcurveto
                 (let loop ()
                   (when (> (length stack) 0)
@@ -256,7 +251,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
 
                [(29) ;; callgsubr
                 (define index (+ (pop stack) gsubrsBias))
-                (define subr (hash-ref gsubrs index))
+                (define subr (list-ref gsubrs index))
                 (when subr
                   (hash-set! usedGsubrs index #true)
                   (define p (pos stream))
@@ -500,6 +495,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/CFFGlyph.js
   (when open
     (path-closePath path))
 
-  #R path
+  (set-cff-glyph-_usedSubrs! this usedSubrs)
+  (set-cff-glyph-_usedGsubrs! this usedGsubrs)
   (set-cff-glyph-path! this path)
   path)

fontland/fontland/glyph.rkt

@@ -51,7 +51,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/Glyph.js
   (apply +glyph #:constructor ttf-glyph args))
 
 (define (+cff-glyph . args)
-  (apply +glyph #:constructor cff-glyph args))
+  (apply +glyph #:constructor make-cff-glyph args))
 
 #|
 approximates

fontland/fontland/struct.rkt

@@ -27,6 +27,8 @@
 
 (struct cff-subset subset (cff strings charstrings gsubrs) #:transparent #:mutable)
 
-(struct cff-glyph glyph ([path #:auto] [_usedGsubrs #:auto] [_usedSubrs #:auto])
-  #:transparent #:mutable
-  #:auto-value #f)
+(struct cff-glyph glyph (path _usedGsubrs _usedSubrs)
+  #:transparent #:mutable)
+
+(define (make-cff-glyph . args)
+  (apply cff-glyph (append args (list #f (make-hash) (make-hash)))))

fontland/fontland/subset.rkt

@@ -92,11 +92,9 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/CFFSubset.js
              (list (getCharString (cff-subset-cff this) gid))))
 
     (define glyph (get-glyph (subset-font this) gid))
-    (unless (cff-glyph-path glyph)
-      (set-cff-glyph-path! glyph (getPath glyph))) ;; this causes the glyph to be parsed
+    (unless (cff-glyph-path glyph) (getPath glyph)) ;; this causes the glyph to be parsed
 
-    #R (cff-glyph-path glyph)
-    (for ([subr (in-hash-keys #R (cff-glyph-_usedGsubrs glyph))])
+    (for ([subr (in-hash-keys (cff-glyph-_usedGsubrs glyph))])
       (hash-set! gsubrs subr #true)))
 
   (set-cff-subset-gsubrs! this (subsetSubrs
@@ -105,12 +103,11 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/CFFSubset.js
                                 gsubrs)))
 
 (define (subsetSubrs this subrs used)
-  #RRR 'in-subsetSubrs
   (for/list ([(subr i) (in-indexed subrs)])
     (cond
       [(hash-ref used i #false)
        (pos (hash-ref (cff-subset-cff this) 'stream) (hash-ref subr 'offset))
-       #RRR (read-bytes (hash-ref subr 'length) (hash-ref (cff-subset-cff this) 'stream))]
+       (read-bytes (hash-ref subr 'length) (hash-ref (cff-subset-cff this) 'stream))]
       [else (bytes 11)])))
 
 
@@ -122,7 +119,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/CFFSubset.js
   (define used_subrs (make-hash))
   (for ([gid (in-list (subset-glyphs this))])
     (define glyph (get-glyph (subset-font this) gid))
-    ;; skip path parsing
+    (unless (cff-glyph-path glyph) (getPath glyph)) ;; this causes the glyph to be parsed
        
     (for ([subr (in-hash-keys (cff-glyph-_usedSubrs glyph))])
       (hash-set! used_subrs subr #true)))

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

@@ -88,9 +88,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
 
     (augment [@size size])
     (define (@size dict parent [includePointers #true])
-      #RR 'in-cff-dict-size
-      #RR @name
-      #RR includePointers
+      #RRR @name
+      #RRR includePointers
       
       (define ctx
         (mhasheq x:parent-key parent
@@ -99,11 +98,10 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
                  x:start-offset-key (hash-ref parent x:start-offset-key 0)))
 
       (define len 0)
-      #RRR len
 
       (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)))]
+             [val (in-value (dict-ref dict (list-ref field 1) #false))]
              #:unless (let ([ res (or (not val) (equal? val (list-ref field 3)))])
                         res))
         #R k
@@ -117,15 +115,12 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
                         (list-ref field 0)
                         (list (list-ref field 0))))
         (set! len (+ len #R (length key))))
-
-      (define intermediate-len len)
-      #RR intermediate-len
       
-      (when #RR includePointers
-        (set! len (+ len #RR (hash-ref ctx x:pointer-size-key))))
+      (when #R includePointers
+        (set! len (+ len #R (hash-ref ctx x:pointer-size-key))))
 
       (define final-len len)
-      #RR final-len)
+      #R final-len)
 
     (augment [@encode encode])
     (define (@encode dict stream parent)

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

@@ -2,6 +2,11 @@
 (require racket/class racket/match xenomorph sugar/unstable/dict)
 (provide CFFIndex)
 
+#|
+approximates
+https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFIndex.js
+|#
+
 (define CFFIndex%
   (class x:base%
     (super-new)
@@ -48,10 +53,6 @@
 
     (augride [@size size])
     (define (@size arr parent)
-      #RRR 'in-cff-index-size
-      #R (length arr)
-      (when (= 819 (length arr))
-        #R (take arr 3))
       (define size 2)
       (cond
         [(zero? (length arr)) size]
@@ -61,9 +62,7 @@
          ;; find maximum offset to determinine offset type
          (define offset 1)
          (for ([(item i) (in-indexed arr)])
-              (set! offset (+ offset #R (send #R type size item parent))))
-
-         #RR offset
+           (set! offset (+ offset (send type size item parent))))
 
          (define offsetType
            (cond
@@ -76,10 +75,50 @@
          (set! size (+ size 1 (* (send offsetType size) (add1 (length arr)))))
          (set! size (+ size (sub1 offset)))
 
-         #RR size]))
+         size]))
 
     (define/augride (encode arr stream parent)
-      (error 'cff-index-encode-not-implemented))))
+      #R arr
+      (encode uint16be (length arr) stream)
+      (cond
+        [(zero? (length arr))]
+        [else
+         (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 size item parent))
+           (set! sizes (append sizes (list s)))
+           (set! offset (+ offset s)))
+
+         (define offsetType
+           (cond
+             [(<= offset #xff)
+              uint8]
+             [(<= offset #xffff)
+              uint16]
+             [(<= offset #xffffff)
+              uint24]
+             [(<= offset #xffffffff)
+              uint32]
+             [else
+              (error 'cff-index-encode-bad-offset!)]))
+
+         ;; write offset size
+         (encode uint8 (size offsetType) stream)
+
+         ;; write elements
+         (set! offset 1)
+         (encode offsetType offset stream)
+
+         (for ([size (in-list sizes)])
+           (set! offset (+ offset size))
+           (encode offsetType offset stream))
+
+         (for ([item (in-list arr)])
+           (encode type item stream #:parent parent))]))))
 
 (define (CFFIndex [type #f])
   (new CFFIndex% [type type]))