mbutterick
/
typesetting
2
1
Fork 0
Code Issues 13 Pull Requests Projects Releases Wiki Activity

next: decoding for cvt, glyf, hmtx; then `size` methods

Browse Source
main
Matthew Butterick 8 years ago
parent 8b710c4887
commit 0c1ddcbdf8
20 changed files with 926 additions and 812 deletions
Show Stats Download Patch File Download Diff File

33
pitfall/fontkit/directory.rkt
Unescape Escape View File

@ -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)

382
pitfall/fontkit/fpgm.rkt
Unescape Escape View File

@ -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)))

28
pitfall/fontkit/head.rkt
Unescape Escape View File

@ -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
)

15
pitfall/fontkit/hhea.rkt
Unescape Escape View File

@ -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))

22
pitfall/fontkit/hmtx.rkt
Unescape Escape View File

@ -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)))

243
pitfall/fontkit/loca.rkt
Unescape Escape View File

@ -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)))

15
pitfall/fontkit/maxp.rkt
Unescape Escape View File

@ -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))

91
pitfall/fontkit/prep.rkt
Unescape Escape View File

@ -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)))

4
pitfall/fontkit/subset.rkt
Unescape Escape View File

@ -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)
)

2
pitfall/fontkit/tables.rkt
Unescape Escape View File

@ -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)
(define-table-decoders table-decoders maxp hhea head loca prep fpgm hmtx)

775
pitfall/fontkit/tabletest.rkt
Unescape Escape View File

@ -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)))

47
pitfall/restructure/Untitled.rkt
Unescape Escape View File

@ -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"))

9
pitfall/restructure/array.rkt
Unescape Escape View File

@ -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"))
(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))

4
pitfall/restructure/bitfield.rkt
Unescape Escape View File

@ -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))

8
pitfall/restructure/helper.rkt
Unescape Escape View File

@ -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)

15
pitfall/restructure/number.rkt
Unescape Escape View File

@ -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)))

5
pitfall/restructure/streamcoder.rkt
Unescape Escape View File

@ -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)]))))

4
pitfall/restructure/string.rkt
Unescape Escape View File

@ -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

23
pitfall/restructure/struct.rkt
Unescape Escape View File

@ -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)))))

13
pitfall/restructure/versioned-struct.rkt
Unescape Escape View File

@ -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])))
res]))
)
Write Preview
Loading…
Cancel
Save