From 253f5fc17098df8139f4465d71d0cda09914ad2a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 6 Dec 2018 10:42:50 -0800 Subject: [PATCH] another toe --- fontland/fontland/font.rkt | 90 +++++++++++------------------- fontland/fontland/subset.rkt | 46 ++++++++------- fontland/fontland/table-stream.rkt | 43 ++++++++++++++ fontland/fontland/ttf-glyph.rkt | 7 ++- 4 files changed, 106 insertions(+), 80 deletions(-) create mode 100644 fontland/fontland/table-stream.rkt diff --git a/fontland/fontland/font.rkt b/fontland/fontland/font.rkt index 678ee39a..1d36f55f 100644 --- a/fontland/fontland/font.rkt +++ b/fontland/fontland/font.rkt @@ -25,20 +25,22 @@ sugar/list racket/promise crc32c) -(provide (all-defined-out)) +(provide (except-out (all-defined-out) + head + post + hhea + maxp + OS/2 + cvt_ + prep + fpgm)) #| approximates https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js |# -(require (for-syntax "tables.rkt")) -(define-syntax (define-table-getters stx) - (syntax-case stx () - [(_) - (with-syntax ([(TABLE-TAG ...) (hash-keys table-codecs)]) - #'(begin - (define/public (TABLE-TAG) (_getTable 'TABLE-TAG)) ...))])) + (test-module @@ -68,28 +70,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js [_hb-buf (delay (hb_buffer_create))] [_crc (begin0 (crc32c-input-port _port) (pos _port 0))]) - - (define/public (_getTable table-tag) - (unless (has-table? this table-tag) - (raise-argument-error '_getTable "table that exists in font" table-tag)) - (hash-ref! _decoded-tables table-tag (λ () (_decodeTable table-tag)))) - - (define-table-getters) - - (define/public (_getTableStream tag) - (define table (hash-ref (· this directory tables) tag)) - (and table (pos _port (· table offset)) _port)) - - (define/public (_decodeTable table-tag) - (unless (hash-has-key? table-codecs table-tag) - (raise-argument-error '_decodeTable "decodable table" table-tag)) - (define table (hash-ref (· this directory tables) table-tag)) - ;; todo: possible to avoid copying the bytes here? - (pos _port (· table offset)) - (define table-bytes (open-input-bytes (peek-bytes (· table length) 0 _port))) - (define table-decoder (hash-ref table-codecs table-tag)) - (decode table-decoder table-bytes #:parent this)) - (as-methods postscriptName measure-string @@ -104,11 +84,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js xHeight bbox createSubset - has-table? - has-cff-table? - has-morx-table? - has-gsub-table? - has-gpos-table? getGlyph layout glyphsForString @@ -116,7 +91,15 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js directory ft-face hb-font - hb-buf)) + hb-buf + head + post + hhea + maxp + OS/2 + cvt_ + prep + fpgm)) (define (directory this) (force (· this _directory))) @@ -124,6 +107,15 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js (define (hb-font this) (or (force (· this _hb-font)) (error 'hb-font-not-available))) (define (hb-buf this) (force (· this _hb-buf))) +(require "table-stream.rkt") +(define (head this) (_getTable this 'head)) +(define (post this) (_getTable this 'post)) +(define (hhea this) (_getTable this 'hhea)) +(define (OS/2 this) (_getTable this 'OS/2)) +(define (maxp this) (_getTable this 'maxp)) +(define (cvt_ this) (_getTable this 'cvt_)) +(define (prep this) (_getTable this 'prep)) +(define (fpgm this) (_getTable this 'fpgm)) ;; The unique PostScript name for this font (define/contract (postscriptName this) @@ -193,7 +185,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js ;; The height of capital letters above the baseline. (define/contract (capHeight this) (->m number?) - (if (send this has-table? #"OS/2") + (if (has-table? this #"OS/2") (· this OS/2 capHeight) (· this ascent))) @@ -204,7 +196,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js ;; The height of lower case letters in the font. (define/contract (xHeight this) (->m number?) - (if (send this has-table? #"OS/2") + (if (has-table? this #"OS/2") (· this OS/2 xHeight) 0)) @@ -230,24 +222,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js (+ttf-subset this)) -(define/contract (has-table? this tag) - ((or/c bytes? symbol?) . ->m . boolean?) - (hash-has-key? (· this directory tables) (match tag - [(? bytes?) (string->symbol (bytes->string/latin-1 tag))] - [_ tag]))) - -(define (has-cff-table? x) (has-table? x 'CFF_)) -(define (has-morx-table? x) (has-table? x 'morx)) -(define (has-gpos-table? x) (has-table? x 'GPOS)) -(define (has-gsub-table? x) (has-table? x 'GSUB)) - -(test-module - (check-false (· f has-cff-table?)) - (check-false (· f has-morx-table?)) - (check-false (· f has-gsub-table?)) - (check-false (· f has-gpos-table?))) - - ;; Returns a glyph object for the given glyph id. ;; You can pass the array of code points this glyph represents for ;; your use later, and it will be stored in the glyph object. @@ -418,8 +392,8 @@ https://github.com/mbutterick/fontkit/blob/master/src/base.js (test-module (check-equal? (measure-string f "f" (· f unitsPerEm)) 321.0) - (check-true (send f has-table? #"cmap")) - (check-exn exn:fail:contract? (λ () (send f _getTable 'nonexistent-table-tag))) + (check-true (has-table? f #"cmap")) + (check-exn exn:fail:contract? (λ () (_getTable f 'nonexistent-table-tag))) (check-true (let ([h (layout fira "Rifle" #:debug #t)]) (and (equal? (hash-ref h 'hb-gids) '(227 480 732 412)) diff --git a/fontland/fontland/subset.rkt b/fontland/fontland/subset.rkt index c077084c..ce2ed409 100644 --- a/fontland/fontland/subset.rkt +++ b/fontland/fontland/subset.rkt @@ -6,6 +6,7 @@ sugar/unstable/dict sugar/unstable/js "table/loca.rkt" + "table-stream.rkt" "directory.rkt" fontland/glyph fontland/ttf-glyph @@ -71,9 +72,9 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js (define ttf-glyf-data (glyph-decode glyph)) ;; get the offset to the glyph from the loca table - (match-define (list this-offset next-offset) (take (drop (· (subset-font ss) loca offsets) gid) 2)) + (match-define (list this-offset next-offset) (take (drop (hash-ref (dump (_getTable (subset-font ss) 'loca)) 'offsets) gid) 2)) - (define port (send (subset-font ss) _getTableStream 'glyf)) + (define port (_getTableStream (subset-font ss) 'glyf)) (pos port (+ (pos port) this-offset)) (define buffer (read-bytes (- next-offset this-offset) port)) @@ -105,6 +106,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js (define (clone-deep val) (deserialize (serialize val))) +(require racket/sequence) (define (encode ss port) #;(output-port? . ->m . void?) @@ -134,23 +136,29 @@ https://github.com/mbutterick/fontkit/blob/master/src/subset/TTFSubset.js (define hhea (clone-deep (· (subset-font ss) hhea to-hash))) (dict-set! hhea 'numberOfMetrics (length (· (ttf-subset-hmtx ss) metrics))) + (define table-mhash + (let ([mh (make-hasheq)]) + (define kvs (list 'head head + 'hhea hhea + 'loca (ttf-subset-loca ss) + 'maxp maxp + 'cvt_ (· (subset-font ss) cvt_) + 'prep (· (subset-font ss) prep) + 'glyf (ttf-subset-glyf ss) + 'hmtx (ttf-subset-hmtx ss) + 'fpgm (· (subset-font ss) fpgm))) + (for ([kv (in-slice 2 kvs)]) + (unless (second kv) + (error 'encode (format "missing value for ~a" (first kv)))) + (hash-set! mh (first kv) (second kv))) + mh)) - (send Directory encode port - (mhash 'tables - (mhash - 'head head - 'hhea hhea - 'loca (ttf-subset-loca ss) - 'maxp maxp - 'cvt_ (· (subset-font ss) cvt_) - 'prep (· (subset-font ss) prep) - 'glyf (ttf-subset-glyf ss) - 'hmtx (ttf-subset-hmtx ss) - 'fpgm (· (subset-font ss) fpgm)))) - - #;(report* (bytes-length (send stream dump)) (send stream dump)) - #;(report* (bytes-length (file->bytes "out.bin")) (file->bytes "out.bin")) + (send Directory encode port (mhash 'tables table-mhash)) + + #;(report* (bytes-length (send stream dump)) (send stream dump)) + #;(report* (bytes-length (file->bytes "out.bin")) (file->bytes "out.bin")) - (void) - ) + (void) + ) + \ No newline at end of file diff --git a/fontland/fontland/table-stream.rkt b/fontland/fontland/table-stream.rkt new file mode 100644 index 00000000..096f0881 --- /dev/null +++ b/fontland/fontland/table-stream.rkt @@ -0,0 +1,43 @@ +#lang racket +(require sugar/unstable/js + (only-in xenomorph pos decode) + "tables.rkt" + (for-syntax "tables.rkt")) +(provide (all-defined-out)) + +(define-syntax (define-table-getters stx) + (syntax-case stx () + [(_) + (with-syntax ([(TABLE-TAG ...) (hash-keys table-codecs)]) + #'(begin + (define (TABLE-TAG this) (_getTable this 'TABLE-TAG)) ...))])) + +(define (has-table? this tag) + #;((or/c bytes? symbol?) . ->m . boolean?) + (hash-has-key? (· this directory tables) (match tag + [(? bytes?) (string->symbol (bytes->string/latin-1 tag))] + [_ tag]))) + + + +(define (_getTable this table-tag) + (unless (has-table? this table-tag) + (raise-argument-error '_getTable "table that exists in font" table-tag)) + (hash-ref! (· this _decoded-tables) table-tag (λ () (_decodeTable this table-tag)))) + +(define-table-getters) + +(define (_getTableStream this tag) + (define table (hash-ref (· this directory tables) tag)) + (and table (pos (· this _port) (· table offset)) (· this _port))) + +(define (_decodeTable this table-tag) + (unless (hash-has-key? table-codecs table-tag) + (raise-argument-error '_decodeTable "decodable table" table-tag)) + (define table (hash-ref (· this directory tables) table-tag)) + ;; todo: possible to avoid copying the bytes here? + (pos (· this _port) (· table offset)) + (define table-bytes (open-input-bytes (peek-bytes (· table length) 0 (· this _port)))) + (define table-decoder (hash-ref table-codecs table-tag)) + (decode table-decoder table-bytes #:parent this)) + diff --git a/fontland/fontland/ttf-glyph.rkt b/fontland/fontland/ttf-glyph.rkt index 7129712e..886fe2be 100644 --- a/fontland/fontland/ttf-glyph.rkt +++ b/fontland/fontland/ttf-glyph.rkt @@ -1,4 +1,4 @@ -#lang racket/base +#lang debug racket/base (require (for-syntax racket/base) racket/match racket/list @@ -101,14 +101,15 @@ https://github.com/mbutterick/fontkit/blob/master/src/glyph/TTFGlyph.js ;; Decodes the glyph data into points for simple glyphs, ;; or components for composite glyphs +(require "table-stream.rkt") (define (glyph-decode ttfg) - (define offsets (· (glyph-font ttfg) loca offsets)) + (define offsets (hash-ref (dump (_getTable (glyph-font ttfg) 'loca)) 'offsets)) (match-define (list glyfPos nextPos) (take (drop offsets (glyph-id ttfg)) 2)) ;; Nothing to do if there is no data for this glyph (and (not (= glyfPos nextPos)) (let () - (define port (send (glyph-font ttfg) _getTableStream 'glyf)) + (define port (_getTableStream (glyph-font ttfg) 'glyf)) (pos port (+ (pos port) glyfPos)) (define startPos (pos port)) (define glyph-data (decode GlyfHeader port))