shoring up pointer

pitfall/fontkit/GPOS-test.coffee

@@ -2,8 +2,8 @@ fontkit = require '../pdfkit/node_modules/fontkit'
 
 fira_path = "../pitfall/test/assets/fira.ttf"
 f = fontkit.openSync(fira_path)
-thing = f.GPOS.lookupList
-console.log f.GPOS.lookupList.get(0)
+thing = f.GPOS.lookupList.get(0)
+console.log thing
 
 ###
 { version: 65536,

pitfall/fontkit/GPOS-test.rkt

@@ -4,5 +4,5 @@
 (define fira-path "../pitfall/test/assets/fira.ttf")
 (define f (openSync fira-path))
 (report 'start-decode)
-(define gpos-hash (send GPOS decode (send f _getTableStream 'GPOS)))
-gpos-hash
+(define gpos (send GPOS decode (send f _getTableStream 'GPOS)))
+;gpos

pitfall/fontkit/GPOS.rkt

@@ -20,35 +20,29 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/GPOS.js
    'xAdvDevice uint16be ;; pointer
    'yAdvDevice uint16be)) ;; pointer
 
-(require racket/dict)
-
 (define-subclass RestructureBase (ValueRecord [key 'valueFormat])
-
   (define/public (buildStruct parent)
-    (define struct parent)
-    (report parent)
-    (while (and (not (with-handlers ([exn:fail:object? (λ (exn) #f)])
-                      (get-field key struct))) (· struct parent))
-           (set! struct (· struct parent)))
-
-    (cond
-      [(report (with-handlers ([exn:fail:object? (λ (exn) #f)])
-                      (get-field key struct))) (void)]
-      [else (report (get-field key struct))
-            (define fields empty)
-            (set! fields (dictify 'rel (λ () (hash-ref struct (error '_startOffset-not-available)))))
-            (define format (get-field key struct))
-            
-(report* format fields)
-            (for ([key (in-list format)])
-                 (when (dict-ref format key)
-                   (set! fields (append fields (list (cons key (dict-ref types key)))))))
-            (+Struct fields)]))
+    ;; set `struct` to the first Struct object in the chain of ancestors
+    ;; with the target key
+    (define struct (let loop ([x parent])
+                     (cond
+                       [(and x (Struct? x) (dict-ref (· x res) key #f)) x]
+                       [(· x parent) => loop]
+                       [else #f])))
+    (and struct
+         (let ()
+           (define format (dict-ref (· struct res) key))
+           (define fields
+             (append
+              (dictify 'rel (λ _ (report (get-field _startOffset struct))))
+              (for/list ([(key val) (in-dict format)]
+                         #:when val)
+                (cons key (dict-ref types key)))))
+           (+Struct fields))))
 
   (define/override (size val ctx)
     (send (buildStruct ctx) size val ctx))
 
-  
   (define/augride (decode stream parent)
     (define res (send (buildStruct parent) decode stream parent))
     (hash-remove! res 'rel)
@@ -107,8 +101,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/GPOS.js
 (define-subclass VersionedStruct (GPOSLookup-VersionedStruct))
 (define GPOSLookup
   (+GPOSLookup-VersionedStruct
-   (λ (parent) (or (· parent parent res lookupType)
-                   (raise-argument-error 'GPOSLookup "parent object" #f)))
+   'lookupType
    (dictify
     ;; Single Adjustment
     1 (+VersionedStruct uint16be
@@ -194,7 +187,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/GPOS.js
 
 (define gpos-common-dict (dictify 'scriptList (+Pointer uint16be ScriptList)
                                   'featureList (+Pointer uint16be FeatureList)
-                                  'lookupList (+Pointer uint16be (LookupList GPOSLookup))))
+                                  'lookupList (+Pointer uint16be (LookupList GPOSLookup))
+                                  ))
 
 (define-subclass VersionedStruct (GPOS-VersionedStruct))
 (define GPOS (+GPOS-VersionedStruct uint32be

pitfall/fontkit/opentype.rkt

@@ -52,7 +52,7 @@
                    'lookupType uint16be
                    'flags LookupFlags
                    'subTableCount uint16be
-                   'subTables (+Array (+Pointer uint16be SubTable 'parent) 'subTableCount)
+                   'subTables (+Array (+Pointer uint16be SubTable) 'subTableCount)
                    'markFilteringSet uint16be)))
   (+Array (+Pointer uint16be Lookup) uint16be))
 

pitfall/fontkit/racket.rkt

@@ -13,6 +13,7 @@
      racket/string
      racket/format
      racket/contract
+     racket/dict
      racket/list
      racket/port
      racket/function

pitfall/pdfkit/node_modules/fontkit/index.js

@@ -2523,6 +2523,7 @@ var ValueRecord = function () {
 
     var fields = {};
     fields.rel = function () {
+      console.log("struct._startOffset="+ struct._startOffset);
       return struct._startOffset;
     };
 

pitfall/pdfkit/node_modules/restructure/src/Pointer.js

@@ -37,6 +37,7 @@
         return null;
       }
       relative = (function() {
+        console.log("pointer-scope="+this.options.type)
         switch (this.options.type) {
           case 'local':
             return ctx._startOffset;
@@ -55,8 +56,13 @@
       if (this.options.relativeTo) {
         relative += this.relativeToGetter(ctx);
       }
+      console.log("this._startOffset= "+this._startOffset);
+      console.log("ctx= "+ctx);
+      console.log("ctx._startOffset= "+ctx._startOffset);
+      console.log("offset= "+ offset)
+      console.log("relative= "+ relative)
       ptr = offset + relative;
-      console.log("ptr="+ptr+" type="+this.offsetType.size());
+      console.log("ptr="+ptr+" size="+this.offsetType.size());
       if (this.type != null) {
         val = null;
         decodeValue = (function(_this) {

pitfall/pdfkit/node_modules/restructure/src/Struct.js

@@ -48,7 +48,7 @@
       for (key in fields) {
         type = fields[key];
 
-        console.log("key=" + key + " type="+type);
+        console.log("key= " + key );
         if (typeof type === 'function') {
           val = type.call(res, res);
         } else {

pitfall/restructure/array.rkt

@@ -7,29 +7,39 @@ approximates
 https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
 |#
 
-(define-subclass Streamcoder (Array type [_length #f] [lengthType 'count])
+(define-subclass Streamcoder (Array type [length_ #f] [lengthType 'count])
           
   (define/augride (decode stream [parent #f])
-    (let ([len (cond
-                 ;; explicit length
-                 [_length (resolveLength _length stream parent)]
-                 [else  ;; implicit length: length of stream divided by size of item
-                  (define num (send stream length))
-                  (define denom (send type size))
-                  (unless (andmap (λ (x) (and x (number? x))) (list num denom))
-                    (raise-argument-error 'Array:decode "valid length and size" (list num denom)))
-                  (floor (/ (send stream length) (send type size)))])])
+    (define pos (· stream pos))
+    (define ctx parent)
+    (define len (cond
+                  ;; explicit length
+                  [length_ (resolveLength length_ stream parent)]
+                  [else  ;; implicit length: length of stream divided by size of item
+                   (define num (send stream length))
+                   (define denom (send type size))
+                   (unless (andmap (λ (x) (and x (number? x))) (list num denom))
+                     (raise-argument-error 'Array:decode "valid length and size" (list num denom)))
+                   (floor (/ (send stream length) (send type size)))]))
+    (report* length_ (Number? length_))
+    (when (Number? length_)
+      (set-field! parent ctx parent)
+      (set-field! _startOffset ctx pos)
+      (set-field! _currentOffset ctx 0)
+      (set-field! _length ctx length_))
     
-      (caseq lengthType
-             [(count) (for/list ([i (in-range len)])
-                        (send type decode stream this))])))
+    (define res (caseq lengthType
+                       [(bytes) (error 'array-decode-bytes-no!)]
+                       [(count) (for/list ([i (in-range len)])
+                                  (send type decode stream ctx))]))
+    res)
 
   (define/override (size [array #f])
     (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)]
+      [(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])
@@ -56,7 +66,7 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
 |#
 
 (define-subclass object% (InnerLazyArray type [_length #f] [stream #f] [parent #f])
-  (field [base (· stream pos)]
+  (field [base (and stream (· stream pos))]
          [items (mhash)]) ; implement with hash (random add) rather than array
 
   (define/public-final (get index)
@@ -74,11 +84,13 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
       (get i))))
 
 (define-subclass Array (LazyArray)
-  (inherit-field _length type)
+  (inherit-field length_ type)
   (define/override (decode stream [parent #f])
-    (define len (resolveLength _length stream parent))
+    (define len (resolveLength length_ stream parent))
     (define res (+InnerLazyArray type len stream parent))
-    (send stream pos (+ (· stream pos) (* len (send type size)))) ; skip the bytes that LazyArray would occupy
+    (define lazy-space (* len (send type size)))
+    (report lazy-space)
+    (send stream pos (+ (· stream pos) lazy-space)) ; skip the bytes that LazyArray would occupy
     res)
 
   (define/override (size [val #f])

pitfall/restructure/base.rkt

@@ -5,14 +5,16 @@
 (define RestructureBase
   (class object%
     (super-new)    
-    (field [starting-offset #f]
+    (field [_startOffset #f]
+           [_currentOffset #f]
+           [_length #f]
            [parent #f])
     (define/pubment (decode stream . args)
-      (set! starting-offset (and (object? stream) (send stream pos)))
+      (set! _startOffset (and (object? stream) (send stream pos)))
       (set! parent (and (pair? args) (is-a? (car args) RestructureBase) (car args)))
       (inner (void) decode stream . args))
-    (abstract encode)
-    (abstract size)
+    (define/public (encode . xs) (void))
+    (define/public (size . xs) (void))
     (define/public (process . args) (void))
     (define/public (preEncode . args) (void))))
 

pitfall/restructure/buffer.rkt

@@ -7,9 +7,9 @@ approximates
 https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee
 |#
 
-(define-subclass RestructureBase (Buffer [_length #xffff])
+(define-subclass RestructureBase (Buffer [length_ #xffff])
   (define/augride (decode stream [parent #f])
-    (define len (resolveLength _length stream parent))
+    (define len (resolveLength length_ stream parent))
     (send stream readBuffer len))
 
   (define/override (size [val #f] [parent #f])
@@ -17,11 +17,11 @@ https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee
                 (raise-argument-error 'Buffer:size "bytes" val)))
     (if val
         (bytes-length val)
-        (resolveLength _length val parent)))
+        (resolveLength length_ val parent)))
 
   (define/override (encode stream buf [parent #f])
-    (when (Number? _length)
-      (send _length encode stream (bytes-length buf)))
+    (when (Number? length_)
+      (send length_ encode stream (bytes-length buf)))
     (send stream writeBuffer buf)))
 
 (define (bytes->Buffer bstr)

pitfall/restructure/pointer-test.rkt

@@ -0,0 +1,47 @@
+#lang restructure/racket
+(require "pointer.rkt" "stream.rkt" "buffer.rkt" "base.rkt" "number.rkt" rackunit)
+
+#|
+approximates
+https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
+|#
+
+;; it 'should handle null pointers', ->
+(let ([stream (+DecodeStream (bytes 0))]
+      [pointer (+Pointer uint8 uint8)])
+  (define ctx (make-object RestructureBase))
+  (set-field! _startOffset ctx 50)
+  (check-exn exn:fail? (λ () (send pointer decode stream ctx))))
+
+;; it 'should use local offsets from start of parent by default', ->
+(let ([stream (+DecodeStream (bytes 1 53))]
+      [pointer (+Pointer uint8 uint8)])
+  (define ctx (make-object RestructureBase))
+  (set-field! _startOffset ctx 0)
+  (check-equal? (send pointer decode stream ctx) 53))
+
+;; todo
+;; it 'should support immediate offsets', ->
+#;(let ([stream (+DecodeStream (bytes 1 53))]
+        [pointer (+Pointer uint8 uint8 'immediate)])
+    (check-equal? (send pointer decode stream) 53))
+
+;; it 'should support offsets relative to the parent', ->
+(let ([stream (+DecodeStream (bytes 0 0 1 53))]
+      [pointer (+Pointer uint8 uint8 'parent)])
+  (send stream pos 2)
+  (define ctx-parent (make-object RestructureBase))
+  (set-field! _startOffset ctx-parent 2)
+  (define ctx (make-object RestructureBase))
+  (set-field! parent ctx ctx-parent)
+  (check-equal? (send pointer decode stream ctx) 53))
+
+;; it 'should support global offsets', ->
+#;(let ([stream (+DecodeStream (bytes 1 2 4 0 0 0 53))]
+      [pointer (+Pointer uint8 uint8 'global)])
+  (send stream pos 2)
+  (define ctx-parent (make-object RestructureBase))
+  (set-field! _startOffset ctx-parent 2)
+  (define ctx (make-object RestructureBase))
+  (set-field! parent ctx ctx-parent)
+  (check-equal? (send pointer decode stream ctx) 53))

pitfall/restructure/pointer.rkt

@@ -8,17 +8,26 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
 
 (define-subclass RestructureBase (Pointer offsetType type [scope 'local])
   (and (symbol? scope) (caseq scope
-                              [(local parent grandparent immediate) 'yay]
-                              [else (raise-argument-error 'Pointer "local or parent" scope)]))
+                              [(local parent immediate global) 'yay]
+                              [else (raise-argument-error 'Pointer "local or parent or immediate" scope)]))
 
-  (define/augride (decode stream ctx)
+  (define/augride (decode stream [ctx #f])
     (define offset (send offsetType decode stream ctx))
-    (define ptr (+ offset (caseq scope
-                                 [(immediate) (· this starting-offset)]
-                                 [(local) (· this parent starting-offset)]
-                                 [(parent) (· this parent parent starting-offset)]
-                                 [(grandparent) (· this parent parent parent starting-offset)])))
-    (report* ptr (send offsetType size))
+    (report scope 'pointer-scope)
+    (define relative (caseq scope
+                            [(local) (· ctx _startOffset)]
+                            [(parent) (· ctx parent _startOffset)]
+                            [(immediate) (- (· stream pos) (send offsetType size))]
+                            [(global) 
+                                  (let loop ([c ctx])
+                                    (cond
+                                      [(· c parent) => loop]
+                                      [else (or (· c starting-offset) 0)]))]))
+    (report* (· this _startOffset) (and ctx (· ctx _startOffset)))
+    (report* offset relative)
+    (define ptr (+ offset relative))
+    (report* ptr)
+    (report (send offsetType size) 'size)
     (cond
       [type (define orig-pos (send stream pos))
             (send stream pos ptr)
@@ -32,7 +41,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
     (error 'Pointer-encode-not-done))
 
   (define/override (size [val #f] [ctx #f])
-    
+    (error 'Pointer-size-not-done)
     (report* this offsetType type (send type size)))
 
   

pitfall/restructure/struct.rkt

@@ -32,7 +32,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
     (cond
       [(dict? fields)
        (for* ([(key type) (in-dict fields)])
-             (send type encode stream (hash-ref input-hash key)))]
+         (send type encode stream (hash-ref input-hash key)))]
       [else (send fields encode stream input-hash parent)]))
 
   (define/public-final (_setup stream parent length)
@@ -42,18 +42,18 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
     (unless (assocs? fields)
       (raise-argument-error '_parseFields "assocs" fields))
     (for ([(key type) (in-dict fields)])
-      (report* key type)
-         (define val
-           (if (procedure? type)
-               (type res)
-               (send type decode stream this)))
-         (hash-set! res key val)))
+      (report key)
+      (define val
+        (if (procedure? type)
+            (type res)
+            (send type decode stream this)))
+      (hash-set! res key val)))
 
   (define/override (size [input-hash (mhash)] [parent #f] [includePointers #t])
     (for/sum ([(key type) (in-dict fields)])
-             (define val (hash-ref input-hash key #f))
-             (define args (if val (list val) empty))
-             (send type size . args))))
+      (define val (hash-ref input-hash key #f))
+      (define args (if val (list val) empty))
+      (send type size . args))))
 
 
 (test-module
@@ -63,17 +63,17 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
 
  ;; make random structs and make sure we can round trip
  (for ([i (in-range 10)])
-      (define field-types (for/list ([i (in-range 20)])
-                                    (random-pick (list uint8 uint16be uint16le uint32be uint32le double))))
-      (define size-num-types (for/sum ([num-type (in-list field-types)])
-                                      (send num-type size)))
-      (define s (+Struct (for/list ([num-type (in-list field-types)])
-                                   (cons (gensym) num-type))))
-      (define bs (apply bytes (for/list ([i (in-range size-num-types)])
-                                        (random 256))))
-      (define es (+EncodeStream))
-      (send s encode es (send s decode bs))
-      (check-equal? (send es dump) bs)))
+   (define field-types (for/list ([i (in-range 20)])
+                         (random-pick (list uint8 uint16be uint16le uint32be uint32le double))))
+   (define size-num-types (for/sum ([num-type (in-list field-types)])
+                            (send num-type size)))
+   (define s (+Struct (for/list ([num-type (in-list field-types)])
+                        (cons (gensym) num-type))))
+   (define bs (apply bytes (for/list ([i (in-range size-num-types)])
+                             (random 256))))
+   (define es (+EncodeStream))
+   (send s encode es (send s decode bs))
+   (check-equal? (send es dump) bs)))
                    
  
 
@@ -99,7 +99,14 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
     (cond
       [forced-version] ; for testing purposes: pass an explicit version
       [(integer? type) type]
-      [(symbol? type) (hash-ref (· parent res version-resolver))]
+      [(symbol? type)
+       ;; find the first Struct in the chain of ancestors
+       ;; with the target key
+       (let loop ([x parent])
+         (cond
+           [(and x (Struct? x) (dict-ref (· x res) type #f))]
+           [(· x parent) => loop]
+           [else #f]))]
       [(and (procedure? type) (positive? (procedure-arity type))) (type parent)]
       [(RestructureBase? type) (send type decode stream)]
       [else (raise-argument-error 'VersionedStruct:resolve-version "way of finding version" type)]))
@@ -130,7 +137,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
     (cond
       [(dict? fields)
        (for* ([(key type) (in-dict fields)])
-             (send type encode stream (hash-ref input-hash key)))]
+         (send type encode stream (hash-ref input-hash key)))]
       [else (send fields encode stream input-hash parent)]))
 
   
@@ -142,9 +149,9 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
     (cond
       [(dict? fields)
        (for/sum ([(key type) (in-dict fields)])
-                (define val (hash-ref input-hash key #f))
-                (define args (if val (list val) empty))
-                (send type size . args))]
+         (define val (hash-ref input-hash key #f))
+         (define args (if val (list val) empty))
+         (send type size . args))]
       [else (send fields size input-hash parent includePointers)])))
 
 (test-module
@@ -153,19 +160,19 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
 
  ;; make random versioned structs and make sure we can round trip
  (for ([i (in-range 20)])
-      (define field-types (for/list ([i (in-range 200)])
-                                    (random-pick (list uint8 uint16be uint16le uint32be uint32le double))))
-      (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)))))
-      (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)))
-      (define bs (apply bytes (for/list ([i (in-range struct-size)])
-                                        (random 256))))
-      (check-equal? (send vs encode #f (send vs decode bs)) bs))
+   (define field-types (for/list ([i (in-range 200)])
+                         (random-pick (list uint8 uint16be uint16le uint32be uint32le double))))
+   (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)))))
+   (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)))
+   (define bs (apply bytes (for/list ([i (in-range struct-size)])
+                             (random 256))))
+   (check-equal? (send vs encode #f (send vs decode bs)) bs))
 
  (define s (+Struct (dictify 'a uint8 'b uint8 'c uint8)))
  (check-equal? (send s size) 3)