bug in hmtx / lazyarray

pitfall/fontkit/directory.rkt

@@ -22,6 +22,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js
     (hash-set! this-res 'tables new-tables-val))
 
   (define/override (preEncode this-val stream)
+    (report 'start-directory-preEncode)
     (define tables empty)
     (for ([(tag table) (in-hash (· this-val tables))])
       (when table
@@ -30,18 +31,21 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js
                     'tag tag
                     'checkSum 0
                     'offset #xdeadbeef ; todo
-                    'length (send (hash-ref table-decoders tag (λ () (raise-argument-error 'directory:preEncode "valid table tag" tag))) size table)))))
+                    'length (let ([tag (hash-ref table-decoders tag (λ () (raise-argument-error 'directory:preEncode "valid table tag" tag)))])
+                              (report* tag table (send tag size table)))))))
     (define numTables (length tables))
     (define searchRange (* (floor (log (/ numTables (log 2)))) 16))
     (define entrySelector (floor (/ searchRange (log 2))))
     (define rangeShift (- (* numTables 16) searchRange))
+    
     (hash-set*! this-val
                 'tag "true"
                 'numTables numTables
                 'tables tables
                 'searchRange searchRange
                 'entrySelector rangeShift
-                'rangeShift rangeShift)))
+                'rangeShift rangeShift)
+    (report 'end-directory-preEncode)))
       
 
 (define Directory (make-object RDirectory
@@ -58,37 +62,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js
 
 (test-module
  (define ip (open-input-file charter-path))
- (check-equal?
-  (directory-decode ip)
-  (deserialize '((3)
-                 0
-                 ()
-                 0
-                 ()
-                 ()
-                 (h
-                  !
-                  ()
-                  (tag u . "\u0000\u0001\u0000\u0000")
-                  (rangeShift . 96)
-                  (searchRange . 128)
-                  (numTables . 14)
-                  (entrySelector . 3)
-                  (tables
-                   h
-                   !
-                   (equal)
-                   (loca h ! () (tag u . "loca") (offset . 38692) (checkSum . 2795817194) (length . 460))
-                   (glyf h ! () (tag u . "glyf") (offset . 4620) (checkSum . 1143629849) (length . 34072))
-                   (OS/2 h ! () (tag u . "OS/2") (offset . 360) (checkSum . 2351070438) (length . 96))
-                   (hhea h ! () (tag u . "hhea") (offset . 292) (checkSum . 132056097) (length . 36))
-                   (post h ! () (tag u . "post") (offset . 41520) (checkSum . 1670855689) (length . 514))
-                   (|cvt | h ! () (tag u . "cvt ") (offset . 4592) (checkSum . 10290865) (length . 26))
-                   (VDMX h ! () (tag u . "VDMX") (offset . 1372) (checkSum . 1887795202) (length . 1504))
-                   (prep h ! () (tag u . "prep") (offset . 4512) (checkSum . 490862356) (length . 78))
-                   (maxp h ! () (tag u . "maxp") (offset . 328) (checkSum . 50135594) (length . 32))
-                   (hmtx h ! () (tag u . "hmtx") (offset . 456) (checkSum . 3982043058) (length . 916))
-                   (cmap h ! () (tag u . "cmap") (offset . 2876) (checkSum . 1723761408) (length . 1262))
-                   (name h ! () (tag u . "name") (offset . 39152) (checkSum . 2629707307) (length . 2367))
-                   (head h ! () (tag u . "head") (offset . 236) (checkSum . 4281190895) (length . 54))
-                   (fpgm h ! () (tag u . "fpgm") (offset . 4140) (checkSum . 106535991) (length . 371))))))))
+ (define decoded-dir (deserialize (read (open-input-file charter-directory-path))))
+ (check-equal? (directory-decode ip) decoded-dir)
+ (define es (+EncodeStream))
+ ;(send Directory encode es decoded-dir)
+ )

pitfall/fontkit/head.rkt

@@ -56,4 +56,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/head.js
                                                     (bold . #f)
                                                     (italic . #t))))
  (check-equal? (· table-data magicNumber) #x5F0F3CF5)
- (check-equal? (· table-data indexToLocFormat) 0)) ; used in loca table
+ (check-equal? (· table-data indexToLocFormat) 0) ; used in loca table
+ 
+ (define es (+EncodeStream))
+ (send head encode es table-data)
+ (check-equal? (send es dump) table-bytes))

pitfall/fontkit/hhea.rkt

@@ -34,5 +34,9 @@
  (check-equal? (peek-bytes length offset ip) table-bytes)
  (define table-data (send hhea decode (+DecodeStream table-bytes)))
  (check-equal? (· table-data ascent) 980)
- (check-equal? (· table-data descent) -238))
+ (check-equal? (· table-data descent) -238)
+ (check-equal? (· table-data numberOfMetrics) 229)
+
+
+ )
 

pitfall/fontkit/hmtx.rkt

@@ -8,18 +8,25 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/hmtx.js
 
 (define-subclass Struct (Rhmtx))
 
-(define HmtxEntry (make-object Struct
-                    (dictify
-                     'advance uint16be
-                     'bearing uint16be)))
+(define HmtxEntry (+Struct
+                   (dictify
+                    'advance uint16be
+                    'bearing uint16be)))
+
+(define hmtx (+Rhmtx
+              (dictify
+               'metrics (+LazyArray HmtxEntry (λ (t) (· (send (· t parent) _getTable 'hhea) numberOfMetrics)))
+               'bearing (+LazyArray int16be (λ (t) (- (· (send (· t parent) _getTable 'maxp) numGlyphs)
+                                                      (· (send (· t parent) _getTable 'hhea) numberOfMetrics)))))))
+
 
-(define hmtx (make-object Rhmtx
-               (dictify
-                'metrics (+LazyArray HmtxEntry (λ (t) (hash-ref (send (· t parent) _getTable 'hhea) 'numberOfMetrics)))
-                'bearing (+LazyArray int16be (λ (t) (- (hash-ref (send (· t parent) _getTable 'maxp) 'numGlyphs)
-                                                       (hash-ref (send (· t parent) _getTable 'hhea) 'numberOfMetrics)))))))
 
 (test-module
+ ;; same as hmtx but doesn't require resolution of function to get length
+ (define hmtx-test (+Rhmtx
+                    (dictify
+                     'metrics (+LazyArray HmtxEntry (λ (t) 229))
+                     'bearing (+LazyArray int16be (λ (t) 0)))))
  (define ip (open-input-file charter-path))
  (define dir (deserialize (read (open-input-file charter-directory-path))))
  (define hmtx-offset (· dir tables hmtx offset))
@@ -27,5 +34,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/hmtx.js
  (check-equal? hmtx-offset 456)
  (check-equal? hmtx-length 916)
  (define hmtx-bytes (peek-bytes hmtx-length hmtx-offset ip))
- (define hmtx-data (send hmtx decode (+DecodeStream hmtx-bytes)))
- (check-equal? (send (· hmtx-data bearing) get 42) 412))
+ (define hmtx-data (send hmtx-test decode (+DecodeStream hmtx-bytes)))
+ (check-equal? (send hmtx-test size) (* 229 (send HmtxEntry size)))
+ (define H-gid 41) (define OE-gid 142)
+ (check-equal? (send (· hmtx-data metrics) get H-gid) (mhasheq 'advance 738 'bearing 33))
+ (check-equal? (send (· hmtx-data metrics) get OE-gid) (mhasheq 'advance 993 'bearing 43)))

pitfall/fontkit/subset.rkt

@@ -93,8 +93,9 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js
                 ;; todo: cvt
                 'prep (send (· this font) _getTable 'prep)
                 ;; 'glyf (· this glyf)
-                'hmtx (· this hmtx)
-                'fpgm (send (· this font) _getTable 'fpgm))))
+                ;; 'hmtx (· this hmtx)
+                'fpgm (send (· this font) _getTable 'fpgm)
+                )))
 
   (report* stream (send stream dump))
   

pitfall/restructure/array.rkt

@@ -24,9 +24,14 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
              [(count) (for/list ([i (in-range len)])
                         (send type decode stream this))])))
 
-  (define/override (size array)
-    (unless (list? array) (raise-argument-error 'Array:size "list" array))
-    (* (send type size) (length array)))
+  (define/override (size [array #f])
+    (report* _length array)
+    (when (and array (not (list? array)))
+      (raise-argument-error 'Array:size "list" array))
+    (cond
+      [(not array) (* (send type size) (resolveLength _length (+DecodeStream) #f))]
+      [(Number? _length) (send _length size)]
+      [else (* (send type size) (length array))]))
 
   (define/augride (encode stream array [parent #f])
     (unless (list? array) (raise-argument-error 'Array:encode "list" array))
@@ -51,17 +56,17 @@ approximates
 https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
 |#
 
-(define-subclass object% (InnerLazyArray type [_length #f] [stream #f] [ctx #f])
+(define-subclass object% (InnerLazyArray type [_length #f] [stream #f] [parent #f])
   (field [base (· stream pos)]
          [items (mhash)]) ; implement with hash (random add) rather than array
 
   (define/public-final (get index)
     (when (or (< index 0) (<= _length index))
-      (raise-argument-error 'InnerLazyArray:get (format "non-negative index less than length ~a of array" _length) index))
+      (raise-argument-error 'InnerLazyArray:get (format "array index between 0 and ~a" _length) index))
     (hash-ref! items index (λ ()
                              (define stashed-pos (· stream pos))
                              (send stream pos (+ base (* index (send type size))))
-                             (define new-val (send type decode stream ctx))
+                             (define new-val (send type decode stream parent))
                              (send stream pos stashed-pos)
                              new-val)))
 
@@ -74,10 +79,10 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
   (define/override (decode stream [parent #f])
     (define len (resolveLength _length stream parent))
     (define res (+InnerLazyArray type len stream parent))
-    (send stream pos (+ (· stream pos) (* _length (send type size)))) ; skip the bytes that LazyArray would occupy
+    (send stream pos (+ (· stream pos) (* len (send type size)))) ; skip the bytes that LazyArray would occupy
     res)
 
-  (define/override (size val)
+  (define/override (size [val #f])
     (super size (if (InnerLazyArray? val)
                     (send val toArray)
                     val)))
@@ -91,9 +96,9 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
  (define bstr #"ABCD1234")
  (define ds (+DecodeStream bstr))
  (define la (+LazyArray uint8 4))
-(define ila (send la decode ds))
-(check-equal? (send ds pos) 4)
-(check-equal? (send ila get 1) 66)
-(check-equal? (send ila get 3) 68)
-(check-equal? (send ds pos) 4)
-(check-equal? (send ila toArray) '(65 66 67 68)))
+ (define ila (send la decode ds))
+ (check-equal? (send ds pos) 4)
+ (check-equal? (send ila get 1) 66)
+ (check-equal? (send ila get 3) 68)
+ (check-equal? (send ds pos) 4)
+ (check-equal? (send ila toArray) '(65 66 67 68)))

pitfall/restructure/struct.rkt

@@ -37,10 +37,11 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
     res)
 
   (define/augride (encode stream input-hash [parent #f])
+    
     (unless (hash? input-hash)
       (raise-argument-error 'Struct:encode "hash" input-hash))
 
-    (send this preEncode input-hash stream) ; might bring input hash into compliance
+    (send this preEncode input-hash stream) ; preEncode goes first, because it might bring input hash into compliance
 
     (unless (andmap (λ (key) (member key (hash-keys input-hash))) key-index)
       (raise-argument-error 'Struct:encode (format "hash that contains superset of Struct keys: ~a" key-index) (hash-keys input-hash)))
@@ -71,9 +72,8 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
       (hash-set! res key val)))
 
   (define/override (size [val (mhash)] [parent #f] [includePointers #t])
-    (for/sum ([(key type) (in-hash fields)]
-              #:when (hash-has-key? val key))
-      (send type size (hash-ref val key)))))
+    (for/sum ([(key type) (in-hash fields)])
+      (send type size (hash-ref val key #f)))))
 
 
 (test-module
@@ -143,11 +143,11 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
    (define num-versions 20)
    (define which-struct (random num-versions))
    (define struct-versions (for/list ([v (in-range num-versions)])
-                      (cons v (for/list ([num-type (in-list field-types)])
-                                (cons (gensym) num-type)))))
+                             (cons v (for/list ([num-type (in-list field-types)])
+                                       (cons (gensym) num-type)))))
    (define vs (+VersionedStruct which-struct struct-versions))
    (define struct-size (for/sum ([num-type (in-list (map cdr (dict-ref struct-versions which-struct)))])
-                            (send num-type size)))
+                         (send num-type size)))
    (define bs (apply bytes (for/list ([i (in-range struct-size)])
                              (random 256))))
    (define es (+EncodeStream))

pitfall/restructure/utils.rkt

@@ -2,10 +2,11 @@
 (provide (all-defined-out))
 (require "number.rkt")
 
-(define (resolveLength _length stream parent)
+(define (resolveLength len stream parent)
+  (report* len stream parent)
   (cond
-    [(number? _length) _length]
-    [(procedure? _length) (_length parent)]
-    [(and parent (symbol? _length) (hash-ref parent _length))] ; treat as key into RStruct parent
-    [(and stream (is-a? _length Number) (send _length decode stream))]
-    [else (raise-argument-error 'resolveLength "fixed-size item" _length)]))
+    [(number? len) len]
+    [(procedure? len) (len parent)]
+    [(and parent (symbol? len) (hash-ref parent len))] ; treat as key into RStruct parent
+    [(and stream (Number? len) (send len decode stream))]
+    [else (raise-argument-error 'resolveLength "fixed-size item" len)]))