From 82987cfcfdb48325da078804dbaf8ee0e538b32b Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 15 Jun 2017 15:23:46 -0700 Subject: [PATCH] dirty as hell --- pitfall/fontkit/directory.rkt | 115 +++++++++++++++++++++++---------- pitfall/fontkit/font.rkt | 8 ++- pitfall/fontkit/subset.rkt | 8 +-- pitfall/fontkit/tables.rkt | 2 +- pitfall/restructure/buffer.rkt | 9 ++- pitfall/restructure/string.rkt | 3 +- 6 files changed, 98 insertions(+), 47 deletions(-) diff --git a/pitfall/fontkit/directory.rkt b/pitfall/fontkit/directory.rkt index b0ed0d99..4a2a3e6c 100644 --- a/pitfall/fontkit/directory.rkt +++ b/pitfall/fontkit/directory.rkt @@ -7,32 +7,74 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js |# -(define TableEntry (make-object Struct - (dictify 'tag (+String 4) - 'checkSum uint32be - 'offset uint32be - 'length uint32be))) +(define-subclass Struct (RTableEntry) + (define/override (preEncode this-val stream) + (when (eq? (hash-ref this-val 'tag) 'cvt) + (hash-set! this-val 'tag '|cvt |)))) + +(define TableEntry (+RTableEntry + (dictify 'tag (+String 4) + 'checkSum uint32be + 'offset uint32be + 'length uint32be))) + +(define (pad-to-32bit bstr) + (define mod (modulo (bytes-length bstr) 4)) + (if (positive? mod) + (bytes-append bstr (make-bytes (- 4 mod) 0)) + bstr)) (define-subclass Struct (RDirectory) (define/override (process this-res stream) ;; in `restructure` `process` method, `res` is aliased as `this` (define new-tables-val (mhash)) (for ([table (in-list (· this-res tables))]) - (hash-set! new-tables-val (string->symbol (string-trim (· table tag))) table)) + (hash-set! new-tables-val (string->symbol (string-trim (· 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 16909060 ; todo \1\2\3\4 octal-be - 'length (let ([tag (hash-ref table-decoders tag (λ () (raise-argument-error 'directory:preEncode "valid table tag" tag)))]) - (send tag size table)))))) - (define numTables (length tables)) + + (define offset-ks (mhash)) + (define table-header-hash (mhash)) + (for ([(tag table) (in-hash (· this-val tables))] + [i (in-naturals)] + #:unless (hash-has-key? table-header-hash i)) + (hash-set! table-header-hash i + (let/cc k + (hash-set! offset-ks i k) + (mhash + 'tag tag)))) + + (define table-headers (for/list ([i (in-range (length (hash-keys table-header-hash)))]) + (hash-ref table-header-hash i))) + (define table-header-size (+ 12 (* (length table-headers) (send TableEntry size)))) + + (define data-hash (mhash)) + (for/fold ([current-offset table-header-size]) + ([(table-header i) (in-indexed table-headers)]) + (define tag (· table-header tag)) + (define bstr (hash-ref! data-hash i + (λ () + (define es (+EncodeStream)) + (define tag-codec (hash-ref table-codecs tag (λ () (raise-argument-error 'directory:preEncode "valid table tag" tag)))) + (send tag-codec encode es (hash-ref (· this-val tables) tag)) + (send es dump)))) + (define 32-bit-bstr (pad-to-32bit bstr)) + + (cond + [(hash-ref offset-ks i #f) => (λ (k) (hash-remove! offset-ks i) + (k (mhash + 'tag (· table-header tag) + 'checkSum 0 + 'offset current-offset + 'length (bytes-length bstr))))] + [else + (+ (bytes-length 32-bit-bstr) current-offset)])) + + (hash-set! this-val 'data (for/list ([i (in-range (length (hash-keys data-hash)))]) + (pad-to-32bit (hash-ref data-hash i)))) + + (define numTables (length table-headers)) (define searchRange (* (floor (log (/ numTables (log 2)))) 16)) (define entrySelector (floor (/ searchRange (log 2)))) (define rangeShift (- (* numTables 16) searchRange)) @@ -40,29 +82,32 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js (hash-set*! this-val 'tag "true" 'numTables numTables - 'tables tables + 'tables table-headers 'searchRange searchRange 'entrySelector rangeShift - 'rangeShift rangeShift) - )) + 'rangeShift rangeShift))) -(define Directory (make-object RDirectory - (dictify 'tag (+String 4) - 'numTables uint16be - 'searchRange uint16be - 'entrySelector uint16be - 'rangeShift uint16be - 'tables (+Array TableEntry 'numTables)))) +(define Directory (+RDirectory + (dictify 'tag (+String 4) + 'numTables uint16be + 'searchRange uint16be + 'entrySelector uint16be + 'rangeShift uint16be + 'tables (+Array TableEntry 'numTables) + + ;; we don't know what tables we might get + ;; so we represent as generic Buffer type, + ;; and convert the tables to bytes manually in preEncode + 'data (+Array (+Buffer))))) (define (directory-decode ip [options (mhash)]) (send Directory decode (+DecodeStream (port->bytes ip)))) - -(test-module - (define ip (open-input-file charter-path)) - (define decoded-dir (deserialize (read (open-input-file charter-directory-path)))) - (check-equal? (directory-decode ip) decoded-dir) - (define es (+EncodeStream)) - ;(send Directory encode es decoded-dir) - ) \ No newline at end of file +#;(test-module + (define ip (open-input-file charter-path)) + (define decoded-dir (deserialize (read (open-input-file charter-directory-path)))) + (check-equal? (directory-decode ip) decoded-dir) + (define es (+EncodeStream)) + ;(send Directory encode es decoded-dir) + ) \ No newline at end of file diff --git a/pitfall/fontkit/font.rkt b/pitfall/fontkit/font.rkt index 6875786e..0b7934da 100644 --- a/pitfall/fontkit/font.rkt +++ b/pitfall/fontkit/font.rkt @@ -32,7 +32,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js (hash-ref! _tables table-tag (_decodeTable table-tag))) ; get table from cache, load if not there (define/public (_decodeTable table-tag) - (define table-decoder (hash-ref table-decoders table-tag + (define table-decoder (hash-ref table-codecs table-tag (λ () (raise-argument-error '_decodeTable "decodable table" table-tag)))) (define offset (· (hash-ref (· directory tables) table-tag) offset)) (define len (· (hash-ref (· directory tables) table-tag) length)) @@ -280,6 +280,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js (check-exn exn:fail:contract? (λ () (send f _getTable 'nonexistent-table-tag))) #;(send f _getTable 'maxp) (define subset (make-object TTFSubset f)) - (send subset encode (+EncodeStream)) -(file->bytes "../pitfall/test/out.bin") + (define es (+EncodeStream)) + (send subset encode es) + (define ds (+DecodeStream (send es dump))) + (send Directory decode ds) ) \ No newline at end of file diff --git a/pitfall/fontkit/subset.rkt b/pitfall/fontkit/subset.rkt index 66849ad3..1c1c41d9 100644 --- a/pitfall/fontkit/subset.rkt +++ b/pitfall/fontkit/subset.rkt @@ -67,7 +67,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js ;; include all the glyphs used in the document (for ([gid (in-list (· this glyphs))]) - (send this _addGlyph gid)) + (send this _addGlyph gid)) (define maxp (cloneDeep (send (· this font) _getTable 'maxp))) (hash-set! maxp 'numGlyphs (length (· this glyf))) @@ -87,7 +87,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js (mhash 'tables (mhash 'head head - #| 'hhea hhea 'loca (· this loca) 'maxp maxp @@ -96,12 +95,11 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js 'glyf (· this glyf) 'hmtx (· this hmtx) 'fpgm (send (· this font) _getTable 'fpgm) -|# ))) - (report* (bytes-length (send stream dump)) (send stream dump)) + #;(report* (bytes-length (send stream dump)) (send stream dump)) - (unfinished) + (void) ) diff --git a/pitfall/fontkit/tables.rkt b/pitfall/fontkit/tables.rkt index 8dc9ffb9..96ccf558 100644 --- a/pitfall/fontkit/tables.rkt +++ b/pitfall/fontkit/tables.rkt @@ -9,4 +9,4 @@ (test-module (require (submod TABLE-ID-STRING test) ...)) (define ID (make-hasheq (map cons (list 'TABLE-ID ...) (list TABLE-ID ...))))))) -(define-table-decoders table-decoders maxp hhea head loca prep fpgm hmtx cvt glyf) \ No newline at end of file +(define-table-decoders table-codecs maxp hhea head loca prep fpgm hmtx cvt glyf) \ No newline at end of file diff --git a/pitfall/restructure/buffer.rkt b/pitfall/restructure/buffer.rkt index 23742cb1..83eabbef 100644 --- a/pitfall/restructure/buffer.rkt +++ b/pitfall/restructure/buffer.rkt @@ -1,5 +1,5 @@ #lang restructure/racket -(require "number.rkt" "utils.rkt") +(require "number.rkt" "utils.rkt" "stream.rkt") (provide (all-defined-out)) #| @@ -19,11 +19,16 @@ https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee (bytes-length val) (resolveLength _length val parent))) - (define/override (encode stream buf parent) + (define/override (encode stream buf [parent #f]) (when (Number? _length) (send _length encode stream (bytes-length buf))) (send stream writeBuffer buf))) +(define (bytes->Buffer bstr) + (define b (+Buffer (bytes-length bstr))) + (send b decode (+DecodeStream bstr)) + b) + #;(test-module (require "stream.rkt") diff --git a/pitfall/restructure/string.rkt b/pitfall/restructure/string.rkt index 83c440c0..dff01236 100644 --- a/pitfall/restructure/string.rkt +++ b/pitfall/restructure/string.rkt @@ -29,7 +29,8 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee (send stream write bytes)) - (define/override (size str) + (define/override (size [str-in #f]) + (define str (or str-in (make-string strlen #\x))) (define es (+EncodeStream)) (encode es str) (bytes-length (send es dump))))