From e29bb8dda88c1b1f76488fe5414c66fb66f3481a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 12 Jun 2017 23:23:07 -0700 Subject: [PATCH] next: simulate parent --- pitfall/fontkit/hmtx.rkt | 23 +++++++++++--- pitfall/restructure/array.rkt | 58 ++++++++++++++++++++++++++++++++-- pitfall/restructure/stream.rkt | 5 ++- pitfall/restructure/utils.rkt | 12 +++---- 4 files changed, 83 insertions(+), 15 deletions(-) diff --git a/pitfall/fontkit/hmtx.rkt b/pitfall/fontkit/hmtx.rkt index 79e5f304..798ecbf7 100644 --- a/pitfall/fontkit/hmtx.rkt +++ b/pitfall/fontkit/hmtx.rkt @@ -9,14 +9,27 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/hmtx.js (define-subclass Struct (Rhmtx)) (define HmtxEntry (make-object Struct - (dictify - 'advance uint16be - 'bearing uint16be))) + (dictify + 'advance uint16be + 'bearing uint16be))) (define hmtx (make-object Rhmtx (dictify - 'metrics uint16be - 'bearing uint16be))) + 'metrics (+LazyArray HmtxEntry (λ (t) (hash-ref (send (· t parent) _getTable 'hhea) 'numberOfMetrics))) + 'bearing (+LazyArray int16be (λ (t) (- (hash-ref (send (· t parent) _getTable 'maxp) 'numGlyphs) + (hash-ref (send (· t parent) _getTable 'hhea) 'numberOfMetrics))))))) + +(test-module + (define ip (open-input-file charter-path)) + (define dir (deserialize (read (open-input-file charter-directory-path)))) + (define hmtx-offset (· dir tables hmtx offset)) + (define hmtx-length (· dir tables hmtx length)) + (check-equal? hmtx-offset 456) + (check-equal? hmtx-length 916) + (define hmtx-bytes (peek-bytes hmtx-length hmtx-offset ip)) + (define hmtx-data (send hmtx decode (+DecodeStream hmtx-bytes))) + (check-equal? (· maxp-data numGlyphs) 229) + (check-equal? (· maxp-data version) 65536)) (test-module diff --git a/pitfall/restructure/array.rkt b/pitfall/restructure/array.rkt index 86816fe5..8e6e9837 100644 --- a/pitfall/restructure/array.rkt +++ b/pitfall/restructure/array.rkt @@ -9,7 +9,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee (define-subclass Streamcoder (Array type [_length #f] [lengthType 'count]) - (define/augment (decode stream [parent #f]) + (define/augride (decode stream [parent #f]) (let ([len (cond ;; explicit length [_length (resolveLength _length stream parent)] @@ -28,7 +28,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee (unless (list? array) (raise-argument-error 'Array:size "list" array)) (* (send type size) (length array))) - (define/augment (encode stream array [parent #f]) + (define/augride (encode stream array [parent #f]) (unless (list? array) (raise-argument-error 'Array:encode "list" array)) (for ([item (in-list array)]) (send type encode stream item)))) @@ -44,4 +44,56 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee (check-equal? (send os dump) #"ABCDEF") (check-equal? (send (+Array uint16be) size '(1 2 3)) 6) - (check-equal? (send (+Array doublebe) size '(1 2 3 4 5)) 40)) \ No newline at end of file + (check-equal? (send (+Array doublebe) size '(1 2 3 4 5)) 40)) + +#| +approximates +https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee +|# + +(define-subclass object% (InnerLazyArray type [_length #f] [stream #f] [ctx #f]) + (field [base (· stream pos)] + [items (mhash)]) ; implement with hash (random add) rather than array + + (define/public-final (get index) + (when (or (< index 0) (<= _length index)) + (raise-argument-error 'InnerLazyArray:get (format "non-negative index less than length ~a of array" _length) index)) + (hash-ref! items index (λ () + (define stashed-pos (· stream pos)) + (send stream pos (+ base (* index (send type size)))) + (define new-val (send type decode stream ctx)) + (send stream pos stashed-pos) + new-val))) + + (define/public-final (toArray) + (for/list ([i (in-range _length)]) + (get i)))) + +(define-subclass Array (LazyArray) + (inherit-field _length type) + (define/override (decode stream [parent #f]) + (define len (resolveLength _length stream parent)) + (define res (+InnerLazyArray type len stream parent)) + (send stream pos (+ (· stream pos) (* _length (send type size)))) ; skip the bytes that LazyArray would occupy + res) + + (define/override (size val) + (super size (if (InnerLazyArray? val) + (send val toArray) + val))) + + (define/override (encode stream val) + (super encode (if (InnerLazyArray? val) + (send val toArray) + val)))) + +(test-module + (define bstr #"ABCD1234") + (define ds (+DecodeStream bstr)) + (define la (+LazyArray uint8 4)) +(define ila (send la decode ds)) +(check-equal? (send ds pos) 4) +(check-equal? (send ila get 1) 66) +(check-equal? (send ila get 3) 68) +(check-equal? (send ds pos) 4) +(check-equal? (send ila toArray) '(65 66 67 68))) diff --git a/pitfall/restructure/stream.rkt b/pitfall/restructure/stream.rkt index 2fea4003..b9abf8e5 100644 --- a/pitfall/restructure/stream.rkt +++ b/pitfall/restructure/stream.rkt @@ -5,7 +5,10 @@ (define-subclass object% (PortWrapper _port) (unless (port? _port) (raise-argument-error 'PortWrapper:constructor "port" _port)) - (define/public-final (pos) (port-position _port)) + (define/public-final (pos [where #f]) + (when where + (set-port-position! _port where)) + (port-position _port)) (define/public (dump) (void))) (test-module diff --git a/pitfall/restructure/utils.rkt b/pitfall/restructure/utils.rkt index 5b2a8c1d..aa60797f 100644 --- a/pitfall/restructure/utils.rkt +++ b/pitfall/restructure/utils.rkt @@ -2,10 +2,10 @@ (provide (all-defined-out)) (require "number.rkt") -(define (resolveLength length stream parent) +(define (resolveLength _length stream parent) (cond - [(number? length) length] - [(procedure? length) (length parent)] - [(and parent (symbol? length) (hash-ref parent length))] ; treat as key into RStruct parent - [(and stream (is-a? length Number) (send length decode stream))] - [else (raise-argument-error 'resolveLength "fixed-size item" length)])) \ No newline at end of file + [(number? _length) _length] + [(procedure? _length) (_length parent)] + [(and parent (symbol? _length) (hash-ref parent _length))] ; treat as key into RStruct parent + [(and stream (is-a? _length Number) (send _length decode stream))] + [else (raise-argument-error 'resolveLength "fixed-size item" _length)])) \ No newline at end of file