portifying

pitfall/fontkit/GPOS-test.rkt

@@ -2,12 +2,10 @@
 (require fontkit "subset.rkt" rackunit xenomorph racket/serialize)
 
 (define fira-path "../pitfall/test/assets/fira.ttf")
-(define f (openSync fira-path))
-(define gpos (· f GPOS))
+(define f (openSync charter-path))
 (define ttfs (make-object TTFSubset f))
 (send ttfs encodeStream)
 
-#;(define gsub (· f GSUB))
-
+#;(define gpos (· f GPOS))
 #;(get (· gpos lookupList) 7)
 

pitfall/fontkit/directory.rkt

@@ -1,5 +1,5 @@
 #lang fontkit/racket
-(require xenomorph "tables.rkt")
+(require xenomorph "tables.rkt" describe)
 
 (provide (all-defined-out))
 
@@ -27,7 +27,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js
     (dict-set! this-res 'tables new-tables-val)
     this-res)
 
-  (define/override (pre-encode this-val stream)
+  (define/augride (pre-encode this-val port)
     (define tables (for/list ([(tag table) (in-hash (· this-val tables))])
                              (define table-codec (hash-ref table-codecs tag))
                              (mhash 'tag (unescape-tag tag)

pitfall/fontkit/loca.rkt

@@ -21,7 +21,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/loca.js
       (dict-update! res 'offsets (λ (offsets) (map (curry * 2) offsets))))
     res)
 
-  (define/override (pre-encode this-val stream)
+  (define/augride (pre-encode this-val stream)
     ;; this = val to be encoded
     (loca-pre-encode this-val stream)
     this-val))

pitfall/fontkit/subset.rkt

@@ -67,10 +67,10 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
   ;; get the offset to the glyph from the loca table
   (match-define (list curOffset nextOffset) (take (drop (· this font loca offsets) gid) 2))
 
-  (define stream (send (· this font) _getTableStream 'glyf))
-  (pos (+ (pos stream) curOffset))
+  (define port (send (· this font) _getTableStream 'glyf))
+  (pos port (+ (pos port) curOffset))
 
-  (define buffer (send stream readBuffer (- nextOffset curOffset)))
+  (define buffer (read-bytes  (- nextOffset curOffset) port))
 
   ;; if it is a compound glyph, include its components
   (when (and glyf (negative? (· glyf numberOfContours)))
@@ -96,8 +96,9 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
 ;; additional tables required for standalone fonts:
 ;; name, cmap, OS/2, post
 
-(define/contract (encode this stream)
+(define/contract (encode this port)
   (output-port? . ->m . void?)
+  
   (set-field! glyf this empty)
   (set-field! offset this 0)
   (set-field! loca this (mhash 'offsets empty))
@@ -122,8 +123,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
   
   (define hhea (cloneDeep (dump (· this font hhea))))
   (dict-set! hhea 'numberOfMetrics (length (· this hmtx metrics)))
-
-  (send Directory encode stream
+  
+  (send Directory encode port
         (mhash 'tables
                (mhash
                 'head head
@@ -134,8 +135,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
                 'prep (· this font prep)
                 'glyf (· this glyf)
                 'hmtx (· this hmtx)
-                'fpgm (· this font fpgm)
-                )))
+                'fpgm (· this font fpgm))))
 
   #;(report* (bytes-length (send stream dump)) (send stream dump))
   #;(report* (bytes-length (file->bytes "out.bin")) (file->bytes "out.bin"))

pitfall/xenomorph/private/base.rkt

@@ -81,7 +81,7 @@
                    [(output-port? port) port]
                    [(not port) (open-output-bytes)]
                    [else (raise-argument-error 'Xenomorph "output port or #f" port)]))
-      (define encode-result (inner #"" encode op val parent . args))
+      (define encode-result (inner (void) encode op val parent . args))
       (when (bytes? encode-result)
         (write-bytes encode-result op))
       (when (not port) (get-output-bytes op)))

pitfall/xenomorph/private/struct.rkt

@@ -45,16 +45,20 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
 
 
 (define-subclass xenomorph-base% (Struct [fields (dictify)])
-  (field [[_process process] (λ (val port ctx) val)]
+  (field [[_post-decode post-decode] (λ (val port ctx) val)]
          [[_pre-encode pre-encode] (λ (val port) val)]) ; store as field so it can be mutated from outside
   
   (define/overment (post-decode res stream [ctx #f])
-    (let* ([res (_process res stream ctx)]
+    (let* ([res (_post-decode res stream ctx)]
            [res (inner res post-decode res stream ctx)])
-      (unless (dict? res) (raise-result-error 'Struct:process "dict" res))
+      (unless (dict? res) (raise-result-error 'Struct:post-decode "dict" res))
       res))
   
-  (define/override (pre-encode . args) (apply _pre-encode args))
+  (define/overment (pre-encode res . args)
+    (let* ([res (apply _pre-encode res args)]
+           [res (inner res pre-encode res . args)])
+      (unless (dict? res) (raise-result-error 'Struct:pre-encode "dict" res))
+      res))
   
   (unless ((disjoin assocs? Struct?) fields) ; should be Versioned Struct but whatever
     (raise-argument-error 'Struct "assocs or Versioned Struct" fields))
@@ -100,7 +104,6 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
     (unless (dict? val)
       (raise-argument-error 'Struct:encode "dict" val))
 
-    (send this pre-encode val port) ; preEncode goes first, because it might bring input dict into compliance
     (define ctx (mhash 'pointers empty
                        'startOffset (pos port)
                        'parent parent

pitfall/xenomorph/test/struct-test.rkt

@@ -23,7 +23,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
 (parameterize ([current-input-port (open-input-bytes #"\x05devon\x20")])
   (define struct (+Struct (dictify 'name (+StringT uint8)
                                    'age uint8)))
-  (set-field! process struct (λ (o . _) (ref-set! o 'canDrink (>= (· o age) 21)) o))
+  (set-field! post-decode struct (λ (o . _) (ref-set! o 'canDrink (>= (· o age) 21)) o))
   (check-equal? (dump (decode struct))
                 (mhasheq 'name "devon" 'age 32 'canDrink #t)))