progress

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

@@ -20,20 +20,20 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
                       (values key field))])
 
     (define (decodeOperands type stream ret operands)
-      (cond
-        [(list? type)
+      (match type
+        [(? list?)
          (for/list ([(op i) (in-indexed operands)])
                    (decodeOperands (list-ref type i) stream ret (list op)))]
-        [(hash-ref type 'decode #f) => (λ (proc) (proc stream ret operands))]
-        [else (case type
-                [(number offset sid) (car operands)]
-                [(boolean) (if (car operands) #t #f)]
-                [else operands])]))
+        [(hash-table 'decode proc) (proc stream ret operands)]
+        [(or 'number 'offset 'sid) (car operands)]
+        ['boolean (if (car operands) #t #f)]
+        [_ operands]))
 
     (define (encodeOperands type stream ctx operands)
       (error 'cff-dict-encodeOperands-undefined))
 
-    (define/augment (decode stream parent)
+    (augment [@decode decode])
+    (define (@decode stream parent)
       (define end (+ (pos stream) (hash-ref parent 'length)))
       (define ret (make-hash))
       (define operands null)
@@ -53,7 +53,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
             [(< 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)))
@@ -64,8 +63,11 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
                (hash-set! ret (second field) val))
              (set! operands null)]
             [else
-             (set! operands (append operands (list (decode CFFOperand stream b))))])
-          (loop))))
+             ;; use `send` here to pass b as value arg
+             (set! operands (append operands (list (send CFFOperand decode stream b))))])
+          (loop)))
+
+      ret)
 
     (define/augment (size dict parent [includePointers #true])
       (error 'cff-dict-size-undefined))
@@ -73,4 +75,4 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
     (define/augment (encode stream dict parent)
       (error 'cff-dict-encode-undefined))))
 
-(define (CFFDict [ops null]) (make-object CFFDict% ops))
+(define (CFFDict [ops null]) #R (make-object CFFDict% ops))

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

@@ -48,10 +48,14 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFFont.js
   (define ip (open-input-file fira-otf-path))
   (define cff-bytes (peek-bytes cff-length cff-offset ip))
   (define cff-font (decode CFFFont cff-bytes))
-  (check-equal? (hash-ref cff-font 'length) 13)
+  (check-equal? (hash-ref cff-font 'version) 1)
   (check-equal? (hash-ref cff-font 'hdrSize) 4)
   (check-equal? (hash-ref cff-font 'offSize) 3)
   (check-equal? (hash-ref cff-font 'nameIndex) '("FiraSans-Book"))
-  (check-equal? (hash-ref cff-font 'length) (string-length (car (hash-ref cff-font 'nameIndex))))
-  cff-font
+  (check-equal? (take-right (hash-ref cff-font 'stringIndex) 2)
+                (list
+                 "Digitized data copyright \\(c\\) 2012-2015, The Mozilla Foundation and Telefonica S.A."
+                 "Fira Sans Book"))
+  (hash-ref cff-font 'topDict)
+  (check-equal? (length (hash-ref cff-font 'globalSubrIndex)) 820)
   )

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

@@ -21,7 +21,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFOperand.js
   (class x:base%
     (super-new)
 
-    (define (decode stream value)
+    (augment [@decode decode])
+    (define (@decode stream value)
       (cond
         [(<= 32 value 246) (- value 139)]
         [(<= 247 value 250) (+ (* (- value 247) 256) (read-byte stream) 108)]
@@ -48,7 +49,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFOperand.js
                    (let ([strs (cons (vector-ref FLOAT_LOOKUP n2) strs)])
                      (values strs #false))]))]))]))
 
-    (define (size value-arg)
+    (define/augment (size value-arg)
       ;; if the value needs to be forced to the largest size (32 bit)
       ;; e.g. for unknown pointers, set to 32768
       (define value (if (hash-ref value-arg 'forceLarge #f) 32768 value-arg))
@@ -62,7 +63,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFOperand.js
         [(<= -32768 value 32767) 3]
         [else 5]))
 
-    (define (encode stream value)
+    (augment [@encode encode])
+    (define (@encode stream value)
       ;; if the value needs to be forced to the largest size (32 bit)
       ;; e.g. for unknown pointers, save the old value and set to 32768
       (define val (string->number (format "~a" value)))
@@ -107,5 +109,4 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFOperand.js
          (encode uint32be val stream)]))))
 
 
-(define (CFFOperand . args)
-  (apply make-object CFFOperand% args))
+(define CFFOperand (make-object CFFOperand%))

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

@@ -174,12 +174,13 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFTop.js
                'offSize uint8
                'nameIndex (CFFIndex (x:string #:length 'length))
                'topDictIndex (CFFIndex CFFTopDict)
-               ;;'stringIndex (CFFIndex (x:string #:length 'length))
-               ;;'globalSubrIndex (CFFIndex)
-               )
+               'stringIndex (CFFIndex (x:string #:length 'length))
+               'globalSubrIndex (CFFIndex))
     
-    2 (dictify 'hdrSize uint8
+    #|
+2 (dictify 'hdrSize uint8
                'length  uint16be
-               ;;'topDict CFF2TopDict
-               ;;'globalSubrIndex (CFFIndex)
-               ))))
+               'topDict CFF2TopDict
+               'globalSubrIndex (CFFIndex))
+|#
+               )))