progress on directory

pitfall/pitfall/directory.rkt

@@ -1,14 +1,32 @@
 #lang pitfall/racket
+(require restructure)
+
 (provide (all-defined-out))
 
-(require restructure)
 
 
+
+(define TableEntry (make-object RStruct
+                     (list (cons 'tag (make-object RString 4))
+                           (cons 'checkSum uint32be)
+                           (cons 'offset uint32be)
+                           (cons 'length uint32be))))
+
 #;(define TableEntry (new RStruct
-                     'tag (RString 4)
+                          (list (cons 'tag (RString 4))
-                     'checkSum uint32be
+                                (cons 'checkSum uint32be)
-                     'offset uint32be
+                                (cons 'offset uint32be)
-                     'length uint32be))
+                                (cons 'length uint32be))))
+
+(define Directory (make-object RStruct
+                    (list (cons 'tag (make-object RString 4))
+                          (cons 'numTables uint16be)
+                          (cons 'searchRange uint16be)
+                          (cons 'entrySelector uint16be)
+                          (cons 'rangeShift uint16be)
+                          ;(cons 'tables (make-object RArray TableEntry 'numTables))
+                          )))
+
 
 #;(define Directory (:seq ([tag hexbytes #:assert (curry equal? "/00 01 00 00")]
                            [numTables uint16be #:assert ]
@@ -21,12 +39,12 @@
     (Directory ip))
 
 
-#;(define ip (open-input-file "test/assets/Charter.ttf"))
+(module+ test
-#;(directory-decode ip (mhash '_startOffset 0))
+  (require rackunit)
-#;(module+ test
+  (define ip (open-input-file "test/assets/Charter.ttf"))
-    (require rackunit)
+  (define is (make-object RDecodeStream ip))
-    (define ip (open-input-file "test/assets/Charter.ttf"))
+  (send Directory decode is)
-    (check-equal?
+  #;(check-equal?
      (directory-decode ip (mhash '_startOffset 0))
      '((tag . "00 01 00 00")
        (numTables . 14)

pitfall/restructure/decodestream.rkt

@@ -18,10 +18,13 @@
                                 [endian '("" BE LE)])
                                (values (string->symbol (format "~a~a" key endian)) value))))
 
-
+(require racket/port)
 ;; basically just a wrapper for a Racket port
-(define-subclass object% (RDecodeStream [buffer #""])
+(define-subclass object% (RDecodeStream [buffer-in #""])
-  (field [length (bytes-length buffer)]
+  (field [buffer (if (input-port? buffer-in)
+                   (port->bytes buffer-in)
+                   buffer-in)]
+         [length (bytes-length buffer)]
          [_port (open-input-bytes buffer)])
   (getter-field [pos (port-position _port)])
 

pitfall/restructure/string.rkt

@@ -9,8 +9,8 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
 
 (define-subclass RStreamcoder (RString [length #f] [encoding 'ascii])
   (field [_codec (caseq encoding
-                        [(latin-1) (cons string->bytes/latin-1 bytes->string/latin-1)]
+                        [(latin-1 ascii) (cons string->bytes/latin-1 bytes->string/latin-1)]
-                        [(ascii utf-8 utf8)(cons string->bytes/utf-8 bytes->string/utf-8)])])
+                        [(utf-8 utf8)(cons string->bytes/utf-8 bytes->string/utf-8)])])
          
   (define/augment (decode stream [parent #f])
     (define count (if length

pitfall/restructure/struct.rkt

@@ -1,4 +1,5 @@
 #lang restructure/racket
+(require racket/dict)
 (provide (all-defined-out))
 
 #|
@@ -6,31 +7,36 @@ approximates
 https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
 |#
 
-(define-subclass RBase (RStruct [fields (mhash)])
+(define-subclass RBase (RStruct assocs)
+  (field [key-index (map car assocs)]
+         [fields (mhash)])
+  (for ([(k v) (in-dict assocs)])
+    (hash-set! fields k v))
 
   (define/override (decode stream [parent #f] [length 0])
     (define res (_setup stream parent length))
     (_parseFields stream res fields)
-    (hash-set! (hash-ref res '_props) '_currentOffset (· stream pos))
+    #;(hash-set! (hash-ref res '_props) '_currentOffset (· stream pos))
     res)
 
   (define/override (encode stream val [parent #f])
-    (for ([(key type) (in-hash fields)])
+    (for ([key (in-list key-index)])
-      (send type encode stream (hash-ref val key))))
+      (send (hash-ref fields key) encode stream (hash-ref val key))))
 
   (define/private (_setup stream parent length)
     (define res (mhasheq))
 
     ;; define hidden properties
-    (hash-set! res '_props
+    #;(hash-set! res '_props
                (mhasheq 'parent (mhasheq 'value parent)
-                      '_startOffset (mhasheq 'value (· stream pos))
+                        '_startOffset (mhasheq 'value (· stream pos))
-                      '_currentOffset (mhasheq 'value 0 'writable #t)
+                        '_currentOffset (mhasheq 'value 0 'writable #t)
-                      '_length (mhasheq 'value length)))
+                        '_length (mhasheq 'value length)))
     res)
 
   (define/private (_parseFields stream res field)
-    (for ([(key hashvalue) (in-hash fields)])
+    (for ([key (in-list key-index)])
+      (define hashvalue (hash-ref fields key))
       (define val
         (if (procedure? hashvalue)
             (hashvalue res)

pitfall/restructure/test.rkt

@@ -3,8 +3,8 @@
 
 (define Person
   (make-object RStruct
-    (mhash 'name (make-object RString uint8 'utf8)
+    (list (cons 'name (make-object RString uint8 'utf8))
-           'age uint8)))
+          (cons 'age uint8))))
 
 ;; decode a person from a buffer
 (define stream-in (make-object RDecodeStream #"\4MikeA"))