From 98550e43f2418c7c0c0c0699b0a70553c0075c70 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 22 Jun 2017 16:28:18 -0700 Subject: [PATCH] conflicts between ctx and ctx res --- pitfall/fontkit/GPOS-test.coffee | 1 + pitfall/fontkit/GPOS-test.rkt | 2 +- pitfall/fontkit/GPOS.rkt | 12 ++++---- pitfall/fontkit/opentype.rkt | 22 +++++++++----- pitfall/restructure/array.rkt | 2 +- pitfall/restructure/base.rkt | 4 +-- pitfall/restructure/buffer.rkt | 2 +- pitfall/restructure/pointer-test.rkt | 43 ++++++++++++++-------------- pitfall/restructure/pointer.rkt | 27 ++++++++++------- pitfall/restructure/stream.rkt | 2 +- pitfall/restructure/struct.rkt | 9 +++++- pitfall/sugar/js.rkt | 35 ++++++++++++++++++---- 12 files changed, 105 insertions(+), 56 deletions(-) diff --git a/pitfall/fontkit/GPOS-test.coffee b/pitfall/fontkit/GPOS-test.coffee index 474c3c59..b1c60820 100644 --- a/pitfall/fontkit/GPOS-test.coffee +++ b/pitfall/fontkit/GPOS-test.coffee @@ -2,6 +2,7 @@ fontkit = require '../pdfkit/node_modules/fontkit' fira_path = "../pitfall/test/assets/fira.ttf" f = fontkit.openSync(fira_path) +console.log "*************************** start decode" thing = f.GPOS.lookupList.get(0) console.log thing diff --git a/pitfall/fontkit/GPOS-test.rkt b/pitfall/fontkit/GPOS-test.rkt index 4fa921b5..7e5f93b1 100644 --- a/pitfall/fontkit/GPOS-test.rkt +++ b/pitfall/fontkit/GPOS-test.rkt @@ -5,4 +5,4 @@ (define f (openSync fira-path)) (report 'start-decode) (define gpos (send GPOS decode (send f _getTableStream 'GPOS))) -;gpos +gpos diff --git a/pitfall/fontkit/GPOS.rkt b/pitfall/fontkit/GPOS.rkt index 15a957c5..8089059c 100644 --- a/pitfall/fontkit/GPOS.rkt +++ b/pitfall/fontkit/GPOS.rkt @@ -20,7 +20,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/GPOS.js 'xAdvDevice uint16be ;; pointer 'yAdvDevice uint16be)) ;; pointer -(define-subclass RestructureBase (ValueRecord [key 'valueFormat]) +(define-subclass object% (ValueRecord [key 'valueFormat]) (define/public (buildStruct parent) ;; set `struct` to the first Struct object in the chain of ancestors ;; with the target key @@ -40,15 +40,15 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/GPOS.js (cons key (dict-ref types key))))) (+Struct fields)))) - (define/override (size val ctx) + (define/public (size val ctx) (send (buildStruct ctx) size val ctx)) - (define/augride (decode stream parent) + (define/public (decode stream parent) (define res (send (buildStruct parent) decode stream parent)) (hash-remove! res 'rel) res) - (define/override (encode . args) + (define/public (encode . args) (error 'GPOS-encode-not-implemented))) (define PairValueRecord (+Struct @@ -190,8 +190,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/GPOS.js 'lookupList (+Pointer uint16be (LookupList GPOSLookup)) )) -(define-subclass VersionedStruct (GPOS-VersionedStruct)) -(define GPOS (+GPOS-VersionedStruct uint32be +(define-subclass VersionedStruct (GPOS-MainVersionedStruct)) +(define GPOS (+GPOS-MainVersionedStruct uint32be (dictify #x00010000 gpos-common-dict ;; ignore variations diff --git a/pitfall/fontkit/opentype.rkt b/pitfall/fontkit/opentype.rkt index 3dca8cf6..536c1e40 100644 --- a/pitfall/fontkit/opentype.rkt +++ b/pitfall/fontkit/opentype.rkt @@ -6,25 +6,31 @@ ;; Scripts and Languages # ;;######################## +(define-subclass Array (FeatIdxArray)) + (define LangSysTable (+Struct (dictify 'reserved uint16be 'reqFeatureIndex uint16be 'featureCount uint16be - 'featureIndexes (+Array uint16be 'featureCount)))) + 'featureIndexes (+FeatIdxArray uint16be 'featureCount)))) +(define-subclass Pointer (LSR-Pointer)) (define LangSysRecord (+Struct (dictify 'tag (+String 4) - 'langSys (+Pointer uint16be LangSysTable 'parent)))) + 'langSys (+LSR-Pointer uint16be LangSysTable 'parent)))) +(define-subclass Pointer (DLS-Pointer)) +(define-subclass Array (DLS-Array)) (define Script (+Struct - (dictify 'defaultLangSys (+Pointer uint16be LangSysTable) + (dictify 'defaultLangSys (+DLS-Pointer uint16be LangSysTable) 'count uint16be - 'langSysRecords (+Array LangSysRecord 'count)))) + 'langSysRecords (+DLS-Array LangSysRecord 'count)))) (define-subclass Struct (ScriptRecord-Struct)) +(define-subclass Pointer (ScriptRecord-Pointer)) (define ScriptRecord (+ScriptRecord-Struct (dictify 'tag (+String 4) - 'script (+Pointer uint16be Script 'parent)))) + 'script (+ScriptRecord-Pointer uint16be Script 'parent)))) (define ScriptList (+Array ScriptRecord uint16be)) @@ -38,9 +44,11 @@ 'lookupCount uint16be 'lookupListIndexes (+Array uint16be 'lookupCount)))) -(define FeatureRecord (+Struct (dictify +(define-subclass Struct (FeatureRec)) +(define-subclass Pointer (FeatureRec-Pointer)) +(define FeatureRecord (+FeatureRec (dictify 'tag (+String 4) - 'feature (+Pointer uint16be Feature 'parent)))) + 'feature (+FeatureRec-Pointer uint16be Feature 'parent)))) (define FeatureList (+Array FeatureRecord uint16be)) diff --git a/pitfall/restructure/array.rkt b/pitfall/restructure/array.rkt index f6cee028..d8aea450 100644 --- a/pitfall/restructure/array.rkt +++ b/pitfall/restructure/array.rkt @@ -21,7 +21,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee (unless (andmap (λ (x) (and x (number? x))) (list num denom)) (raise-argument-error 'Array:decode "valid length and size" (list num denom))) (floor (/ (send stream length) (send type size)))])) - (report* length_ (Number? length_)) + (when (Number? length_) (set-field! parent ctx parent) (set-field! _startOffset ctx pos) diff --git a/pitfall/restructure/base.rkt b/pitfall/restructure/base.rkt index 9e5946b9..278dd079 100644 --- a/pitfall/restructure/base.rkt +++ b/pitfall/restructure/base.rkt @@ -9,10 +9,10 @@ [_currentOffset #f] [_length #f] [parent #f]) - (define/pubment (decode stream . args) + (define/public (decode stream . args) (set! _startOffset (and (object? stream) (send stream pos))) (set! parent (and (pair? args) (is-a? (car args) RestructureBase) (car args))) - (inner (void) decode stream . args)) + #;(inner (void) decode stream . args)) (define/public (encode . xs) (void)) (define/public (size . xs) (void)) (define/public (process . args) (void)) diff --git a/pitfall/restructure/buffer.rkt b/pitfall/restructure/buffer.rkt index 1fb92871..9f8c9aa1 100644 --- a/pitfall/restructure/buffer.rkt +++ b/pitfall/restructure/buffer.rkt @@ -8,7 +8,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee |# (define-subclass RestructureBase (Buffer [length_ #xffff]) - (define/augride (decode stream [parent #f]) + (define/override (decode stream [parent #f]) (define len (resolveLength length_ stream parent)) (send stream readBuffer len)) diff --git a/pitfall/restructure/pointer-test.rkt b/pitfall/restructure/pointer-test.rkt index 166747b4..566aa779 100644 --- a/pitfall/restructure/pointer-test.rkt +++ b/pitfall/restructure/pointer-test.rkt @@ -9,39 +9,40 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee ;; it 'should handle null pointers', -> (let ([stream (+DecodeStream (bytes 0))] [pointer (+Pointer uint8 uint8)]) - (define ctx (make-object RestructureBase)) - (set-field! _startOffset ctx 50) - (check-exn exn:fail? (λ () (send pointer decode stream ctx)))) + (check-exn exn:fail? (λ () (send pointer decode stream (mhash '_startOffset 50))))) ;; it 'should use local offsets from start of parent by default', -> (let ([stream (+DecodeStream (bytes 1 53))] [pointer (+Pointer uint8 uint8)]) - (define ctx (make-object RestructureBase)) - (set-field! _startOffset ctx 0) - (check-equal? (send pointer decode stream ctx) 53)) + (check-equal? (send pointer decode stream (mhash '_startOffset 0)) 53)) -;; todo ;; it 'should support immediate offsets', -> -#;(let ([stream (+DecodeStream (bytes 1 53))] - [pointer (+Pointer uint8 uint8 'immediate)]) - (check-equal? (send pointer decode stream) 53)) +(let ([stream (+DecodeStream (bytes 1 53))] + [pointer (+Pointer uint8 uint8 'immediate)]) + (check-equal? (send pointer decode stream) 53)) ;; it 'should support offsets relative to the parent', -> (let ([stream (+DecodeStream (bytes 0 0 1 53))] [pointer (+Pointer uint8 uint8 'parent)]) (send stream pos 2) - (define ctx-parent (make-object RestructureBase)) - (set-field! _startOffset ctx-parent 2) - (define ctx (make-object RestructureBase)) - (set-field! parent ctx ctx-parent) - (check-equal? (send pointer decode stream ctx) 53)) + (check-equal? (send pointer decode stream (mhash 'parent (mhash '_startOffset 2))) 53)) ;; it 'should support global offsets', -> -#;(let ([stream (+DecodeStream (bytes 1 2 4 0 0 0 53))] +(let ([stream (+DecodeStream (bytes 1 2 4 0 0 0 53))] [pointer (+Pointer uint8 uint8 'global)]) (send stream pos 2) - (define ctx-parent (make-object RestructureBase)) - (set-field! _startOffset ctx-parent 2) - (define ctx (make-object RestructureBase)) - (set-field! parent ctx ctx-parent) - (check-equal? (send pointer decode stream ctx) 53)) \ No newline at end of file + (check-equal? (send pointer decode stream (mhash 'parent (mhash 'parent (mhash '_startOffset 2)))) 53)) + +;; todo +#| + it 'should support offsets relative to a property on the parent', -> + stream = new DecodeStream new Buffer [1, 0, 0, 0, 0, 53] + pointer = new Pointer uint8, uint8, relativeTo: 'parent.ptr' + pointer.decode(stream, _startOffset: 0, parent: ptr: 4).should.equal 53 +|# + +;; it 'should support returning pointer if there is no decode type', -> +(let ([stream (+DecodeStream (bytes 4))] + [pointer (+Pointer uint8 'void)]) + (check-equal? (send pointer decode stream (mhash '_startOffset 0)) 4)) + diff --git a/pitfall/restructure/pointer.rkt b/pitfall/restructure/pointer.rkt index 31aed668..280bb915 100644 --- a/pitfall/restructure/pointer.rkt +++ b/pitfall/restructure/pointer.rkt @@ -6,24 +6,31 @@ approximates https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee |# -(define-subclass RestructureBase (Pointer offsetType type [scope 'local]) +(define-subclass object% (Pointer offsetType type [scope 'local]) + (when (eq? type 'void) (set! type #f)) + (and (symbol? scope) (caseq scope [(local parent immediate global) 'yay] [else (raise-argument-error 'Pointer "local or parent or immediate" scope)])) - (define/augride (decode stream [ctx #f]) + (define/public (decode stream [ctx #f]) (define offset (send offsetType decode stream ctx)) (report scope 'pointer-scope) (define relative (caseq scope - [(local) (· ctx _startOffset)] + [(local) (or (· ctx res _startOffset) (· ctx _startOffset))] [(parent) (· ctx parent _startOffset)] [(immediate) (- (· stream pos) (send offsetType size))] [(global) - (let loop ([c ctx]) - (cond - [(· c parent) => loop] - [else (or (· c starting-offset) 0)]))])) - (report* (· this _startOffset) (and ctx (· ctx _startOffset))) + (let loop ([c ctx]) + (cond + [(· c parent) => loop] + [(· c _startOffset)] + [else 0]))])) + (report* this (· this _startOffset) + (and (· this res) (· this res _startOffset)) + ctx (and ctx (· ctx _startOffset)) + (and (· ctx res) (· ctx res _startOffset))) + (when (and ctx (· ctx _startOffset) (= (· ctx _startOffset) 1012)) (error 'stop)) (report* offset relative) (define ptr (+ offset relative)) (report* ptr) @@ -37,10 +44,10 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee [else ptr])) - (define/override (encode stream val) + (define/public (encode stream val) (error 'Pointer-encode-not-done)) - (define/override (size [val #f] [ctx #f]) + (define/public (size [val #f] [ctx #f]) (error 'Pointer-size-not-done) (report* this offsetType type (send type size))) diff --git a/pitfall/restructure/stream.rkt b/pitfall/restructure/stream.rkt index d839181e..8d9db7dc 100644 --- a/pitfall/restructure/stream.rkt +++ b/pitfall/restructure/stream.rkt @@ -113,7 +113,7 @@ https://github.com/mbutterick/restructure/blob/master/src/DecodeStream.coffee ;; Streamcoder is a helper class that checks / converts stream arguments before decode / encode ;; not a subclass of DecodeStream or EncodeStream, however. (define-subclass RestructureBase (Streamcoder) - (define/augment (decode x . args) + (define/overment (decode x . args) (define stream (if (bytes? x) (+DecodeStream x) x)) (unless (DecodeStream? stream) (raise-argument-error 'Streamcoder:decode "bytes or DecodeStream" x)) diff --git a/pitfall/restructure/struct.rkt b/pitfall/restructure/struct.rkt index 9e365172..67a57ced 100644 --- a/pitfall/restructure/struct.rkt +++ b/pitfall/restructure/struct.rkt @@ -36,7 +36,12 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee [else (send fields encode stream input-hash parent)])) (define/public-final (_setup stream parent length) - (mhasheq)) + (define res (mhasheq)) + (hash-set*! res 'parent parent + '_startOffset (· stream pos) + '_currentOffset 0 + '_length length) + res) (define/public-final (_parseFields stream res fields) (unless (assocs? fields) @@ -113,12 +118,14 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (define/override (decode stream [parent #f] [length 0]) (set! res (send this _setup stream parent length)) + (report res 'versioned-struct-res) (define version (resolve-version stream parent)) (hash-set! res 'version version) (define fields (dict-ref versions version (λ () (raise-argument-error 'VersionedStruct:decode "valid version key" (cons version (· this versions)))))) (cond [(VersionedStruct? fields) (send fields decode stream parent)] [else + (report res 'whatigot) (send this _parseFields stream res fields) (send this process res stream) res])) diff --git a/pitfall/sugar/js.rkt b/pitfall/sugar/js.rkt index 3573ca13..34b8aa76 100644 --- a/pitfall/sugar/js.rkt +++ b/pitfall/sugar/js.rkt @@ -40,15 +40,40 @@ (check-equal? (number -4) "-4")) +(define-syntax-rule (send-or-false X REF) + (with-handlers ([exn:fail:object? (λ (exn) #f)]) + (send X REF))) + +(define-syntax-rule (get-or-false X REF) + (with-handlers ([exn:fail:object? (λ (exn) #f)]) + (get-field REF X))) + +(require sugar/debug) (define-macro-cases · [(_ X REF) - #'(cond - [(object? X) (with-handlers ([exn:fail:object? (λ (exn) (send X REF))]) - (get-field REF X))] - [(hash? X) (hash-ref X 'REF #f)] - [else (raise-argument-error '· (format "~a must be object or hash" 'X) X)])] + #'(let loop ([x X]) + (cond + [(and (object? x) (or (get-or-false x REF) (send-or-false x REF)))] + [(and (object? x) (get-or-false x res)) => loop] + [(and (object? x) (send-or-false x res)) => loop] + [(object? x) #f] + [(and (hash? x) (hash-ref x 'res #f)) => loop] + [(and (hash? x) (hash-ref x 'REF #f))] + [(hash? x) #f] + [else (raise-argument-error '· (format "~a must be object or hash" 'X) x)]))] [(_ X REF0 . REFS) #'(· (· X REF0) . REFS)]) +(module+ test + (define c (class object% + (super-new) + (field [a 42]) + (define/public (res) (hash 'res (hash 'b 43))))) + (define co (make-object c)) + (define h2 (hash 'a 42 'res co)) + (check-equal? (· h2 a) 42) + (check-equal? (· h2 b) 43) + (check-equal? (· co a) 42) + (check-equal? (· co b) 43)) (define-macro (·map REF XS) #'(for/list ([x (in-list XS)]) (· x REF)))