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

resume in struct

Browse Source
main
Matthew Butterick 7 years ago
parent 4768cfe464
commit 3fb2990284
6 changed files with 123 additions and 56 deletions
Show Stats Download Patch File Download Diff File

94
pitfall/pitfall/directory.rkt
Unescape Escape View File

@ -1,50 +1,50 @@
#lang pitfall/racket
(provide (all-defined-out))
(require binparser/object)
(define TableEntry (:seq ([tag (:make-string 4)]
[checkSum uint32be]
[offset uint32be]
[length uint32be])))
(define Directory (:seq ([tag hexbytes #:assert (curry equal? "00 01 00 00")]
[numTables uint16be #:assert ]
[searchRange uint16be]
[entrySelector uint16be]
[rangeShift uint16be]
[tables (:repeat numTables TableEntry)])))
(define (directory-decode ip [options (mhash)])
(Directory ip))
(define ip (open-input-file "test/assets/Charter.ttf"))
(directory-decode ip (mhash '_startOffset 0))
(module+ test
(require rackunit)
(define ip (open-input-file "test/assets/Charter.ttf"))
(check-equal?
(directory-decode ip (mhash '_startOffset 0))
'((tag . "00 01 00 00")
(numTables . 14)
(searchRange . 128)
(entrySelector . 3)
(rangeShift . 96)
(tables
((tag . "OS/2") (checkSum . 2351070438) (offset . 360) (length . 96))
((tag . "VDMX") (checkSum . 1887795202) (offset . 1372) (length . 1504))
((tag . "cmap") (checkSum . 1723761408) (offset . 2876) (length . 1262))
((tag . "cvt ") (checkSum . 10290865) (offset . 4592) (length . 26))
((tag . "fpgm") (checkSum . 106535991) (offset . 4140) (length . 371))
((tag . "glyf") (checkSum . 1143629849) (offset . 4620) (length . 34072))
((tag . "head") (checkSum . 4281190895) (offset . 236) (length . 54))
((tag . "hhea") (checkSum . 132056097) (offset . 292) (length . 36))
((tag . "hmtx") (checkSum . 3982043058) (offset . 456) (length . 916))
((tag . "loca") (checkSum . 2795817194) (offset . 38692) (length . 460))
((tag . "maxp") (checkSum . 50135594) (offset . 328) (length . 32))
((tag . "name") (checkSum . 2629707307) (offset . 39152) (length . 2367))
((tag . "post") (checkSum . 1670855689) (offset . 41520) (length . 514))
((tag . "prep") (checkSum . 490862356) (offset . 4512) (length . 78))))))
(require restructure)
#;(define TableEntry (new RStruct
'tag (RString 4)
'checkSum uint32be
'offset uint32be
'length uint32be))
#;(define Directory (:seq ([tag hexbytes #:assert (curry equal? "/00 01 00 00")]
[numTables uint16be #:assert ]
[searchRange uint16be]
[entrySelector uint16be]
[rangeShift uint16be]
[tables (:repeat numTables TableEntry)])))
#;(define (directory-decode ip [options (mhash)])
(Directory ip))
#;(define ip (open-input-file "test/assets/Charter.ttf"))
#;(directory-decode ip (mhash '_startOffset 0))
#;(module+ test
(require rackunit)
(define ip (open-input-file "test/assets/Charter.ttf"))
(check-equal?
(directory-decode ip (mhash '_startOffset 0))
'((tag . "00 01 00 00")
(numTables . 14)
(searchRange . 128)
(entrySelector . 3)
(rangeShift . 96)
(tables
((tag . "OS/2") (checkSum . 2351070438) (offset . 360) (length . 96))
((tag . "VDMX") (checkSum . 1887795202) (offset . 1372) (length . 1504))
((tag . "cmap") (checkSum . 1723761408) (offset . 2876) (length . 1262))
((tag . "cvt ") (checkSum . 10290865) (offset . 4592) (length . 26))
((tag . "fpgm") (checkSum . 106535991) (offset . 4140) (length . 371))
((tag . "glyf") (checkSum . 1143629849) (offset . 4620) (length . 34072))
((tag . "head") (checkSum . 4281190895) (offset . 236) (length . 54))
((tag . "hhea") (checkSum . 132056097) (offset . 292) (length . 36))
((tag . "hmtx") (checkSum . 3982043058) (offset . 456) (length . 916))
((tag . "loca") (checkSum . 2795817194) (offset . 38692) (length . 460))
((tag . "maxp") (checkSum . 50135594) (offset . 328) (length . 32))
((tag . "name") (checkSum . 2629707307) (offset . 39152) (length . 2367))
((tag . "post") (checkSum . 1670855689) (offset . 41520) (length . 514))
((tag . "prep") (checkSum . 490862356) (offset . 4512) (length . 78))))))

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

@ -8,7 +8,7 @@
(raise-argument-error 'read-bytes-exact (format "byte string length ~a" count) bs))
bs)
(define RestructureBase%
(define RBase
(class object%
(super-new)
(abstract decode)
@ -56,4 +56,18 @@
(define-macro (unfinished)
(with-pattern ([ID-UNFINISHED (prefix-id (syntax-source caller-stx) ":" (syntax-line caller-stx) ":" #'unfinished)])
#'(error 'ID-UNFINISHED)))
#'(error 'ID-UNFINISHED)))
(define-macro (define+provide ID . EXPRS)
#'(begin
(provide ID)
(define ID . EXPRS)))
(require sugar/list)
(define (listify kvs)
(for/list ([slice (in-list (slice-at kvs 2))])
(cons (car slice) (cadr slice))))
(define-syntax-rule (define-hashifier id hasher) (define (id . kvs) (hasher (listify kvs))))
(define-hashifier mhash make-hash)
(define-hashifier mhasheq make-hasheq)
(define-hashifier mhasheqv make-hasheqv)

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

@ -0,0 +1,4 @@
#lang restructure/racket
(r+p "number.rkt"
"struct.rkt")

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

@ -14,11 +14,11 @@
(check-true (unsigned-type? 'UInt16))
(check-false (unsigned-type? 'Int16)))
(define-subclass RestructureBase% (NumberT type [endian (if (system-big-endian?) 'BE 'LE)])
(define-subclass RBase (Number [type 'UInt16] [endian (if (system-big-endian?) 'BE 'LE)])
(getter-field [fn (string->symbol (format "~a~a" type (if (ends-with-8? type) "" endian)))])
(unless (hash-has-key? type-sizes fn)
(raise-argument-error 'NumberT "valid type and endian" (format "~v ~v" type endian)))
(raise-argument-error 'Number "valid type and endian" (format "~v ~v" type endian)))
(getter-field [size (hash-ref type-sizes fn)])
@ -39,7 +39,7 @@
(test-module
(let ([o (make-object NumberT 'UInt16 'LE)]
(let ([o (make-object Number 'UInt16 'LE)]
[ip (open-input-bytes (bytes 1 2 3 4))]
[op (open-output-bytes)])
(check-equal? (send o decode ip) 513) ;; 1000 0000 0100 0000
@ -47,7 +47,7 @@
(check-equal? (send o encode op 513) (bytes 1 2))
(check-equal? (send o encode op 1027) (bytes 3 4)))
(let ([o (make-object NumberT 'UInt16 'BE)]
(let ([o (make-object Number 'UInt16 'BE)]
[ip (open-input-bytes (bytes 1 2 3 4))]
[op (open-output-bytes)])
(check-equal? (send o decode ip) 258) ;; 0100 0000 1000 0000
@ -57,7 +57,36 @@
(test-module
(check-equal? (send (make-object NumberT 'UInt8) size) 1)
(check-equal? (send (make-object NumberT 'UInt32) size) 4)
(check-equal? (send (make-object NumberT 'Double) size) 8))
(check-equal? (send (make-object Number 'UInt8) size) 1)
(check-equal? (send (make-object Number) size) 2)
(check-equal? (send (make-object Number 'UInt32) size) 4)
(check-equal? (send (make-object Number 'Double) size) 8))
(require (for-syntax "decodestream.rkt" racket/match))
;; use keys of type-sizes hash to generate corresponding number definitions
(define-macro (make-int-types)
(with-pattern ([((ID BASE ENDIAN) ...) (for/list ([k (in-hash-keys type-sizes)])
(define kstr (format "~a" k))
(match-define (list* prefix suffix _)
(regexp-split #rx"(?=[BL]E|$)" kstr))
(map string->symbol
(list (string-downcase kstr)
prefix
(if (positive? (string-length suffix))
suffix
(if (system-big-endian?) "BE" "LE")))))]
[(ID ...) (suffix-id #'(ID ...) #:context caller-stx)])
#'(begin (define+provide ID (make-object Number 'BASE 'ENDIAN)) ...)))
(make-int-types)
(test-module
(check-equal? (send uint8 size) 1)
(check-equal? (send uint16 size) 2)
(check-equal? (send uint32 size) 4)
(check-equal? (send double size) 8))

1
pitfall/restructure/racket.rkt
Unescape Escape View File

@ -8,6 +8,7 @@
(r+p "helper.rkt"
sugar/debug
racket/class
racket/string
br/define)
(module reader syntax/module-reader

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

@ -0,0 +1,19 @@
#lang restructure/racket
(provide (all-defined-out))
#|
approximates
https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
|#
(define-subclass RBase (RStruct [fields (mhash)])
(define/override (decode stream parent [length 0])
(unfinished))
(define/override (encode stream val parent)
(unfinished))
)
(make-object RStruct (mhash 'foo "bar"))
Write Preview
Loading…
Cancel
Save