next: simulate parent

pitfall/fontkit/hmtx.rkt

@@ -9,14 +9,27 @@ 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)))
+                    (dictify
+                     'advance uint16be
+                     'bearing uint16be)))
 
 (define hmtx (make-object Rhmtx
                (dictify
-                'metrics uint16be
-                'bearing uint16be)))
+                '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
+ (define ip (open-input-file charter-path))
+ (define dir (deserialize (read (open-input-file charter-directory-path))))
+ (define hmtx-offset (· dir tables hmtx offset))
+ (define hmtx-length (· dir tables hmtx length))
+ (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? (· maxp-data numGlyphs) 229)
+ (check-equal? (· maxp-data version) 65536))
 
 
 (test-module

pitfall/restructure/array.rkt

@@ -9,7 +9,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
 
 (define-subclass Streamcoder (Array type [_length #f] [lengthType 'count])
           
-  (define/augment (decode stream [parent #f])
+  (define/augride (decode stream [parent #f])
     (let ([len (cond
                  ;; explicit length
                  [_length (resolveLength _length stream parent)]
@@ -28,7 +28,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
     (unless (list? array) (raise-argument-error 'Array:size "list" array))
     (* (send type size) (length array)))
 
-  (define/augment (encode stream array [parent #f])
+  (define/augride (encode stream array [parent #f])
     (unless (list? array) (raise-argument-error 'Array:encode "list" array))
     (for ([item (in-list array)])
       (send type encode stream item))))
@@ -44,4 +44,56 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
  (check-equal? (send os dump) #"ABCDEF")
 
  (check-equal? (send (+Array uint16be) size '(1 2 3)) 6)
- (check-equal? (send (+Array doublebe) size '(1 2 3 4 5)) 40))
+ (check-equal? (send (+Array doublebe) size '(1 2 3 4 5)) 40))
+
+#|
+approximates
+https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
+|#
+
+(define-subclass object% (InnerLazyArray type [_length #f] [stream #f] [ctx #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))
+    (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))
+                             (send stream pos stashed-pos)
+                             new-val)))
+
+  (define/public-final (toArray)
+    (for/list ([i (in-range _length)])
+      (get i))))
+
+(define-subclass Array (LazyArray)
+  (inherit-field _length type)
+  (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
+    res)
+
+  (define/override (size val)
+    (super size (if (InnerLazyArray? val)
+                    (send val toArray)
+                    val)))
+
+  (define/override (encode stream val)
+    (super encode (if (InnerLazyArray? val)
+                      (send val toArray)
+                      val))))    
+
+(test-module
+ (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)))

pitfall/restructure/stream.rkt

@@ -5,7 +5,10 @@
 (define-subclass object% (PortWrapper _port)
   (unless (port? _port)
     (raise-argument-error 'PortWrapper:constructor "port" _port))
-  (define/public-final (pos) (port-position _port))
+  (define/public-final (pos [where #f])
+    (when where
+      (set-port-position! _port where))
+    (port-position _port))
   (define/public (dump) (void)))
 
 (test-module

pitfall/restructure/utils.rkt

@@ -2,10 +2,10 @@
 (provide (all-defined-out))
 (require "number.rkt")
 
-(define (resolveLength length stream parent)
+(define (resolveLength _length 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? _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)]))