From 8d2406e39af4f25bb0f92aa963a87c362f1cf018 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 15 Jun 2017 16:58:48 -0700 Subject: [PATCH] next: addGlyph --- pitfall/fontkit/charter-directory.rktd | 63 +++++----- pitfall/fontkit/charter-italic-directory.rktd | 9 +- pitfall/fontkit/cvt_.rkt | 4 +- pitfall/fontkit/directory.rkt | 114 +++++++----------- pitfall/fontkit/font.rkt | 1 + pitfall/fontkit/subset.rkt | 5 +- pitfall/fontkit/subsetfont.rktd | Bin 760 -> 760 bytes pitfall/fontkit/tables.rkt | 4 +- 8 files changed, 91 insertions(+), 109 deletions(-) diff --git a/pitfall/fontkit/charter-directory.rktd b/pitfall/fontkit/charter-directory.rktd index 146433ac..53394959 100644 --- a/pitfall/fontkit/charter-directory.rktd +++ b/pitfall/fontkit/charter-directory.rktd @@ -1,32 +1,33 @@ ((3) - 0 - () - 0 - () - () - (h - ! - () - (tag u . "\u0000\u0001\u0000\u0000") - (rangeShift . 96) - (searchRange . 128) - (numTables . 14) - (entrySelector . 3) - (tables - h - ! - (equal) - (loca h ! () (tag u . "loca") (offset . 38692) (checkSum . 2795817194) (length . 460)) - (glyf h ! () (tag u . "glyf") (offset . 4620) (checkSum . 1143629849) (length . 34072)) - (OS/2 h ! () (tag u . "OS/2") (offset . 360) (checkSum . 2351070438) (length . 96)) - (hhea h ! () (tag u . "hhea") (offset . 292) (checkSum . 132056097) (length . 36)) - (post h ! () (tag u . "post") (offset . 41520) (checkSum . 1670855689) (length . 514)) - (cvt h ! () (tag u . "cvt ") (offset . 4592) (checkSum . 10290865) (length . 26)) - (VDMX h ! () (tag u . "VDMX") (offset . 1372) (checkSum . 1887795202) (length . 1504)) - (prep h ! () (tag u . "prep") (offset . 4512) (checkSum . 490862356) (length . 78)) - (maxp h ! () (tag u . "maxp") (offset . 328) (checkSum . 50135594) (length . 32)) - (hmtx h ! () (tag u . "hmtx") (offset . 456) (checkSum . 3982043058) (length . 916)) - (cmap h ! () (tag u . "cmap") (offset . 2876) (checkSum . 1723761408) (length . 1262)) - (name h ! () (tag u . "name") (offset . 39152) (checkSum . 2629707307) (length . 2367)) - (head h ! () (tag u . "head") (offset . 236) (checkSum . 4281190895) (length . 54)) - (fpgm h ! () (tag u . "fpgm") (offset . 4140) (checkSum . 106535991) (length . 371))))) \ No newline at end of file + 0 + () + 0 + () + () + (h + ! + () + (tag u . "\u0000\u0001\u0000\u0000") + (rangeShift . 96) + (data) + (searchRange . 128) + (numTables . 14) + (tables + h + ! + (equal) + (loca h ! () (tag u . "loca") (offset . 38692) (checkSum . 2795817194) (length . 460)) + (OS/2 h ! () (tag u . "OS/2") (offset . 360) (checkSum . 2351070438) (length . 96)) + (glyf h ! () (tag u . "glyf") (offset . 4620) (checkSum . 1143629849) (length . 34072)) + (hhea h ! () (tag u . "hhea") (offset . 292) (checkSum . 132056097) (length . 36)) + (post h ! () (tag u . "post") (offset . 41520) (checkSum . 1670855689) (length . 514)) + (cvt_ h ! () (tag u . "cvt ") (offset . 4592) (checkSum . 10290865) (length . 26)) + (VDMX h ! () (tag u . "VDMX") (offset . 1372) (checkSum . 1887795202) (length . 1504)) + (prep h ! () (tag u . "prep") (offset . 4512) (checkSum . 490862356) (length . 78)) + (maxp h ! () (tag u . "maxp") (offset . 328) (checkSum . 50135594) (length . 32)) + (hmtx h ! () (tag u . "hmtx") (offset . 456) (checkSum . 3982043058) (length . 916)) + (cmap h ! () (tag u . "cmap") (offset . 2876) (checkSum . 1723761408) (length . 1262)) + (name h ! () (tag u . "name") (offset . 39152) (checkSum . 2629707307) (length . 2367)) + (head h ! () (tag u . "head") (offset . 236) (checkSum . 4281190895) (length . 54)) + (fpgm h ! () (tag u . "fpgm") (offset . 4140) (checkSum . 106535991) (length . 371))) + (entrySelector . 3))) \ No newline at end of file diff --git a/pitfall/fontkit/charter-italic-directory.rktd b/pitfall/fontkit/charter-italic-directory.rktd index ee14b291..8e6bce46 100644 --- a/pitfall/fontkit/charter-italic-directory.rktd +++ b/pitfall/fontkit/charter-italic-directory.rktd @@ -9,19 +9,19 @@ () (tag u . "\u0000\u0001\u0000\u0000") (rangeShift . 96) + (data) (searchRange . 128) (numTables . 14) - (entrySelector . 3) (tables h ! (equal) (loca h ! () (tag u . "loca") (offset . 37392) (checkSum . 46801904) (length . 460)) - (glyf h ! () (tag u . "glyf") (offset . 4620) (checkSum . 2099535230) (length . 32772)) (OS/2 h ! () (tag u . "OS/2") (offset . 360) (checkSum . 2367847603) (length . 96)) + (glyf h ! () (tag u . "glyf") (offset . 4620) (checkSum . 2099535230) (length . 32772)) (hhea h ! () (tag u . "hhea") (offset . 292) (checkSum . 113838023) (length . 36)) (post h ! () (tag u . "post") (offset . 40280) (checkSum . 1671576585) (length . 514)) - (cvt h ! () (tag u . "cvt ") (offset . 4592) (checkSum . 9307818) (length . 26)) + (cvt_ h ! () (tag u . "cvt ") (offset . 4592) (checkSum . 9307818) (length . 26)) (VDMX h ! () (tag u . "VDMX") (offset . 1372) (checkSum . 1905948947) (length . 1504)) (prep h ! () (tag u . "prep") (offset . 4512) (checkSum . 776081685) (length . 78)) (maxp h ! () (tag u . "maxp") (offset . 328) (checkSum . 50135583) (length . 32)) @@ -29,4 +29,5 @@ (cmap h ! () (tag u . "cmap") (offset . 2876) (checkSum . 1723761408) (length . 1262)) (name h ! () (tag u . "name") (offset . 37852) (checkSum . 2313429994) (length . 2427)) (head h ! () (tag u . "head") (offset . 236) (checkSum . 4275817075) (length . 54)) - (fpgm h ! () (tag u . "fpgm") (offset . 4140) (checkSum . 106535991) (length . 371))))) \ No newline at end of file + (fpgm h ! () (tag u . "fpgm") (offset . 4140) (checkSum . 106535991) (length . 371))) + (entrySelector . 3))) \ No newline at end of file diff --git a/pitfall/fontkit/cvt_.rkt b/pitfall/fontkit/cvt_.rkt index 2a7b1967..9ee26eb1 100644 --- a/pitfall/fontkit/cvt_.rkt +++ b/pitfall/fontkit/cvt_.rkt @@ -16,8 +16,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/cvt.js (test-module (define ip (open-input-file charter-path)) (define dir (deserialize (read (open-input-file charter-directory-path)))) - (define offset (· dir tables cvt offset)) - (define len (· dir tables cvt length)) + (define offset (· dir tables cvt_ offset)) + (define len (· dir tables cvt_ length)) (check-equal? offset 4592) (check-equal? len 26) (set-port-position! ip 0) diff --git a/pitfall/fontkit/directory.rkt b/pitfall/fontkit/directory.rkt index 88eaee3f..6e878b59 100644 --- a/pitfall/fontkit/directory.rkt +++ b/pitfall/fontkit/directory.rkt @@ -7,10 +7,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js |# -(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 (+Struct (dictify 'tag (+String 4) @@ -19,82 +15,66 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js '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 op (open-output-bytes)) + (write-bytes bstr op) + (file-position op (* (ceiling (/ (file-position op) 4)) 4)) + (get-output-bytes op)) + +(test-module + (check-equal? (pad-to-32bit #"") #"") + (check-equal? (pad-to-32bit #"1") #"1\0\0\0") + (check-equal? (pad-to-32bit #"12") #"12\0\0") + (check-equal? (pad-to-32bit #"123") #"123\0") + (check-equal? (pad-to-32bit #"1234") #"1234")) + +;; for stupid tags like 'cvt ' (define (symbol-replace sym this that) - (string->symbol (string-replace (symbol->string sym) this that))) - -(define (escape-tag tag) - (symbol-replace (if (string? tag) (string->symbol tag) tag) " " "_")) - -(define (unescape-tag tag) - (symbol-replace (if (string? tag) (string->symbol tag) tag) "_" " ")) + (string->symbol (string-replace (if (string? sym) sym (symbol->string sym)) this that))) +(define (escape-tag tag) (symbol-replace tag " " "_")) +(define (unescape-tag tag) (symbol-replace tag "_" " ")) (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 (escape-tag (· table tag)) table)) (hash-set! this-res 'tables new-tables-val)) (define/override (preEncode this-val stream) - - (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 (unescape-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 (escape-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 (unescape-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 preamble-length 12) + (define table-header-size (+ preamble-length + (* (length (hash-keys (· this-val tables))) (send TableEntry size)))) + + (define-values (table-headers table-datas) + (for/lists (ths tds) + ([(tag table) (in-hash (· this-val tables))]) + + (define table-data + (let ([es (+EncodeStream)]) + (send (hash-ref table-codecs tag) encode es table) + (send es dump))) + + (define table-header (mhash + 'tag (unescape-tag tag) + 'checkSum 0 + 'offset (+ table-header-size (apply + (map bytes-length tds))) + 'length (bytes-length table-data))) + + (define table-data-padded (pad-to-32bit table-data)) + (values table-header table-data-padded))) + (define numTables (length table-headers)) (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 table-headers 'searchRange searchRange - 'entrySelector rangeShift - 'rangeShift rangeShift))) + 'entrySelector (floor (/ searchRange (log 2))) + 'rangeShift (- (* numTables 16) searchRange) + 'data table-datas))) (define Directory (+RDirectory @@ -113,10 +93,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js (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) + ) \ No newline at end of file diff --git a/pitfall/fontkit/font.rkt b/pitfall/fontkit/font.rkt index 733a5b00..3131c4a3 100644 --- a/pitfall/fontkit/font.rkt +++ b/pitfall/fontkit/font.rkt @@ -282,5 +282,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js (define subset (make-object TTFSubset f)) (define es (+EncodeStream)) (send subset encode es) + #;(with-output-to-file "subsetfont.rktd" (λ () (display (send es dump)) )) (check-equal? (send es dump) (file->bytes "subsetfont.rktd")) ) \ No newline at end of file diff --git a/pitfall/fontkit/subset.rkt b/pitfall/fontkit/subset.rkt index 04e8a84b..d748a88f 100644 --- a/pitfall/fontkit/subset.rkt +++ b/pitfall/fontkit/subset.rkt @@ -51,7 +51,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js ) -(define-stub-go _addGlyph) +(define (_addGlyph . xs) + (void)) ;; tables required by PDF spec: ;; head, hhea, loca, maxp, cvt, prep, glyf, hmtx, fpgm @@ -97,7 +98,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js 'fpgm (send (· this font) _getTable 'fpgm) ))) - #;(report* (bytes-length (send stream dump)) (send stream dump)) + (report* (bytes-length (send stream dump))) (void) ) diff --git a/pitfall/fontkit/subsetfont.rktd b/pitfall/fontkit/subsetfont.rktd index f5dceb69aad7f31c99d007a2c9f0c8f638ab6835..61557a8d840c580de598a28d4cce2518c52593ef 100644 GIT binary patch delta 19 acmeyt`h%6Lq^LBNfs;XjL2o11J0<`?{{_bY delta 19 acmeyt`h%6Lq^LBNfs;Xjpsyntax caller-stx (format "~a.rkt" (syntax->datum #'STX)))])]) #'(begin @@ -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-codecs maxp hhea head loca prep fpgm hmtx cvt_ glyf) \ No newline at end of file +(define-table-codecs table-codecs maxp hhea head loca prep fpgm hmtx cvt_ glyf) \ No newline at end of file