diff --git a/pitfall/fontkit/directory.rkt b/pitfall/fontkit/directory.rkt index cc85b418..d8901a18 100644 --- a/pitfall/fontkit/directory.rkt +++ b/pitfall/fontkit/directory.rkt @@ -1,5 +1,5 @@ #lang fontkit/racket -(require restructure) +(require restructure "tables.rkt") (provide (all-defined-out)) @@ -14,12 +14,35 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js 'length uint32be))) (define-subclass RStruct (RDirectory) - (define/override (process res stream) + (define/override (process this-res stream) ;; in `restructure` `process` method, `res` is aliased as `this` (define new-tables-val (mhash)) - (for ([table (in-list (· res tables))]) - (hash-set! new-tables-val (string->symbol (· table tag)) table)) - (hash-set! res 'tables new-tables-val))) + (for ([table (in-list (· this-res tables))]) + (hash-set! new-tables-val (string->symbol (· table tag)) table)) + (hash-set! this-res 'tables new-tables-val)) + + (define/override (preEncode this-val stream) + (define tables empty) + (for ([(tag table) (in-hash (· this-val tables))]) + (when table + (push-end! tables + (mhash + 'tag tag + 'checkSum 0 + 'offset #xdeadbeef ; todo + 'length (send (hash-ref table-decoders tag (λ () (raise-argument-error 'directory:preEncode "valid table tag" tag))) size table))))) + (define numTables (length tables)) + (define searchRange (* (floor (log (/ numTables (log 2)))) 16)) + (define entrySelector (floor (/ searchRange (log 2)))) + (define rangeShift (- (* numTables 16) searchRange)) + (hash-set*! this-val + 'tag "true" + 'numTables numTables + 'tables tables + 'searchRange searchRange + 'entrySelector rangeShift + 'rangeShift rangeShift))) + (define Directory (make-object RDirectory (dictify 'tag (make-object RString 4) diff --git a/pitfall/fontkit/fpgm.rkt b/pitfall/fontkit/fpgm.rkt index e098f7df..017978fd 100644 --- a/pitfall/fontkit/fpgm.rkt +++ b/pitfall/fontkit/fpgm.rkt @@ -17,385 +17,5 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/fpgm.js (dictify 'instructions (make-object RArray uint8)))) -(test-module - (require "directory.rkt") - (define ip (open-input-file charter-path)) - (define dir (directory-decode ip)) - (define offset (· dir tables fpgm offset)) - (define len (· dir tables fpgm length)) - (check-equal? offset 4140) - (check-equal? len 371) - (set-port-position! ip 0) - (define ds (make-object RDecodeStream (peek-bytes len offset ip))) - (check-equal? (hash-ref (send fpgm decode ds) 'instructions) '(184 - 0 - 0 - 44 - 75 - 184 - 0 - 9 - 80 - 88 - 177 - 1 - 1 - 142 - 89 - 184 - 1 - 255 - 133 - 184 - 0 - 68 - 29 - 185 - 0 - 9 - 0 - 3 - 95 - 94 - 45 - 184 - 0 - 1 - 44 - 32 - 32 - 69 - 105 - 68 - 176 - 1 - 96 - 45 - 184 - 0 - 2 - 44 - 184 - 0 - 1 - 42 - 33 - 45 - 184 - 0 - 3 - 44 - 32 - 70 - 176 - 3 - 37 - 70 - 82 - 88 - 35 - 89 - 32 - 138 - 32 - 138 - 73 - 100 - 138 - 32 - 70 - 32 - 104 - 97 - 100 - 176 - 4 - 37 - 70 - 32 - 104 - 97 - 100 - 82 - 88 - 35 - 101 - 138 - 89 - 47 - 32 - 176 - 0 - 83 - 88 - 105 - 32 - 176 - 0 - 84 - 88 - 33 - 176 - 64 - 89 - 27 - 105 - 32 - 176 - 0 - 84 - 88 - 33 - 176 - 64 - 101 - 89 - 89 - 58 - 45 - 184 - 0 - 4 - 44 - 32 - 70 - 176 - 4 - 37 - 70 - 82 - 88 - 35 - 138 - 89 - 32 - 70 - 32 - 106 - 97 - 100 - 176 - 4 - 37 - 70 - 32 - 106 - 97 - 100 - 82 - 88 - 35 - 138 - 89 - 47 - 253 - 45 - 184 - 0 - 5 - 44 - 75 - 32 - 176 - 3 - 38 - 80 - 88 - 81 - 88 - 176 - 128 - 68 - 27 - 176 - 64 - 68 - 89 - 27 - 33 - 33 - 32 - 69 - 176 - 192 - 80 - 88 - 176 - 192 - 68 - 27 - 33 - 89 - 89 - 45 - 184 - 0 - 6 - 44 - 32 - 32 - 69 - 105 - 68 - 176 - 1 - 96 - 32 - 32 - 69 - 125 - 105 - 24 - 68 - 176 - 1 - 96 - 45 - 184 - 0 - 7 - 44 - 184 - 0 - 6 - 42 - 45 - 184 - 0 - 8 - 44 - 75 - 32 - 176 - 3 - 38 - 83 - 88 - 176 - 64 - 27 - 176 - 0 - 89 - 138 - 138 - 32 - 176 - 3 - 38 - 83 - 88 - 35 - 33 - 176 - 128 - 138 - 138 - 27 - 138 - 35 - 89 - 32 - 176 - 3 - 38 - 83 - 88 - 35 - 33 - 184 - 0 - 192 - 138 - 138 - 27 - 138 - 35 - 89 - 32 - 176 - 3 - 38 - 83 - 88 - 35 - 33 - 184 - 1 - 0 - 138 - 138 - 27 - 138 - 35 - 89 - 32 - 176 - 3 - 38 - 83 - 88 - 35 - 33 - 184 - 1 - 64 - 138 - 138 - 27 - 138 - 35 - 89 - 32 - 184 - 0 - 3 - 38 - 83 - 88 - 176 - 3 - 37 - 69 - 184 - 1 - 128 - 80 - 88 - 35 - 33 - 184 - 1 - 128 - 35 - 33 - 27 - 176 - 3 - 37 - 69 - 35 - 33 - 35 - 33 - 89 - 27 - 33 - 89 - 68 - 45 - 184 - 0 - 9 - 44 - 75 - 83 - 88 - 69 - 68 - 27 - 33 - 33 - 89 - 45))) + diff --git a/pitfall/fontkit/head.rkt b/pitfall/fontkit/head.rkt index 8e46e09c..66e5bc54 100644 --- a/pitfall/fontkit/head.rkt +++ b/pitfall/fontkit/head.rkt @@ -30,31 +30,5 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/head.js 'glyphDataFormat int16be ;; 0 for current format ))) -(test-module - (require "directory.rkt") - (define ip (open-input-file charter-italic-path)) ; use italic to make sure style flags are set correctly - (define dir (directory-decode ip)) - (define offset (· dir tables head offset)) - (define length (· dir tables head length)) - (check-equal? offset 236) - (check-equal? length 54) - (define table-bytes #"\0\1\0\0\0\2\0\0.\252t<_\17<\365\0\t\3\350\0\0\0\0\316\3\301\261\0\0\0\0\316\3\304\364\377\36\377\24\4\226\3\324\0\2\0\t\0\2\0\0\0\0") - (set-port-position! ip 0) - (check-equal? (peek-bytes length offset ip) table-bytes) - (define table-data (send head decode (make-object RDecodeStream table-bytes))) - (check-equal? (· table-data unitsPerEm) 1000) - (check-equal? (· table-data yMin) -236) - (check-equal? (· table-data yMax) 980) - (check-equal? (· table-data xMax) 1174) - (check-equal? (· table-data xMin) -226) - (check-equal? (· table-data macStyle) (make-hash '((shadow . #f) - (extended . #f) - (condensed . #f) - (underline . #f) - (outline . #f) - (bold . #f) - (italic . #t)))) - (check-equal? (· table-data magicNumber) #x5F0F3CF5) - (check-equal? (· table-data indexToLocFormat) 0) ; used in loca table - ) + diff --git a/pitfall/fontkit/hhea.rkt b/pitfall/fontkit/hhea.rkt index dc4e4983..3f3142e7 100644 --- a/pitfall/fontkit/hhea.rkt +++ b/pitfall/fontkit/hhea.rkt @@ -22,18 +22,5 @@ 'numberOfMetrics uint16be ;; Number of advance widths in 'hmtx' table ))) -(test-module - (require "directory.rkt") - (define ip (open-input-file charter-path)) - (define dir (directory-decode ip)) - (define offset (· dir tables hhea offset)) - (define length (· dir tables hhea length)) - (check-equal? offset 292) - (check-equal? length 36) - (define table-bytes #"\0\1\0\0\3\324\377\22\0\0\4\311\377_\377`\4\251\0\1\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\345") - (set-port-position! ip 0) - (check-equal? (peek-bytes length offset ip) table-bytes) - (define table-data (send hhea decode (make-object RDecodeStream table-bytes))) - (check-equal? (· table-data ascent) 980) - (check-equal? (· table-data descent) -238)) + diff --git a/pitfall/fontkit/hmtx.rkt b/pitfall/fontkit/hmtx.rkt new file mode 100644 index 00000000..f8f9b8fd --- /dev/null +++ b/pitfall/fontkit/hmtx.rkt @@ -0,0 +1,22 @@ +#lang fontkit/racket +(require restructure) +(provide (all-defined-out)) +#| +approximates +https://github.com/mbutterick/fontkit/blob/master/src/tables/hmtx.js +|# + +(define-subclass RStruct (Rhmtx)) + +(define HmtxEntry (make-object RStruct + (dictify + 'advance uint16be + 'bearing uint16be))) + +(define hmtx (make-object Rhmtx + (dictify + 'metrics uint16be + 'bearing uint16be))) + + + diff --git a/pitfall/fontkit/loca.rkt b/pitfall/fontkit/loca.rkt index 54651f2c..a6794c2f 100644 --- a/pitfall/fontkit/loca.rkt +++ b/pitfall/fontkit/loca.rkt @@ -41,246 +41,5 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/loca.js 1 (dictify 'offsets (make-object RArray uint32be)) ))) -(test-module - (require "directory.rkt") - (define ip (open-input-file charter-path)) - (define dir (directory-decode ip)) - (define offset (· dir tables loca offset)) - (define len (· dir tables loca length)) - (check-equal? offset 38692) - (check-equal? len 460) - (set-port-position! ip 0) - (define ds (make-object RDecodeStream (peek-bytes len offset ip))) - (define table-data (send loca decode ds #:version 0)) - (check-equal? (length (· table-data offsets)) 230) - (check-equal? (· table-data offsets) '(0 - 0 - 0 - 136 - 296 - 500 - 864 - 1168 - 1548 - 1628 - 1716 - 1804 - 1944 - 2048 - 2128 - 2176 - 2256 - 2312 - 2500 - 2596 - 2788 - 3052 - 3168 - 3396 - 3624 - 3732 - 4056 - 4268 - 4424 - 4564 - 4640 - 4728 - 4804 - 5012 - 5384 - 5532 - 5808 - 6012 - 6212 - 6456 - 6672 - 6916 - 7204 - 7336 - 7496 - 7740 - 7892 - 8180 - 8432 - 8648 - 8892 - 9160 - 9496 - 9764 - 9936 - 10160 - 10312 - 10536 - 10780 - 10992 - 11148 - 11216 - 11272 - 11340 - 11404 - 11444 - 11524 - 11820 - 12044 - 12216 - 12488 - 12728 - 12932 - 13324 - 13584 - 13748 - 13924 - 14128 - 14232 - 14592 - 14852 - 15044 - 15336 - 15588 - 15776 - 16020 - 16164 - 16368 - 16520 - 16744 - 16984 - 17164 - 17320 - 17532 - 17576 - 17788 - 17896 - 18036 - 18284 - 18552 - 18616 - 18988 - 19228 - 19512 - 19712 - 19796 - 19976 - 20096 - 20160 - 20224 - 20536 - 20836 - 20876 - 21000 - 21200 - 21268 - 21368 - 21452 - 21532 - 21720 - 21908 - 22036 - 22244 - 22664 - 22872 - 22932 - 22992 - 23088 - 23220 - 23268 - 23372 - 23440 - 23600 - 23752 - 23868 - 23988 - 24084 - 24184 - 24224 - 24548 - 24788 - 25012 - 25292 - 25716 - 25884 - 26292 - 26396 - 26540 - 26796 - 27172 - 27488 - 27512 - 27536 - 27560 - 27584 - 27912 - 27936 - 27960 - 27984 - 28008 - 28032 - 28056 - 28080 - 28104 - 28128 - 28152 - 28176 - 28200 - 28224 - 28248 - 28272 - 28296 - 28320 - 28344 - 28368 - 28392 - 28416 - 28440 - 28464 - 28488 - 28512 - 28536 - 28560 - 28968 - 28992 - 29016 - 29040 - 29064 - 29088 - 29112 - 29136 - 29160 - 29184 - 29208 - 29232 - 29256 - 29280 - 29304 - 29328 - 29352 - 29376 - 29400 - 29424 - 29448 - 29472 - 29496 - 29520 - 29824 - 30164 - 30220 - 30652 - 30700 - 30956 - 31224 - 31248 - 31332 - 31488 - 31636 - 31916 - 32104 - 32176 - 32484 - 32744 - 32832 - 32956 - 33248 - 33664 - 33884 - 34048 - 34072))) + diff --git a/pitfall/fontkit/maxp.rkt b/pitfall/fontkit/maxp.rkt index 630310da..611a1990 100644 --- a/pitfall/fontkit/maxp.rkt +++ b/pitfall/fontkit/maxp.rkt @@ -22,18 +22,3 @@ 'maxComponentDepth uint16be ;; Maximum levels of recursion; 1 for simple components ))) -(test-module - (require "directory.rkt") - (define ip (open-input-file charter-path)) - (define dir (directory-decode ip)) - (define maxp-offset (· dir tables maxp offset)) - (define maxp-length (· dir tables maxp length)) - (check-equal? maxp-offset 328) - (check-equal? maxp-length 32) - (define maxp-bytes #"\0\1\0\0\0\345\0f\0\a\0O\0\4\0\1\0\0\0\0\0\n\0\0\2\0\1s\0\2\0\1") - (set-port-position! ip 0) - (check-equal? (peek-bytes maxp-length maxp-offset ip) maxp-bytes) - (define maxp-data (send maxp decode (make-object RDecodeStream maxp-bytes))) - (check-equal? (· maxp-data numGlyphs) 229) - (check-equal? (· maxp-data version) 65536)) - diff --git a/pitfall/fontkit/prep.rkt b/pitfall/fontkit/prep.rkt index 578bd190..6b157513 100644 --- a/pitfall/fontkit/prep.rkt +++ b/pitfall/fontkit/prep.rkt @@ -12,94 +12,5 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/prep.js (dictify 'controlValueProgram (make-object RArray uint8)))) -(test-module - (require "directory.rkt") - (define ip (open-input-file charter-path)) - (define dir (directory-decode ip)) - (define offset (· dir tables prep offset)) - (define len (· dir tables prep length)) - (check-equal? offset 4512) - (check-equal? len 78) - (set-port-position! ip 0) - (define table-bytes #"\270\0\0+\0\272\0\1\0\1\0\2+\1\272\0\2\0\1\0\2+\1\277\0\2\0C\0007\0+\0\37\0\23\0\0\0\b+\0\277\0\1\0\200\0i\0R\0;\0#\0\0\0\b+\0\272\0\3\0\5\0\a+\270\0\0 E}i\30D") - (check-equal? table-bytes (peek-bytes len offset ip)) - (define ds (make-object RDecodeStream (peek-bytes len offset ip))) - (check-equal? (hash-ref (send prep decode ds) 'controlValueProgram) '(184 - 0 - 0 - 43 - 0 - 186 - 0 - 1 - 0 - 1 - 0 - 2 - 43 - 1 - 186 - 0 - 2 - 0 - 1 - 0 - 2 - 43 - 1 - 191 - 0 - 2 - 0 - 67 - 0 - 55 - 0 - 43 - 0 - 31 - 0 - 19 - 0 - 0 - 0 - 8 - 43 - 0 - 191 - 0 - 1 - 0 - 128 - 0 - 105 - 0 - 82 - 0 - 59 - 0 - 35 - 0 - 0 - 0 - 8 - 43 - 0 - 186 - 0 - 3 - 0 - 5 - 0 - 7 - 43 - 184 - 0 - 0 - 32 - 69 - 125 - 105 - 24 - 68))) + diff --git a/pitfall/fontkit/subset.rkt b/pitfall/fontkit/subset.rkt index 9d54aad8..7f36b4c1 100644 --- a/pitfall/fontkit/subset.rkt +++ b/pitfall/fontkit/subset.rkt @@ -92,9 +92,11 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js 'maxp maxp ;; todo: cvt 'prep (send (· this font) _getTable 'prep) - 'glyf (· this glyf) + ;; 'glyf (· this glyf) 'hmtx (· this hmtx) 'fpgm (send (· this font) _getTable 'fpgm)))) + + (report* stream (send stream dump)) (unfinished) ) diff --git a/pitfall/fontkit/tables.rkt b/pitfall/fontkit/tables.rkt index 1c9f4ffa..92ef8eab 100644 --- a/pitfall/fontkit/tables.rkt +++ b/pitfall/fontkit/tables.rkt @@ -8,4 +8,4 @@ (r+p . TABLE-ID-STRINGS) (define ID (make-hasheq (map cons (list 'TABLE-ID ...) (list TABLE-ID ...))))))) -(define-table-decoders table-decoders maxp hhea head loca prep fpgm) \ No newline at end of file +(define-table-decoders table-decoders maxp hhea head loca prep fpgm hmtx) \ No newline at end of file diff --git a/pitfall/fontkit/tabletest.rkt b/pitfall/fontkit/tabletest.rkt new file mode 100644 index 00000000..81afb30b --- /dev/null +++ b/pitfall/fontkit/tabletest.rkt @@ -0,0 +1,775 @@ +#lang fontkit/racket +(require "directory.rkt") +(require rackunit "tables.rkt" restructure) + + + +(define ip (open-input-file charter-path)) +(define dir (directory-decode ip)) + +;; maxp +(let () + (define maxp-offset (· dir tables maxp offset)) + (define maxp-length (· dir tables maxp length)) + (check-equal? maxp-offset 328) + (check-equal? maxp-length 32) + (define maxp-bytes #"\0\1\0\0\0\345\0f\0\a\0O\0\4\0\1\0\0\0\0\0\n\0\0\2\0\1s\0\2\0\1") + (set-port-position! ip 0) + (check-equal? (peek-bytes maxp-length maxp-offset ip) maxp-bytes) + (define maxp-data (send maxp decode (make-object RDecodeStream maxp-bytes))) + (check-equal? (· maxp-data numGlyphs) 229) + (check-equal? (· maxp-data version) 65536)) + + +;; hhea +(let () + (define offset (· dir tables hhea offset)) + (define length (· dir tables hhea length)) + (check-equal? offset 292) + (check-equal? length 36) + (define table-bytes #"\0\1\0\0\3\324\377\22\0\0\4\311\377_\377`\4\251\0\1\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\345") + (set-port-position! ip 0) + (check-equal? (peek-bytes length offset ip) table-bytes) + (define table-data (send hhea decode (make-object RDecodeStream table-bytes))) + (check-equal? (· table-data ascent) 980) + (check-equal? (· table-data descent) -238)) + + +;; head +(let () + (define ip (open-input-file charter-italic-path)) ; use italic to make sure style flags are set correctly + (define dir (directory-decode ip)) + (define offset (· dir tables head offset)) + (define length (· dir tables head length)) + (check-equal? offset 236) + (check-equal? length 54) + (define table-bytes #"\0\1\0\0\0\2\0\0.\252t<_\17<\365\0\t\3\350\0\0\0\0\316\3\301\261\0\0\0\0\316\3\304\364\377\36\377\24\4\226\3\324\0\2\0\t\0\2\0\0\0\0") + (set-port-position! ip 0) + (check-equal? (peek-bytes length offset ip) table-bytes) + (define table-data (send head decode (make-object RDecodeStream table-bytes))) + (check-equal? (· table-data unitsPerEm) 1000) + (check-equal? (· table-data yMin) -236) + (check-equal? (· table-data yMax) 980) + (check-equal? (· table-data xMax) 1174) + (check-equal? (· table-data xMin) -226) + (check-equal? (· table-data macStyle) (make-hash '((shadow . #f) + (extended . #f) + (condensed . #f) + (underline . #f) + (outline . #f) + (bold . #f) + (italic . #t)))) + (check-equal? (· table-data magicNumber) #x5F0F3CF5) + (check-equal? (· table-data indexToLocFormat) 0) ; used in loca table + ) + + +;; prep +(let () + (define offset (· dir tables prep offset)) + (define len (· dir tables prep length)) + (check-equal? offset 4512) + (check-equal? len 78) + (set-port-position! ip 0) + (define table-bytes #"\270\0\0+\0\272\0\1\0\1\0\2+\1\272\0\2\0\1\0\2+\1\277\0\2\0C\0007\0+\0\37\0\23\0\0\0\b+\0\277\0\1\0\200\0i\0R\0;\0#\0\0\0\b+\0\272\0\3\0\5\0\a+\270\0\0 E}i\30D") + (check-equal? table-bytes (peek-bytes len offset ip)) + (define ds (make-object RDecodeStream (peek-bytes len offset ip))) + (check-equal? (hash-ref (send prep decode ds) 'controlValueProgram) '(184 + 0 + 0 + 43 + 0 + 186 + 0 + 1 + 0 + 1 + 0 + 2 + 43 + 1 + 186 + 0 + 2 + 0 + 1 + 0 + 2 + 43 + 1 + 191 + 0 + 2 + 0 + 67 + 0 + 55 + 0 + 43 + 0 + 31 + 0 + 19 + 0 + 0 + 0 + 8 + 43 + 0 + 191 + 0 + 1 + 0 + 128 + 0 + 105 + 0 + 82 + 0 + 59 + 0 + 35 + 0 + 0 + 0 + 8 + 43 + 0 + 186 + 0 + 3 + 0 + 5 + 0 + 7 + 43 + 184 + 0 + 0 + 32 + 69 + 125 + 105 + 24 + 68))) + +;; fpgm +(let () + (define offset (· dir tables fpgm offset)) + (define len (· dir tables fpgm length)) + (check-equal? offset 4140) + (check-equal? len 371) + (set-port-position! ip 0) + (define ds (make-object RDecodeStream (peek-bytes len offset ip))) + (check-equal? (hash-ref (send fpgm decode ds) 'instructions) '(184 + 0 + 0 + 44 + 75 + 184 + 0 + 9 + 80 + 88 + 177 + 1 + 1 + 142 + 89 + 184 + 1 + 255 + 133 + 184 + 0 + 68 + 29 + 185 + 0 + 9 + 0 + 3 + 95 + 94 + 45 + 184 + 0 + 1 + 44 + 32 + 32 + 69 + 105 + 68 + 176 + 1 + 96 + 45 + 184 + 0 + 2 + 44 + 184 + 0 + 1 + 42 + 33 + 45 + 184 + 0 + 3 + 44 + 32 + 70 + 176 + 3 + 37 + 70 + 82 + 88 + 35 + 89 + 32 + 138 + 32 + 138 + 73 + 100 + 138 + 32 + 70 + 32 + 104 + 97 + 100 + 176 + 4 + 37 + 70 + 32 + 104 + 97 + 100 + 82 + 88 + 35 + 101 + 138 + 89 + 47 + 32 + 176 + 0 + 83 + 88 + 105 + 32 + 176 + 0 + 84 + 88 + 33 + 176 + 64 + 89 + 27 + 105 + 32 + 176 + 0 + 84 + 88 + 33 + 176 + 64 + 101 + 89 + 89 + 58 + 45 + 184 + 0 + 4 + 44 + 32 + 70 + 176 + 4 + 37 + 70 + 82 + 88 + 35 + 138 + 89 + 32 + 70 + 32 + 106 + 97 + 100 + 176 + 4 + 37 + 70 + 32 + 106 + 97 + 100 + 82 + 88 + 35 + 138 + 89 + 47 + 253 + 45 + 184 + 0 + 5 + 44 + 75 + 32 + 176 + 3 + 38 + 80 + 88 + 81 + 88 + 176 + 128 + 68 + 27 + 176 + 64 + 68 + 89 + 27 + 33 + 33 + 32 + 69 + 176 + 192 + 80 + 88 + 176 + 192 + 68 + 27 + 33 + 89 + 89 + 45 + 184 + 0 + 6 + 44 + 32 + 32 + 69 + 105 + 68 + 176 + 1 + 96 + 32 + 32 + 69 + 125 + 105 + 24 + 68 + 176 + 1 + 96 + 45 + 184 + 0 + 7 + 44 + 184 + 0 + 6 + 42 + 45 + 184 + 0 + 8 + 44 + 75 + 32 + 176 + 3 + 38 + 83 + 88 + 176 + 64 + 27 + 176 + 0 + 89 + 138 + 138 + 32 + 176 + 3 + 38 + 83 + 88 + 35 + 33 + 176 + 128 + 138 + 138 + 27 + 138 + 35 + 89 + 32 + 176 + 3 + 38 + 83 + 88 + 35 + 33 + 184 + 0 + 192 + 138 + 138 + 27 + 138 + 35 + 89 + 32 + 176 + 3 + 38 + 83 + 88 + 35 + 33 + 184 + 1 + 0 + 138 + 138 + 27 + 138 + 35 + 89 + 32 + 176 + 3 + 38 + 83 + 88 + 35 + 33 + 184 + 1 + 64 + 138 + 138 + 27 + 138 + 35 + 89 + 32 + 184 + 0 + 3 + 38 + 83 + 88 + 176 + 3 + 37 + 69 + 184 + 1 + 128 + 80 + 88 + 35 + 33 + 184 + 1 + 128 + 35 + 33 + 27 + 176 + 3 + 37 + 69 + 35 + 33 + 35 + 33 + 89 + 27 + 33 + 89 + 68 + 45 + 184 + 0 + 9 + 44 + 75 + 83 + 88 + 69 + 68 + 27 + 33 + 33 + 89 + 45))) + +;; loca +(let () + (define offset (· dir tables loca offset)) + (define len (· dir tables loca length)) + (check-equal? offset 38692) + (check-equal? len 460) + (set-port-position! ip 0) + (define ds (make-object RDecodeStream (peek-bytes len offset ip))) + (define table-data (send loca decode ds #:version 0)) + (check-equal? (length (· table-data offsets)) 230) + (check-equal? (· table-data offsets) '(0 + 0 + 0 + 136 + 296 + 500 + 864 + 1168 + 1548 + 1628 + 1716 + 1804 + 1944 + 2048 + 2128 + 2176 + 2256 + 2312 + 2500 + 2596 + 2788 + 3052 + 3168 + 3396 + 3624 + 3732 + 4056 + 4268 + 4424 + 4564 + 4640 + 4728 + 4804 + 5012 + 5384 + 5532 + 5808 + 6012 + 6212 + 6456 + 6672 + 6916 + 7204 + 7336 + 7496 + 7740 + 7892 + 8180 + 8432 + 8648 + 8892 + 9160 + 9496 + 9764 + 9936 + 10160 + 10312 + 10536 + 10780 + 10992 + 11148 + 11216 + 11272 + 11340 + 11404 + 11444 + 11524 + 11820 + 12044 + 12216 + 12488 + 12728 + 12932 + 13324 + 13584 + 13748 + 13924 + 14128 + 14232 + 14592 + 14852 + 15044 + 15336 + 15588 + 15776 + 16020 + 16164 + 16368 + 16520 + 16744 + 16984 + 17164 + 17320 + 17532 + 17576 + 17788 + 17896 + 18036 + 18284 + 18552 + 18616 + 18988 + 19228 + 19512 + 19712 + 19796 + 19976 + 20096 + 20160 + 20224 + 20536 + 20836 + 20876 + 21000 + 21200 + 21268 + 21368 + 21452 + 21532 + 21720 + 21908 + 22036 + 22244 + 22664 + 22872 + 22932 + 22992 + 23088 + 23220 + 23268 + 23372 + 23440 + 23600 + 23752 + 23868 + 23988 + 24084 + 24184 + 24224 + 24548 + 24788 + 25012 + 25292 + 25716 + 25884 + 26292 + 26396 + 26540 + 26796 + 27172 + 27488 + 27512 + 27536 + 27560 + 27584 + 27912 + 27936 + 27960 + 27984 + 28008 + 28032 + 28056 + 28080 + 28104 + 28128 + 28152 + 28176 + 28200 + 28224 + 28248 + 28272 + 28296 + 28320 + 28344 + 28368 + 28392 + 28416 + 28440 + 28464 + 28488 + 28512 + 28536 + 28560 + 28968 + 28992 + 29016 + 29040 + 29064 + 29088 + 29112 + 29136 + 29160 + 29184 + 29208 + 29232 + 29256 + 29280 + 29304 + 29328 + 29352 + 29376 + 29400 + 29424 + 29448 + 29472 + 29496 + 29520 + 29824 + 30164 + 30220 + 30652 + 30700 + 30956 + 31224 + 31248 + 31332 + 31488 + 31636 + 31916 + 32104 + 32176 + 32484 + 32744 + 32832 + 32956 + 33248 + 33664 + 33884 + 34048 + 34072))) diff --git a/pitfall/restructure/Untitled.rkt b/pitfall/restructure/Untitled.rkt new file mode 100644 index 00000000..7c1cb2d7 --- /dev/null +++ b/pitfall/restructure/Untitled.rkt @@ -0,0 +1,47 @@ +#lang restructure/racket +(require "number.rkt" "utils.rkt" "streamcoder.rkt") +(provide RArray) + +#| +approximates +https://github.com/mbutterick/restructure/blob/master/src/Array.coffee +|# + +(define-subclass RStreamcoder (RArray type [length #f] [lengthType 'count]) + + (define/augment (decode stream [parent #f]) + (let ([length (cond + [length + (resolveLength length stream parent)] + [else + (define num (send stream length)) + (define denom (send type size)) + (unless (andmap (λ (x) (and x (number? x))) (list num denom)) + (raise-argument-error 'RArray:decode "valid length and size" (list num denom))) + ;; implied length: length of stream divided by size of item + (floor (/ (send stream length) (send type size)))])]) + + (caseq lengthType + [(count) (for/list ([i (in-range length)]) + (send type decode stream this))]))) + + (define/override (size array) + (report array) + (for/sum ([item (in-list array)]) + (report item) + (send item size))) + + (define/augment (encode stream array [parent #f]) + (for ([item (in-list array)]) + (send type encode stream item)))) + + +(test-module + (require "decodestream.rkt" "encodestream.rkt") + (define stream (make-object RDecodeStream #"ABCDEFG")) + + (define A (make-object RArray uint16be 3)) + (check-equal? (send A decode stream) '(16706 17220 17734)) + (define os (make-object REncodeStream)) + (send A encode os '(16706 17220 17734)) + (check-equal? (send os dump) #"ABCDEF")) \ No newline at end of file diff --git a/pitfall/restructure/array.rkt b/pitfall/restructure/array.rkt index fd1117ec..88dc4d0a 100644 --- a/pitfall/restructure/array.rkt +++ b/pitfall/restructure/array.rkt @@ -25,7 +25,9 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee [(count) (for/list ([i (in-range length)]) (send type decode stream this))]))) - (define/public (size) (unfinished)) + (define/override (size array) + (for/sum ([item (in-list array)]) + (send type size))) (define/augment (encode stream array [parent #f]) (for ([item (in-list array)]) @@ -40,4 +42,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee (check-equal? (send A decode stream) '(16706 17220 17734)) (define os (make-object REncodeStream)) (send A encode os '(16706 17220 17734)) - (check-equal? (send os dump) #"ABCDEF")) \ No newline at end of file + (check-equal? (send os dump) #"ABCDEF") + + (check-equal? (send (make-object RArray uint16be) size '(1 2 3)) 6) + (check-equal? (send (make-object RArray doublebe) size '(1 2 3 4 5)) 40)) \ No newline at end of file diff --git a/pitfall/restructure/bitfield.rkt b/pitfall/restructure/bitfield.rkt index 8f101aa5..75b7085c 100644 --- a/pitfall/restructure/bitfield.rkt +++ b/pitfall/restructure/bitfield.rkt @@ -16,7 +16,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee (hash-set! res flag (bitwise-bit-set? val i)) res)) - (define/public (size) (send type size)) + (define/override (size . args) (send type size)) (define/augment (encode stream flag-hash) (send type encode stream (for/sum ([(flag i) (in-indexed flags)] @@ -27,7 +27,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee (test-module (require "number.rkt" "decodestream.rkt" "encodestream.rkt") (define bfer (make-object RBitfield uint16be '(bold italic underline outline shadow condensed extended))) - (define bf (send bfer decode #"\0\25")) + (define bf (send bfer decode (make-object RDecodeStream #"\0\25"))) (check-true (hash-ref bf 'bold)) (check-true (hash-ref bf 'underline)) (check-true (hash-ref bf 'shadow)) diff --git a/pitfall/restructure/helper.rkt b/pitfall/restructure/helper.rkt index 291e88e1..e499d496 100644 --- a/pitfall/restructure/helper.rkt +++ b/pitfall/restructure/helper.rkt @@ -7,11 +7,9 @@ (super-new) (abstract decode) (abstract encode) - (define/public (process . args) - (void)) - (define/public (preEncode . args) - (void)) - #;(abstract size))) + (abstract size) + (define/public (process . args) (void)) + (define/public (preEncode . args) (void)))) (define-macro (test-module . EXPRS) diff --git a/pitfall/restructure/number.rkt b/pitfall/restructure/number.rkt index 926e2dd8..e8aabdd3 100644 --- a/pitfall/restructure/number.rkt +++ b/pitfall/restructure/number.rkt @@ -24,19 +24,22 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee (unless (hash-has-key? type-sizes fn) (raise-argument-error 'Number "valid type and endian" (format "~v ~v" type endian))) - (getter-field [size (hash-ref type-sizes fn)]) + (define/override (size . args) (hash-ref type-sizes fn)) (define/augment (decode stream [res #f]) - (define bstr (send stream read size)) - (if (= 1 size) + (define bstr (send stream read (size))) + (if (= 1 (size)) (bytes-ref bstr 0) (integer-bytes->integer bstr (signed-type? type) (eq? endian 'BE)))) - (define/augment (encode stream val) + (define/augment (encode stream val-in) + (define val (if (and (integer? val-in) (inexact? val-in)) + (inexact->exact val-in) + val-in)) (define bstr - (if (= 1 size) + (if (= 1 (size)) (bytes val) - (integer->integer-bytes val size (signed-type? type) (eq? endian 'BE)))) + (integer->integer-bytes val (size) (signed-type? type) (eq? endian 'BE)))) (if stream (send stream write bstr) bstr))) diff --git a/pitfall/restructure/streamcoder.rkt b/pitfall/restructure/streamcoder.rkt index eab72303..da2efddd 100644 --- a/pitfall/restructure/streamcoder.rkt +++ b/pitfall/restructure/streamcoder.rkt @@ -3,17 +3,16 @@ (provide RStreamcoder) (define-subclass RBase (RStreamcoder) - (define/overment (decode x . args) (let loop ([x x]) (cond [(bytes? x) (loop (open-input-bytes x))] - [(is-a? x RDecodeStream) (inner (void) decode x . args)] + [(or (is-a? x RDecodeStream) (not x)) (inner (void) decode x . args)] [else (raise-argument-error 'decode "item that can become RDecodeStream" x)]))) (define/overment (encode x . args) (let loop ([x x]) (cond [(output-port? x) (loop (make-object REncodeStream x))] - [(is-a? x REncodeStream) (inner (void) encode x . args)] + [(or (is-a? x REncodeStream) (not x)) (inner (void) encode x . args)] [else (raise-argument-error 'encode "item that can become REncodeStream" x)])))) \ No newline at end of file diff --git a/pitfall/restructure/string.rkt b/pitfall/restructure/string.rkt index 38afd8f9..c5472321 100644 --- a/pitfall/restructure/string.rkt +++ b/pitfall/restructure/string.rkt @@ -20,14 +20,14 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee ((cdr _codec) bytes)) (define/augment (encode stream val [parent #f]) - (define bytes ((car _codec) val)) + (define bytes ((car _codec) (format "~a" val))) (when (is-a? length Number) ;; length-prefixed string (send length encode stream (bytes-length bytes))) (send stream write bytes)) - (define/public (size) (unfinished))) + (define/override (size) (unfinished))) (test-module diff --git a/pitfall/restructure/struct.rkt b/pitfall/restructure/struct.rkt index 6f96a5f8..d497cd2e 100644 --- a/pitfall/restructure/struct.rkt +++ b/pitfall/restructure/struct.rkt @@ -11,7 +11,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee (field [key-index #f] [fields (mhash)]) (for ([(k v) (in-dict assocs)]) - (hash-set! fields k v)) + (hash-set! fields k v)) (define/public-final (make-key-index! [fields assocs]) (set! key-index (map car fields))) @@ -27,7 +27,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee (define/override (encode stream val [parent #f]) (send this preEncode val stream) (for ([key (in-list key-index)]) - (send (hash-ref fields key) encode stream (hash-ref val key)))) + (send (hash-ref fields key) encode stream (hash-ref val key)))) (define/public-final (_setup stream parent length) (define res (mhasheq)) @@ -42,11 +42,14 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee (define/public-final (_parseFields stream res fields) (for ([key (in-list key-index)]) - (define dictvalue (dict-ref fields key)) - (define val - (if (procedure? dictvalue) - (dictvalue res) - (send dictvalue decode stream res))) - (hash-set! res key val))) - - ) + (define dictvalue (dict-ref fields key)) + (define val + (if (procedure? dictvalue) + (dictvalue res) + (send dictvalue decode stream res))) + (hash-set! res key val))) + + (define/override (size [val (mhash)] [parent #f] [includePointers #t]) + (for/sum ([(key type) (in-hash fields)] + #:when (hash-has-key? val key)) + (send type size (hash-ref val key))))) diff --git a/pitfall/restructure/versioned-struct.rkt b/pitfall/restructure/versioned-struct.rkt index 6bd27d20..9052a0f6 100644 --- a/pitfall/restructure/versioned-struct.rkt +++ b/pitfall/restructure/versioned-struct.rkt @@ -1,4 +1,4 @@ - #lang restructure/racket +#lang restructure/racket (require racket/dict "struct.rkt") (provide (all-defined-out)) @@ -16,11 +16,12 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee [(is-a? type RBase) (send type decode stream)] [else (raise-argument-error 'decode "way of finding version" type)])) (hash-set! res 'version version) - (define fields (dict-ref versions version (λ () (raise-argument-error 'RVersionedStruct:decode "valid version key" version)))) - (send this make-key-index! fields) + (set-field! fields this (dict-ref versions version (λ () (raise-argument-error 'RVersionedStruct:decode "valid version key" version)))) + (send this make-key-index! (· this fields)) (cond - [(is-a? fields RVersionedStruct) (send fields decode stream parent)] + [(is-a? (· this fields) RVersionedStruct) (send (· this fields) decode stream parent)] [else - (send this _parseFields stream res fields) + (send this _parseFields stream res (· this fields)) (send this process res stream) - res]))) \ No newline at end of file + res])) + ) \ No newline at end of file