fleeze

pitfall/fontkit/directory.rkt

@@ -74,7 +74,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js
 ;; we don't know what tables we might get
 ;; so we represent as generic Buffer type,
 ;; and convert the tables to bytes manually in preEncode
-(define EncodableDirectory (+RDirectory (append directory-common-dict (list (cons 'data (+Array (+Buffer)))))))
+(define EncodableDirectory (+RDirectory (append directory-common-dict (list (cons 'data (+Array (+RBuffer)))))))
 
 (define (directory-decode ip [options (mhash)])
   (send Directory decode (+DecodeStream (port->bytes ip))))

pitfall/fontkit/glyf.rkt

@@ -8,7 +8,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/glyf.js
 
 (define-subclass Struct (Rglyf))
 
-(define glyf (+Array (+Buffer)))
+(define glyf (+Array (+RBuffer)))
 
 (test-module
  (define ip (open-input-file charter-path))

pitfall/restructure/buffer.rkt

@@ -9,10 +9,18 @@ https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee
 
 #|
 A Buffer is a container object for any data object that supports random access
+A Node Buffer object is basically a byte string.
+First argument must be a string, Buffer, ArrayBuffer, Array, or array-like object.
+A Restructure RBuffer object is separate.
 |#
 
+(define (+Buffer xs [type #f])
+  (cond
+    [(string? xs) (string->bytes/utf-8 xs)]
+    [else (list->bytes xs)]))
 
-(define-subclass RestructureBase (Buffer [length_ #xffff])
+
+(define-subclass RestructureBase (RBuffer [length_ #xffff])
   
   (define/override (decode stream [parent #f])
     (define length__ (utils-resolveLength length_ stream parent))
@@ -33,7 +41,6 @@ A Buffer is a container object for any data object that supports random access
       (send stream writeBuffer buf))))
 
 
-(define-subclass Buffer (BufferT))
 
 
 #;(test-module

pitfall/restructure/helper.rkt

@@ -8,4 +8,11 @@
       (require #,(datum->syntax caller-stx 'rackunit) #,(datum->syntax caller-stx 'racket/serialize))
       . EXPRS))
 
-(define index? (λ (x) (and (number? x) (integer? x) (not (negative? x)))))
+(define index? (λ (x) (and (number? x) (integer? x) (not (negative? x)))))
+
+(define (unsigned->signed uint bits)
+  (define most-significant-bit-mask (arithmetic-shift 1 (sub1 bits)))
+  (- (bitwise-xor uint most-significant-bit-mask) most-significant-bit-mask))
+
+(define (signed->unsigned sint bits)
+  (bitwise-and sint (arithmetic-shift 1 bits)))

pitfall/restructure/number.rkt

@@ -43,22 +43,15 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
            [delta (if _signed? 0 signed-min)])
       (values (- signed-min delta) (- signed-max delta))))
 
-  (define (unsigned->signed uint)
-    (define most-significant-bit-mask (arithmetic-shift 1 (sub1 bits)))
-    (- (bitwise-xor uint most-significant-bit-mask) most-significant-bit-mask))
-
-  (define (signed->unsigned sint)
-    (bitwise-and sint (arithmetic-shift 1 bits)))
-
   (define/augment (decode stream . args)
-    (define bstr (send stream read _size))
+    (define bstr (send stream readBuffer _size))
     (define bs ((if (eq? endian system-endian) identity reverse) (bytes->list bstr)))
     (define unsigned-int (for/sum ([(b i) (in-indexed bs)])
                            (arithmetic-shift b (* 8 i))))
     (post-decode unsigned-int))
 
   (define/public (post-decode unsigned-int)
-    ((if _signed? unsigned->signed identity) unsigned-int))
+    (if _signed? (unsigned->signed unsigned-int bits) unsigned-int))
 
   (define/public (pre-encode val-in)
     (exact-if-possible val-in))
@@ -80,7 +73,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
   (define byte-size (/ _size 8))
   
   (define/augment (decode stream . args) ;  convert int to float
-    (define bs (send stream read byte-size))
+    (define bs (send stream readBuffer byte-size))
     (floating-point-bytes->real bs (eq? endian 'be)))
 
   (define/augment (encode stream val-in) ; convert float to int

pitfall/restructure/stream-test.rkt

@@ -12,56 +12,114 @@ https://github.com/mbutterick/restructure/blob/master/test/DecodeStream.coffee
 ;    stream = new DecodeStream buf
 ;    stream.readBuffer(buf.length).should.deep.equal new Buffer [1,2,3]
 
-(define buf (+Buffer (bytes 1 2 3)))
-(define stream (+DecodeStream buf))
+(let ()
+  (define buf (+Buffer '(1 2 3)))
+  (define stream (+DecodeStream buf))
+  (check-equal? (send stream readBuffer (*length buf)) (+Buffer '(1 2 3))))
 
 ;
 ;  it 'should readUInt16BE', ->
 ;    buf = new Buffer [0xab, 0xcd]
 ;    stream = new DecodeStream buf
 ;    stream.readUInt16BE().should.deep.equal 0xabcd
+
+(let ()
+  (define buf (+Buffer '(#xab #xcd)))
+  (define stream (+DecodeStream buf))
+  (check-equal? (send stream readUInt16BE) #xabcd))
+
 ;
 ;  it 'should readUInt16LE', ->
 ;    buf = new Buffer [0xab, 0xcd]
 ;    stream = new DecodeStream buf
 ;    stream.readUInt16LE().should.deep.equal 0xcdab
+
+(let ()
+  (define buf (+Buffer '(#xab #xcd)))
+  (define stream (+DecodeStream buf))
+  (check-equal? (send stream readUInt16LE) #xcdab))
+
 ;
 ;  it 'should readUInt24BE', ->
 ;    buf = new Buffer [0xab, 0xcd, 0xef]
 ;    stream = new DecodeStream buf
 ;    stream.readUInt24BE().should.deep.equal 0xabcdef
+
+(let ()
+  (define buf (+Buffer '(#xab #xcd #xef)))
+  (define stream (+DecodeStream buf))
+  (check-equal? (send stream readUInt24BE) #xabcdef))
+
 ;
 ;  it 'should readUInt24LE', ->
 ;    buf = new Buffer [0xab, 0xcd, 0xef]
 ;    stream = new DecodeStream buf
 ;    stream.readUInt24LE().should.deep.equal 0xefcdab
+
+(let ()
+  (define buf (+Buffer '(#xab #xcd #xef)))
+  (define stream (+DecodeStream buf))
+  (check-equal? (send stream readUInt24LE) #xefcdab))
+
 ;
 ;  it 'should readInt24BE', ->
 ;    buf = new Buffer [0xff, 0xab, 0x24]
 ;    stream = new DecodeStream buf
 ;    stream.readInt24BE().should.deep.equal -21724
+
+(let ()
+  (define buf (+Buffer '(#xff #xab #x24)))
+  (define stream (+DecodeStream buf))
+  (check-equal? (send stream readInt24BE) -21724))
+
 ;
 ;  it 'should readInt24LE', ->
 ;    buf = new Buffer [0x24, 0xab, 0xff]
 ;    stream = new DecodeStream buf
 ;    stream.readInt24LE().should.deep.equal -21724
+
+(let ()
+  (define buf (+Buffer '(#x24 #xab #xff)))
+  (define stream (+DecodeStream buf))
+  (check-equal? (send stream readInt24LE) -21724))
+
 ;
 ;  describe 'readString', ->
 ;    it 'should decode ascii by default', ->
 ;      buf = new Buffer 'some text', 'ascii'
 ;      stream = new DecodeStream buf
 ;      stream.readString(buf.length).should.equal 'some text'
+
+(let ()
+  (define buf (+Buffer "some text" 'ascii))
+  (define stream (+DecodeStream buf))
+  (check-equal? (send stream readString (*length buf)) "some text"))
+
 ;
 ;    it 'should decode ascii', ->
 ;      buf = new Buffer 'some text', 'ascii'
 ;      stream = new DecodeStream buf
 ;      stream.readString(buf.length, 'ascii').should.equal 'some text'
+
+(let ()
+  (define buf (+Buffer "some text" 'ascii))
+  (define stream (+DecodeStream buf))
+  (check-equal? (send stream readString (*length buf) 'ascii) "some text"))
+
 ;
 ;    it 'should decode utf8', ->
 ;      buf = new Buffer 'unicode! 👍', 'utf8'
 ;      stream = new DecodeStream buf
 ;      stream.readString(buf.length, 'utf8').should.equal 'unicode! 👍'
-;
+
+(let ()
+  (define buf (+Buffer "unicode! 👍" 'utf8))
+  (define stream (+DecodeStream buf))
+  (check-equal? (send stream readString (*length buf) 'utf8) "unicode! 👍"))
+
+#|
+; todo: support freaky string encodings
+
 ;    it 'should decode utf16le', ->
 ;      buf = new Buffer 'unicode! 👍', 'utf16le'
 ;      stream = new DecodeStream buf
@@ -86,7 +144,17 @@ https://github.com/mbutterick/restructure/blob/master/test/DecodeStream.coffee
 ;      buf = new Buffer [0x8a, 0x63, 0x63, 0x65, 0x6e, 0x74, 0x65, 0x64, 0x20, 0x63, 0x68, 0x87, 0x72, 0x61, 0x63, 0x74, 0x65, 0x72, 0x73]
 ;      stream = new DecodeStream buf
 ;      stream.readString(buf.length, 'mac').should.equal 'äccented cháracters'
-;
+|#
+
+
+
+
 ;    it 'should return a buffer for unsupported encodings', ->
 ;      stream = new DecodeStream new Buffer [1, 2, 3]
-;      stream.readString(3, 'unsupported').should.deep.equal new Buffer [1, 2, 3]
+;      stream.readString(3, 'unsupported').should.deep.equal new Buffer [1, 2, 3]
+
+
+(let ()
+  (define buf (+Buffer '(1 2 3)))
+  (define stream (+DecodeStream buf))
+  (check-equal? (send stream readString 3 'unsupported) (+Buffer '(1 2 3))))

pitfall/restructure/stream.rkt

@@ -39,23 +39,23 @@ https://github.com/mbutterick/restructure/blob/master/src/EncodeStream.coffee
   (define/public-final (writeBuffer buffer)
     (write buffer)))
 
-(test-module
- (define es (+EncodeStream))
- (check-true (EncodeStream? es))
- (send es write #"AB")
- (check-equal? (· es pos) 2)
- (send es write #"C")
- (check-equal? (· es pos) 3)
- (send es write #"D")
- (check-equal? (· es pos) 4)
- (check-exn exn:fail? (λ () (send es write -42)))
- (check-exn exn:fail? (λ () (send es write 1)))
- (define op (open-output-bytes))
- (define es2 (+EncodeStream op))
- (send es2 write #"FOOBAR")
- (check-equal? (send es2 dump) #"FOOBAR")
- (check-equal? (send es2 dump) #"FOOBAR") ; dump can repeat
- (check-equal? (get-output-bytes op) #"FOOBAR"))
+#;(test-module
+   (define es (+EncodeStream))
+   (check-true (EncodeStream? es))
+   (send es write #"AB")
+   (check-equal? (· es pos) 2)
+   (send es write #"C")
+   (check-equal? (· es pos) 3)
+   (send es write #"D")
+   (check-equal? (· es pos) 4)
+   (check-exn exn:fail? (λ () (send es write -42)))
+   (check-exn exn:fail? (λ () (send es write 1)))
+   (define op (open-output-bytes))
+   (define es2 (+EncodeStream op))
+   (send es2 write #"FOOBAR")
+   (check-equal? (send es2 dump) #"FOOBAR")
+   (check-equal? (send es2 dump) #"FOOBAR") ; dump can repeat
+   (check-equal? (get-output-bytes op) #"FOOBAR"))
 
 
 #| approximates
@@ -64,47 +64,71 @@ https://github.com/mbutterick/restructure/blob/master/src/DecodeStream.coffee
 
 ;; basically just a wrapper for a Racket port
 ;; but needs to start with a buffer so length can be found
+
+(require "sizes.rkt")
+(define-macro (define-reader ID)
+  #'(define/public (ID)
+      (define bs (*ref type-sizes (string->symbol (string-downcase (string-replace (symbol->string 'ID) "read" "")))))
+      (readBuffer bs)))
+
 (define-subclass* PortWrapper (DecodeStream [buffer #""])
-  (unless (bytes? buffer)
+  (unless (bytes? buffer) ; corresponds to a Node Buffer, not a restructure BufferT object
     (raise-argument-error 'DecodeStream:constructor "bytes" buffer))
-
   (super-make-object (open-input-bytes buffer))
   (inherit-field _port)
-  
-  (getter-field [length (bytes-length buffer)])
 
-  (define/override-final (dump)
-    (define current-position (port-position _port))
-    (set-port-position! _port 0)
-    (define bs (port->bytes _port))
-    (set-port-position! _port current-position)
-    bs)
+  (field [pos 0]
+         [length (*length buffer)])
 
-  (define/public-final (readUInt8) (read 1))
-  (define/public-final (readInt8) (read 1))
+  (define/public (readString length [encoding 'ascii])
+    (define proc (caseq encoding
+                        [(utf16le) (error 'bah)]
+                        [(ucs2) (error 'bleh)]
+                        [(utf8) bytes->string/utf-8]
+                        [(ascii) bytes->string/latin-1]
+                        [else identity]))
+    (proc (subbytes buffer pos (increment-field! pos this length))))
 
-  (define/public-final (read count)
+  (define/public-final (readBuffer count)
     (unless (index? count)
       (raise-argument-error 'DecodeStream:read "positive integer" count))
     (define bytes-remaining (- length (port-position _port)))
     (when (> count bytes-remaining)
       (raise-argument-error 'DecodeStream:read (format "byte count not more than bytes remaining = ~a" bytes-remaining) count))
-    (read-bytes count _port))
+    (increment-field! pos this count)
+    (define bs (read-bytes count _port))
+    (unless (= pos (file-position _port)) (raise-result-error 'DecodeStream "positions askew" (list pos (file-position _port))))
+    bs)
 
-  (define/public-final (readBuffer count)
-    (read count)))
+  (define/public (read count) (readBuffer count))
+
+  (define/public (readUInt8) (bytes-ref (readBuffer 1) 0))
+  (define/public (readUInt16BE) (+ (arithmetic-shift (readUInt8) 8) (readUInt8)))
+  (define/public (readInt16BE) (unsigned->signed (readUInt16BE) 16))
+  (define/public (readUInt16LE) (+ (readUInt8) (arithmetic-shift (readUInt8) 8)))
+  (define/public (readUInt24BE) (+ (arithmetic-shift (readUInt16BE) 8) (readUInt8)))
+  (define/public (readUInt24LE) (+ (readUInt16LE) (arithmetic-shift (readUInt8) 16)))
+  (define/public (readInt24BE) (unsigned->signed (readUInt24BE) 24))
+  (define/public (readInt24LE) (unsigned->signed (readUInt24LE) 24))
+  
+  (define/override-final (dump)
+    (define current-position (port-position _port))
+    (set-port-position! _port 0)
+    (define bs (port->bytes _port))
+    (set-port-position! _port current-position)
+    bs))
 
 (test-module
  (define ds (+DecodeStream #"ABCD"))
  (check-true (DecodeStream? ds))
  (check-equal? (send ds dump) #"ABCD")
  (check-equal? (send ds dump) #"ABCD") ; dump can repeat
- (check-equal? (send ds read 2) #"AB")
+ (check-equal? (send ds readUInt16BE) 16706)
  (check-equal? (send ds dump) #"ABCD")
  (check-equal? (· ds pos) 2)
- (check-equal? (send ds read 1) #"C")
+ (check-equal? (send ds readUInt8) 67)
  (check-equal? (· ds pos) 3)
- (check-equal? (send ds read 1) #"D")
+ (check-equal? (send ds readUInt8) 68)
  (check-equal? (· ds pos) 4)
  (check-exn exn:fail? (λ () (send ds read -42)))
  (check-exn exn:fail? (λ () (send ds read 1))))

pitfall/restructure/utils.rkt

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