roundtrip

fontland/fontland/subset.rkt

@@ -191,9 +191,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/CFFSubset.js
              'stringIndex (cff-subset-strings this)
              'globalSubrIndex (cff-subset-gsubrs this)))
 
-  (encode CFFTop top stream)
-
-  (error 'boom))
+  (encode CFFTop top stream))
 
 #;(module+ test
     (require "font.rkt" "helper.rkt")

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

@@ -124,6 +124,36 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFDict.js
 
     (augment [@encode encode])
     (define (@encode dict stream parent)
-      (error 'cff-dict-encode-undefined))))
+      (define ctx (mhasheq
+                   x:pointers-key null
+                   x:start-offset-key (pos stream)
+                   x:parent-key parent
+                   x:val-key dict
+                   x:pointer-size-key 0))
+
+      (hash-set! ctx x:pointer-offset-key (+ (pos stream) (@size dict ctx #false)))
+
+      (for ([field (in-list @ops)])
+        (define val (dict-ref dict (list-ref field 1) #false))
+        (cond
+          [(or (not val) (equal? val (list-ref field 3)))]
+          [else
+           (define operands (encodeOperands (list-ref field 2) stream ctx val))
+           (for ([op (in-list operands)])
+             (send CFFOperand 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 ()
+        (when (< i (length (hash-ref ctx x:pointers-key)))
+          (define ptr (list-ref (hash-ref ctx x:pointers-key) i))
+          (set! i (add1 i))
+          (send (hash-ref ptr 'type) encode (hash-ref ptr 'val) stream (hash-ref ptr 'parent))
+          (loop))))))
 
-(define (CFFDict [name 'unknown] [ops null]) (make-object CFFDict% name ops))
+      (define (CFFDict [name 'unknown] [ops null]) (make-object CFFDict% name ops))

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

@@ -89,7 +89,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFIndex.js
          (define sizes null)
          (define offset 1)
          (for ([item (in-list arr)])
-           (define s (send @type size item parent))
+           (define s (send type size item parent))
            (set! sizes (append sizes (list s)))
            (set! offset (+ offset s)))
 

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

@@ -70,13 +70,14 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFOperand.js
         [else 5]))
 
     (augment [@encode encode])
-    (define (@encode value stream)
+    (define (@encode value-arg stream . _)
       ;; 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)))
+      (define value (if (Ptr? value-arg) (Ptr-val value-arg) value-arg))
+      (define val (if value (string->number (format "~a" value)) 0))
 
       (cond
-        [(hash-ref value 'forceLarge #f)
+        [(and (hash? value-arg) (hash-ref value-arg 'forceLarge #f))
          (encode uint8 29 stream)
          (encode int32be val stream)]
         [(not (integer? val)) ;; floating point
@@ -101,11 +102,11 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFOperand.js
         [(<= -107 value 107)
          (encode uint8 (+ val 139) stream)]
         [(<= 108 value 1131)
-         (encode uint8 (+ (arithmetic-shift val 8) 247) stream)
+         (encode uint8 (+ (arithmetic-shift val -8) 247) stream)
          (encode uint8 (bitwise-and val #xff) stream)]
         [(<= -1131 value -108)
          (let ([val (- (- val) 108)])
-           (encode uint8 (+ (arithmetic-shift val 8) 251) stream)
+           (encode uint8 (+ (arithmetic-shift val -8) 251) stream)
            (encode uint8 (bitwise-and val #xff) stream))]
         [(<= -32768 value 32767)
          (encode uint8 28 stream)

fontland/fontland/table/cff/cff-pointer.rkt

@@ -1,5 +1,5 @@
 #lang debug racket/base
-(require racket/class racket/list xenomorph "cff-struct.rkt")
+(require racket/class racket/list xenomorph/pointer xenomorph/base "cff-struct.rkt")
 (provide CFFPointer)
 
 #|
@@ -20,6 +20,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFPointer.js
   (class x:pointer%
     (super-new)
 
+    (inherit/super [%encode encode])
     (inherit-field type offset-type)
     
     (define/override (decode stream parent operands)
@@ -41,12 +42,12 @@ https://github.com/mbutterick/fontkit/blob/master/src/cff/CFFPointer.js
          (send this size value ctx)
          (list (Ptr 0))]
         [else
+         #RRR 'rees
          (define ptr #false)
          (set! offset-type (make-object
                                (class x:base%
                                  (super-new)
-                                 (define/augment (encode val stream) (set! ptr val)))))
-         (error 'branch-not-impl)
-         #;(super encode value stream ctx)
+                                 (define/augment (encode val stream . _) (set! ptr val)))))
+         (pointer-encode this value stream ctx)
          (list (Ptr ptr))]))))