array test

pitfall/pitfall/directory.rkt

@@ -4,65 +4,45 @@
 (provide (all-defined-out))
 
 
-
-
 (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
-                          (list (cons 'tag (RString 4))
-                                (cons 'checkSum uint32be)
-                                (cons 'offset 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 ]
-                           [searchRange uint16be]
-                           [entrySelector uint16be]
-                           [rangeShift uint16be]
-                           [tables (:repeat numTables TableEntry)])))
-
-#;(define (directory-decode ip [options (mhash)])
-    (Directory ip))
-
+                          ;; todo next: derive the `14` from 'numTables
+                          (cons 'tables (make-object RArray TableEntry 14)))))
 
 (module+ test
   (require rackunit)
   (define ip (open-input-file "test/assets/Charter.ttf"))
   (define is (make-object RDecodeStream ip))
-  (send Directory decode is)
-  #;(check-equal?
-     (directory-decode ip (mhash '_startOffset 0))
-     '((tag . "00 01 00 00")
-       (numTables . 14)
-       (searchRange . 128)
-       (entrySelector . 3)
-       (rangeShift . 96)
-       (tables
-        ((tag . "OS/2") (checkSum . 2351070438) (offset . 360) (length . 96))
-        ((tag . "VDMX") (checkSum . 1887795202) (offset . 1372) (length . 1504))
-        ((tag . "cmap") (checkSum . 1723761408) (offset . 2876) (length . 1262))
-        ((tag . "cvt ") (checkSum . 10290865) (offset . 4592) (length . 26))
-        ((tag . "fpgm") (checkSum . 106535991) (offset . 4140) (length . 371))
-        ((tag . "glyf") (checkSum . 1143629849) (offset . 4620) (length . 34072))
-        ((tag . "head") (checkSum . 4281190895) (offset . 236) (length . 54))
-        ((tag . "hhea") (checkSum . 132056097) (offset . 292) (length . 36))
-        ((tag . "hmtx") (checkSum . 3982043058) (offset . 456) (length . 916))
-        ((tag . "loca") (checkSum . 2795817194) (offset . 38692) (length . 460))
-        ((tag . "maxp") (checkSum . 50135594) (offset . 328) (length . 32))
-        ((tag . "name") (checkSum . 2629707307) (offset . 39152) (length . 2367))
-        ((tag . "post") (checkSum . 1670855689) (offset . 41520) (length . 514))
-        ((tag . "prep") (checkSum . 490862356) (offset . 4512) (length . 78))))))
+  (check-equal?
+   (send Directory decode is)
+   (make-hasheq
+    (list (cons 'tables
+                (list (make-hasheq '((length . 96) (checkSum . 2351070438) (offset . 360) (tag . "OS/2")))
+                      (make-hasheq '((length . 1504) (checkSum . 1887795202) (offset . 1372) (tag . "VDMX")))
+                      (make-hasheq '((length . 1262) (checkSum . 1723761408) (offset . 2876) (tag . "cmap")))
+                      (make-hasheq '((length . 26) (checkSum . 10290865) (offset . 4592) (tag . "cvt ")))
+                      (make-hasheq '((length . 371) (checkSum . 106535991) (offset . 4140) (tag . "fpgm")))
+                      (make-hasheq '((length . 34072) (checkSum . 1143629849) (offset . 4620) (tag . "glyf")))
+                      (make-hasheq '((length . 54) (checkSum . 4281190895) (offset . 236) (tag . "head")))
+                      (make-hasheq '((length . 36) (checkSum . 132056097) (offset . 292) (tag . "hhea")))
+                      (make-hasheq '((length . 916) (checkSum . 3982043058) (offset . 456) (tag . "hmtx")))
+                      (make-hasheq '((length . 460) (checkSum . 2795817194) (offset . 38692) (tag . "loca")))
+                      (make-hasheq '((length . 32) (checkSum . 50135594) (offset . 328) (tag . "maxp")))
+                      (make-hasheq '((length . 2367) (checkSum . 2629707307) (offset . 39152) (tag . "name")))
+                      (make-hasheq '((length . 514) (checkSum . 1670855689) (offset . 41520) (tag . "post")))
+                      (make-hasheq '((length . 78) (checkSum . 490862356) (offset . 4512) (tag . "prep")))))
+          (cons 'entrySelector 3)
+          (cons 'numTables 14)
+          (cons 'searchRange 128)
+          (cons 'rangeShift 96)
+          (cons 'tag "\u0000\u0001\u0000\u0000")))))

pitfall/restructure/array.rkt

@@ -0,0 +1,33 @@
+#lang restructure/racket
+(require "number.rkt" "utils.rkt" "streamcoder.rkt")
+(provide RArray)
+
+#|
+approximates
+https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
+|#
+
+(define-subclass RStreamcoder (RArray type [length #f] [lengthType 'count])
+  
+         
+  (define/augment (decode stream [parent #f])
+    (caseq lengthType
+           [(count) (for/list ([i (in-range length)])
+                              (send type decode stream this))]))
+
+  (define/public (size) (unfinished))
+
+  (define/augment (encode stream array [parent #f])
+    (for ([item (in-list array)])
+         (send type encode stream item))))
+
+
+(test-module
+ (require "decodestream.rkt" "encodestream.rkt")
+ (define stream (make-object RDecodeStream #"ABCDEFG"))
+   
+ (define A (make-object RArray uint16be 3))
+ (check-equal? (send A decode stream) '(16706 17220 17734))
+ (define os (make-object REncodeStream))
+ (send A encode os '(16706 17220 17734))
+ (check-equal? (send os dump) #"ABCDEF"))

pitfall/restructure/main.rkt

@@ -3,5 +3,6 @@
 (r+p "number.rkt"
      "struct.rkt"
      "string.rkt"
+     "array.rkt"
      "decodestream.rkt"
      "encodestream.rkt")

pitfall/restructure/number.rkt

@@ -11,12 +11,12 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
   (define str (symbol->string type))
   (equal? (substring str (sub1 (string-length str))) "8"))
 
-(define (unsigned-type? type)
-  (equal? "U" (substring (symbol->string type) 0 1)))
+(define (signed-type? type)
+  (not (equal? "U" (substring (symbol->string type) 0 1))))
 
 (test-module
- (check-true (unsigned-type? 'UInt16))
- (check-false (unsigned-type? 'Int16)))
+ (check-false (signed-type? 'UInt16))
+ (check-true (signed-type? 'Int16)))
 
 (define-subclass RStreamcoder (Number [type 'UInt16] [endian (if (system-big-endian?) 'BE 'LE)])
   (getter-field [fn (string->symbol (format "~a~a" type (if (ends-with-8? type) "" endian)))])
@@ -30,13 +30,13 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
     (define bstr (send stream read size))
     (if (= 1 size)
         (bytes-ref bstr 0)
-        (integer-bytes->integer bstr (unsigned-type? type) (eq? endian 'BE))))
+        (integer-bytes->integer bstr (signed-type? type) (eq? endian 'BE))))
 
   (define/augment (encode stream val)
     (define bstr
       (if (= 1 size)
           (bytes val)
-          (integer->integer-bytes val size (unsigned-type? type) (eq? endian 'BE))))
+          (integer->integer-bytes val size (signed-type? type) (eq? endian 'BE))))
     (if stream (send stream write bstr) bstr)))
     
 
@@ -90,3 +90,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
  (check-equal? (send uint32 size) 4)
  (check-equal? (send double size) 8))
 
+
+(require "encodestream.rkt")
+(define n (make-object Number 'UInt32))
+(send n encode (make-object REncodeStream) 2351070438)

pitfall/restructure/string.rkt

@@ -25,7 +25,9 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
     (when (is-a? length Number) ;; length-prefixed string
       (send length encode stream (bytes-length bytes)))
     
-    (send stream write bytes)))
+    (send stream write bytes))
+
+  (define/public (size) (unfinished)))
 
 
 (test-module