From 7f32bfbc861e4d85ac44db5d349d64ac03b549d3 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 8 Jun 2017 12:17:11 -0700 Subject: [PATCH] progress on directory --- pitfall/pitfall/directory.rkt | 40 ++++++++++++++++++++-------- pitfall/restructure/decodestream.rkt | 9 ++++--- pitfall/restructure/string.rkt | 4 +-- pitfall/restructure/struct.rkt | 24 ++++++++++------- pitfall/restructure/test.rkt | 4 +-- 5 files changed, 54 insertions(+), 27 deletions(-) diff --git a/pitfall/pitfall/directory.rkt b/pitfall/pitfall/directory.rkt index 146f5a10..0382a8fc 100644 --- a/pitfall/pitfall/directory.rkt +++ b/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) - 'checkSum uint32be - 'offset uint32be - 'length uint32be)) + (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 ] @@ -21,12 +39,12 @@ (Directory ip)) -#;(define ip (open-input-file "test/assets/Charter.ttf")) -#;(directory-decode ip (mhash '_startOffset 0)) -#;(module+ test - (require rackunit) - (define ip (open-input-file "test/assets/Charter.ttf")) - (check-equal? +(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) diff --git a/pitfall/restructure/decodestream.rkt b/pitfall/restructure/decodestream.rkt index efc3524a..d8189104 100644 --- a/pitfall/restructure/decodestream.rkt +++ b/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 #""]) - (field [length (bytes-length buffer)] +(define-subclass object% (RDecodeStream [buffer-in #""]) + (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)]) diff --git a/pitfall/restructure/string.rkt b/pitfall/restructure/string.rkt index ee87f6e6..54afdac1 100644 --- a/pitfall/restructure/string.rkt +++ b/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)] - [(ascii utf-8 utf8)(cons string->bytes/utf-8 bytes->string/utf-8)])]) + [(latin-1 ascii) (cons string->bytes/latin-1 bytes->string/latin-1)] + [(utf-8 utf8)(cons string->bytes/utf-8 bytes->string/utf-8)])]) (define/augment (decode stream [parent #f]) (define count (if length diff --git a/pitfall/restructure/struct.rkt b/pitfall/restructure/struct.rkt index 9f804cc0..bd4a1fcc 100644 --- a/pitfall/restructure/struct.rkt +++ b/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)]) - (send type encode stream (hash-ref val key)))) + (for ([key (in-list key-index)]) + (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)) - '_currentOffset (mhasheq 'value 0 'writable #t) - '_length (mhasheq 'value length))) + '_startOffset (mhasheq 'value (· stream pos)) + '_currentOffset (mhasheq 'value 0 'writable #t) + '_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) diff --git a/pitfall/restructure/test.rkt b/pitfall/restructure/test.rkt index ebea3903..abd8b6c8 100644 --- a/pitfall/restructure/test.rkt +++ b/pitfall/restructure/test.rkt @@ -3,8 +3,8 @@ (define Person (make-object RStruct - (mhash 'name (make-object RString uint8 'utf8) - 'age uint8))) + (list (cons 'name (make-object RString uint8 'utf8)) + (cons 'age uint8)))) ;; decode a person from a buffer (define stream-in (make-object RDecodeStream #"\4MikeA"))