diff --git a/pitfall/fontkit/GPOS.rkt b/pitfall/fontkit/GPOS.rkt index 23853cfe..90fcaf05 100644 --- a/pitfall/fontkit/GPOS.rkt +++ b/pitfall/fontkit/GPOS.rkt @@ -100,7 +100,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/GPOS.js (define-subclass VersionedStruct (GPOSLookup-VersionedStruct)) (define GPOSLookup (+GPOSLookup-VersionedStruct - 'lookupType + (λ (parent) (or (· parent parent res lookupType) + (raise-argument-error 'GPOSLookup "parent object" #f))) (dictify ;; Single Adjustment 1 (+VersionedStruct uint16be @@ -184,15 +185,15 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/GPOS.js ;; Fix circular reference ;; GPOSLookup.versions[9].extension.type = GPOSLookup; -(define gpos-common-dict (dictify 'scriptList (+Pointer uint16be ScriptList) ; pointer - 'featureList (+Pointer uint16be FeatureList) ; pointer - 'lookupList (+Pointer uint16be (LookupList GPOSLookup)) - )) ; pointer +(define gpos-common-dict (dictify 'scriptList (+Pointer uint16be ScriptList) + 'featureList (+Pointer uint16be FeatureList) + 'lookupList (+Pointer uint16be (LookupList GPOSLookup)))) (define-subclass VersionedStruct (GPOS-VersionedStruct)) (define GPOS (+GPOS-VersionedStruct uint32be - (dictify - #x00010000 gpos-common-dict - #x00010001 (append gpos-common-dict (dictify 'featureVariations uint32be))))) ; pointer + (dictify + #x00010000 gpos-common-dict + ;; ignore variations + #;#x00010001 #;(append gpos-common-dict (dictify 'featureVariations (+Pointer uint32be FeatureVariations)))))) (test-module) \ No newline at end of file diff --git a/pitfall/fontkit/opentype.rkt b/pitfall/fontkit/opentype.rkt index 58afe7fa..ca498f9f 100644 --- a/pitfall/fontkit/opentype.rkt +++ b/pitfall/fontkit/opentype.rkt @@ -47,16 +47,15 @@ (define LookupFlags (+Bitfield uint16be '(rightToLeft ignoreBaseGlyphs ignoreLigatures ignoreMarks useMarkFilteringSet #f markAttachmentType))) (define (LookupList SubTable) - (+Array ; originally LazyArray - (+Pointer uint16be (+Struct - (dictify - 'lookupType uint16be - 'flags LookupFlags - 'subTableCount uint16be - ;; 'subTables (+Array (+Pointer uint16be SubTable) 'subTableCount) - 'subTables (+Array uint16be 'subTableCount) - 'markFilteringSet uint16be))) - uint16be)) + (define Lookup (+Struct + (dictify + 'lookupType uint16be + 'flags LookupFlags + 'subTableCount uint16be + 'subTables (+Array (+Pointer uint16be SubTable) 'subTableCount) + ;'subTables (+Array uint16be 'subTableCount) + 'markFilteringSet uint16be))) + (+Array (+Pointer uint16be Lookup) uint16be)) ;;############################################# ;; Contextual Substitution/Positioning Tables # diff --git a/pitfall/restructure/base.rkt b/pitfall/restructure/base.rkt index b0cad972..d0fcaa35 100644 --- a/pitfall/restructure/base.rkt +++ b/pitfall/restructure/base.rkt @@ -10,7 +10,6 @@ (define/pubment (decode stream . args) (set! starting-offset (and (object? stream) (send stream pos))) (set! parent (and (pair? args) (is-a? (car args) RestructureBase) (car args))) - #;(report* starting-offset parent (and parent (get-field starting-offset parent))) (inner (void) decode stream . args)) (abstract encode) (abstract size) diff --git a/pitfall/restructure/pointer.rkt b/pitfall/restructure/pointer.rkt index ddb6934f..c7b79254 100644 --- a/pitfall/restructure/pointer.rkt +++ b/pitfall/restructure/pointer.rkt @@ -12,12 +12,10 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee [else (raise-argument-error 'Pointer "local or parent" scope)])) (define/augride (decode stream ctx) - #;(report* (· this starting-offset) (· this parent starting-offset)) (define offset (send offsetType decode stream ctx)) (define ptr (+ offset (caseq scope [(local) (· this parent starting-offset)] [(parent) (· this parent parent starting-offset)]))) - #;(report* offset ptr) (cond [type (define orig-pos (send stream pos)) (send stream pos ptr) diff --git a/pitfall/restructure/struct.rkt b/pitfall/restructure/struct.rkt index 0dfdc765..6017b226 100644 --- a/pitfall/restructure/struct.rkt +++ b/pitfall/restructure/struct.rkt @@ -7,68 +7,49 @@ approximates https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee |# -(define-subclass Streamcoder (Struct [assocs (dictify)]) +(define-subclass Streamcoder (Struct [fields (dictify)]) (field [res #f]) - (unless (assocs? assocs) - (raise-argument-error 'Struct "assocs" assocs)) - (field [key-index #f] ; store the original key order - [fields (mhash)]) + (unless ((disjoin assocs? VersionedStruct?) fields) + (raise-argument-error 'Struct "assocs or Versioned Struct" fields)) - (define/private (update-key-index! assocs) - (unless (assocs? assocs) - (raise-argument-error 'Struct "assocs" assocs)) - (set! key-index (map car assocs))) - - (update-key-index! assocs) - - (define/public-final (update-fields! assocs) - (unless (assocs? assocs) - (raise-argument-error 'Struct "assocs or hash" assocs)) - (update-key-index! assocs) - (for ([(k v) (in-dict assocs)]) - (hash-set! fields k v))) - - (update-fields! assocs) - (define/augride (decode stream [parent #f] [length 0]) (set! res (_setup stream parent length)) - (_parseFields stream fields) + (_parseFields stream res fields) (send this process res stream) res) - (define/augment (encode stream input-hash [parent #f]) + (define/augride (encode stream input-hash [parent #f]) (unless (hash? input-hash) (raise-argument-error 'Struct:encode "hash" input-hash)) (send this preEncode input-hash stream) ; preEncode goes first, because it might bring input hash into compliance - (inner (void) encode stream input-hash parent) + (unless (andmap (λ (key) (member key (hash-keys input-hash))) (dict-keys fields)) + (raise-argument-error 'Struct:encode (format "hash that contains superset of Struct keys: ~a" (dict-keys fields)) (hash-keys input-hash))) - (unless (andmap (λ (key) (member key (hash-keys input-hash))) key-index) - (raise-argument-error 'Struct:encode (format "hash that contains superset of Struct keys: ~a" key-index) (hash-keys input-hash))) - - (for* ([key (in-list key-index)] ; iterate over original keys in order - [struct-type (in-value (hash-ref fields key))] - [value-to-encode (in-value (hash-ref input-hash key))]) - (send struct-type encode stream value-to-encode))) + (cond + [(dict? fields) + (for* ([(key type) (in-dict fields)]) + (send type encode stream (hash-ref input-hash key)))] + [else (send fields encode stream input-hash parent)])) (define/public-final (_setup stream parent length) (mhasheq)) - (define/public-final (_parseFields stream fields) - (for ([key (in-list key-index)]) - (define dictvalue (dict-ref fields key)) + (define/public-final (_parseFields stream res fields) + (unless (assocs? fields) + (raise-argument-error '_parseFields "assocs" fields)) + (for ([(key type) (in-dict fields)]) (define val - (if (procedure? dictvalue) - (dictvalue res) - (send dictvalue decode stream this))) + (if (procedure? type) + (type res) + (send type decode stream this))) (hash-set! res key val))) - (define/overment (size [input-hash (mhash)] [parent #f] [includePointers #t]) - (inner (void) size input-hash parent includePointers) - (for/sum ([(key type) (in-hash fields)]) + (define/override (size [input-hash (mhash)] [parent #f] [includePointers #t]) + (for/sum ([(key type) (in-dict fields)]) (define val (hash-ref input-hash key #f)) (define args (if val (list val) empty)) (send type size . args)))) @@ -80,8 +61,8 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee (check-exn exn:fail:contract? (λ () (+Struct 42))) ;; make random structs and make sure we can round trip - (for ([i (in-range 100)]) - (define field-types (for/list ([i (in-range 200)]) + (for ([i (in-range 10)]) + (define field-types (for/list ([i (in-range 20)]) (random-pick (list uint8 uint16be uint16le uint32be uint32le double)))) (define size-num-types (for/sum ([num-type (in-list field-types)]) (send num-type size))) @@ -101,13 +82,13 @@ approximates https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee |# -(define-subclass Struct (VersionedStruct version-resolver [versions (dictify)]) +(define-subclass Struct (VersionedStruct type [versions (dictify)]) (inherit-field res) - (unless ((disjoin integer? procedure? RestructureBase? symbol?) version-resolver) - (raise-argument-error 'VersionedStruct "integer, function, symbol, or Restructure object" version-resolver)) + (unless ((disjoin integer? procedure? RestructureBase? symbol?) type) + (raise-argument-error 'VersionedStruct "integer, function, symbol, or Restructure object" type)) (unless (and (dict? versions) (andmap (λ (val) (or (dict? val) (Struct? val))) (map cdr versions))) (raise-argument-error 'VersionedStruct "dict of dicts or Structs" versions)) - (inherit-field fields key-index) + (inherit-field fields) (field [forced-version #f]) (define/public-final (force-version! version) @@ -116,34 +97,54 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (define/public (resolve-version [stream #f] [parent #f]) (cond [forced-version] ; for testing purposes: pass an explicit version - [(integer? version-resolver) version-resolver] - [(symbol? version-resolver) (hash-ref (· parent res) version-resolver)] - [(and (procedure? version-resolver) (positive? (procedure-arity version-resolver))) (version-resolver parent)] - [(RestructureBase? version-resolver) (send version-resolver decode stream)] - [else (raise-argument-error 'VersionedStruct:resolve-version "way of finding version" version-resolver)])) + [(integer? type) type] + [(symbol? type) (hash-ref (· parent res version-resolver))] + [(and (procedure? type) (positive? (procedure-arity type))) (type parent)] + [(RestructureBase? type) (send type decode stream)] + [else (raise-argument-error 'VersionedStruct:resolve-version "way of finding version" type)])) (define/override (decode stream [parent #f] [length 0]) (set! res (send this _setup stream parent length)) (define version (resolve-version stream parent)) (hash-set! res 'version version) - (define assocs (dict-ref versions version (λ () (raise-argument-error 'VersionedStruct:decode "valid version key" version)))) - (send this update-fields! assocs) + (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 - (send this _parseFields stream fields) + (send this _parseFields stream res fields) (send this process res stream) res])) - (define/augment (encode stream input-hash [parent #f]) - (define assocs (dict-ref versions (· input-hash version) (λ () (raise-argument-error 'VersionedStruct:encode "valid version key" version)))) - (send this update-fields! assocs)) - + (define/override (encode stream input-hash [parent #f]) + (unless (hash? input-hash) + (raise-argument-error 'Struct:encode "hash" input-hash)) - (define/augment (size [val (mhash)] [parent #f] [includePointers #t]) + (send this preEncode input-hash stream) ; preEncode goes first, because it might bring input hash into compliance + + (define fields (dict-ref versions (· input-hash version) (λ () (raise-argument-error 'VersionedStruct:encode "valid version key" version)))) + + (unless (andmap (λ (key) (member key (hash-keys input-hash))) (dict-keys fields)) + (raise-argument-error 'Struct:encode (format "hash that contains superset of Struct keys: ~a" (dict-keys fields)) (hash-keys input-hash))) + + (cond + [(dict? fields) + (for* ([(key type) (in-dict fields)]) + (send type encode stream (hash-ref input-hash key)))] + [else (send fields encode stream input-hash parent)])) + + + (define/override (size [input-hash (mhash)] [parent #f] [includePointers #t]) + (when (and (not input-hash) (not forced-version)) + (error 'VersionedStruct-cannot-compute-size)) (define version (resolve-version #f parent)) - (define assocs (dict-ref versions version (λ () (raise-argument-error 'VersionedStruct:size "valid version key" version)))) - (send this update-fields! assocs))) + (define fields (dict-ref versions version (λ () (raise-argument-error 'VersionedStruct:size "valid version key" version)))) + (cond + [(dict? fields) + (for/sum ([(key type) (in-dict fields)]) + (define val (hash-ref input-hash key #f)) + (define args (if val (list val) empty)) + (send type size . args))] + [else (send fields size input-hash parent includePointers)]))) (test-module (require "number.rkt") @@ -168,6 +169,12 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee (define s (+Struct (dictify 'a uint8 'b uint8 'c uint8))) (check-equal? (send s size) 3) (define vs (+VersionedStruct (λ (p) 2) (dictify 1 (dictify 'd s) 2 (dictify 'e s 'f s)))) - (check-equal? (send vs size) 6)) + (check-equal? (send vs size) 6) + (define s2 (+Struct (dictify 'a vs))) + (check-equal? (send s2 size) 6) + (define vs2 (+VersionedStruct (λ (p) 2) (dictify 1 vs 2 vs))) + (check-equal? (send vs2 size) 6) + + )