From 6ae7b647757f905b234a6286c3182b799c306da2 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 23 Jun 2017 16:55:25 -0700 Subject: [PATCH] fleeze --- pitfall/fontkit/directory.rkt | 2 +- pitfall/fontkit/glyf.rkt | 2 +- pitfall/restructure/buffer.rkt | 11 +++- pitfall/restructure/helper.rkt | 9 ++- pitfall/restructure/number.rkt | 13 +--- pitfall/restructure/stream-test.rkt | 78 +++++++++++++++++++++-- pitfall/restructure/stream.rkt | 96 ++++++++++++++++++----------- pitfall/restructure/utils.rkt | 16 ++--- 8 files changed, 164 insertions(+), 63 deletions(-) diff --git a/pitfall/fontkit/directory.rkt b/pitfall/fontkit/directory.rkt index 812cdad5..0f4a79dc 100644 --- a/pitfall/fontkit/directory.rkt +++ b/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)))) diff --git a/pitfall/fontkit/glyf.rkt b/pitfall/fontkit/glyf.rkt index fe2b9ad8..e993f398 100644 --- a/pitfall/fontkit/glyf.rkt +++ b/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)) diff --git a/pitfall/restructure/buffer.rkt b/pitfall/restructure/buffer.rkt index c0ebc2bf..6686962e 100644 --- a/pitfall/restructure/buffer.rkt +++ b/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 diff --git a/pitfall/restructure/helper.rkt b/pitfall/restructure/helper.rkt index 8f68c134..de983a1b 100644 --- a/pitfall/restructure/helper.rkt +++ b/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))))) \ No newline at end of file +(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))) \ No newline at end of file diff --git a/pitfall/restructure/number.rkt b/pitfall/restructure/number.rkt index b66b33e7..baccab3f 100644 --- a/pitfall/restructure/number.rkt +++ b/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 diff --git a/pitfall/restructure/stream-test.rkt b/pitfall/restructure/stream-test.rkt index 1dcaa251..31e473d2 100644 --- a/pitfall/restructure/stream-test.rkt +++ b/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] \ No newline at end of file +; 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)))) \ No newline at end of file diff --git a/pitfall/restructure/stream.rkt b/pitfall/restructure/stream.rkt index 8d9db7dc..c5b4a250 100644 --- a/pitfall/restructure/stream.rkt +++ b/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)))) diff --git a/pitfall/restructure/utils.rkt b/pitfall/restructure/utils.rkt index 6e25570e..eed52d49 100644 --- a/pitfall/restructure/utils.rkt +++ b/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)])) \ No newline at end of file +(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) \ No newline at end of file