From d00515059f3eca0a8aa26139b6bcae29cc471323 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 23 May 2019 07:37:30 -0700 Subject: [PATCH] simplify woffing --- fontland/fontland/directory.rkt | 4 +-- fontland/fontland/font.rkt | 55 ++++++++++++------------------ fontland/fontland/table-stream.rkt | 7 ++-- 3 files changed, 28 insertions(+), 38 deletions(-) diff --git a/fontland/fontland/directory.rkt b/fontland/fontland/directory.rkt index 1ab26478..c961ee73 100644 --- a/fontland/fontland/directory.rkt +++ b/fontland/fontland/directory.rkt @@ -55,7 +55,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js 'rangeShift (- (* numTables 16) searchRange)) this-val) -(define Directory (x:struct #:pre-encode directory-pre-encode +(define directory (x:struct #:pre-encode directory-pre-encode #:post-decode directory-post-decode 'tag (x:symbol #:length 4) 'numTables uint16be @@ -65,7 +65,7 @@ https://github.com/mbutterick/fontkit/blob/master/src/tables/directory.js 'tables (x:array #:type table-entry #:length (λ (p) (hash-ref p 'numTables))))) (define (directory-decode ip [options (mhash)]) - (decode Directory ip)) + (decode directory ip)) (define (file-directory-decode ps) (directory-decode (open-input-file ps))) diff --git a/fontland/fontland/font.rkt b/fontland/fontland/font.rkt index cf8a3a79..9603c996 100644 --- a/fontland/fontland/font.rkt +++ b/fontland/fontland/font.rkt @@ -27,23 +27,30 @@ approximates https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js |# +(struct probe-fail exn ()) + (define (+ttf-font port - [decoded-tables (mhash)] - [src (path->string (object-name port))] - [directory (delay (decode Directory port #:parent (mhash x:start-offset-key 0)))] - [ft-face (delay (and src (FT_New_Face (force ft-library) src)))] - [hb-font (delay (and src (hb_ft_font_create (force ft-face))))] - [hb-buf (delay (hb_buffer_create))] - [crc (equal-hash-code port)] - [get-head-table-proc #f]) + #:directory [directory-class directory] + #:probe [probe-vals (list #"true" #"OTTO" (bytes 0 1 0 0))]) + (unless (input-port? port) (raise-argument-error '+ttf-font "input port" port)) - (unless (member (peek-bytes 4 0 port) (list #"true" #"OTTO" (bytes 0 1 0 0))) - (do-probe-fail!)) + (unless (member (peek-bytes 4 0 port) probe-vals) + (raise (probe-fail "fail" (current-continuation-marks)))) + + (define decoded-tables (mhash)) + (define src (path->string (object-name port))) + (define directory (delay (decode directory-class port #:parent (mhash x:start-offset-key 0)))) + (define ft-face (delay (and src (FT_New_Face (force ft-library) src)))) + (define hb-font (delay (and src (hb_ft_font_create (force ft-face))))) + (define hb-buf (delay (hb_buffer_create))) + (define crc (equal-hash-code port)) + (define get-head-table-proc #f) + (define font (ttf-font port decoded-tables src directory ft-face hb-font hb-buf crc get-head-table-proc)) ;; needed for `loca` table decoding cross-reference - (set-ttf-font-get-head-table-proc! font (delay (get-head-table font))) + (set-ttf-font-get-head-table-proc! font (delay (get-head-table font))) font) (define (font-postscript-name font) (FT_Get_Postscript_Name (ft-face font))) @@ -76,24 +83,10 @@ approximates https://github.com/mbutterick/fontkit/blob/master/src/WOFFFont.js |# -(define (+woff-font port - [decoded-tables (mhash)] - [src (path->string (object-name port))] - [directory (delay (decode woff-directory port #:parent (mhash x:start-offset-key 0)))] - [ft-face (delay (and src (FT_New_Face (force ft-library) src)))] - [hb-font (delay (and src (hb_ft_font_create (force ft-face))))] - [hb-buf (delay (hb_buffer_create))] - [crc (equal-hash-code port)] - [get-head-table-proc #f]) - (unless (input-port? port) - (raise-argument-error '+woff-font "input port" port)) - (unless (member (peek-bytes 4 0 port) (list #"wOFF")) - (do-probe-fail!)) - (define font - (ttf-font port decoded-tables src directory ft-face hb-font hb-buf crc get-head-table-proc)) - ;; needed for `loca` table decoding cross-reference - (set-ttf-font-get-head-table-proc! font (delay (get-head-table font))) - font) +(define (+woff-font port) + (+ttf-font port + #:directory woff-directory + #:probe (list #"wOFF"))) ;; 181228: disk-based caching (either with sqlite or `with-cache`) is a loser ;; reads & writes aren't worth it vs. recomputing @@ -152,10 +145,6 @@ https://github.com/mbutterick/fontkit/blob/master/src/base.js (font-constructor port))) (error 'create-font "unknown font format"))) -(struct probe-fail exn ()) -(define (do-probe-fail!) - (raise (probe-fail "fail" (current-continuation-marks)))) - (module+ test (require rackunit racket/struct racket/vector) (define charter (open-font charter-path)) diff --git a/fontland/fontland/table-stream.rkt b/fontland/fontland/table-stream.rkt index 67393449..004c5f20 100644 --- a/fontland/fontland/table-stream.rkt +++ b/fontland/fontland/table-stream.rkt @@ -37,9 +37,10 @@ (define table (hash-ref (hash-ref directory 'tables) tag)) (and table (pos (ttf-font-port this) (hash-ref table 'offset)) - (if (< (hash-ref table 'compLength +inf.0) (hash-ref table 'length)) - (open-input-bytes (inflate (peek-bytes (hash-ref table 'compLength) 0 (ttf-font-port this)))) - (ttf-font-port this)))) + (let ([maybe-woff-compLength (hash-ref table 'compLength #f)]) + (if (and maybe-woff-compLength (< maybe-woff-compLength (hash-ref table 'length))) + (open-input-bytes (inflate (peek-bytes maybe-woff-compLength 0 (ttf-font-port this)))) + (ttf-font-port this))))) (define (decode-table this table-tag) (unless (hash-has-key? table-codecs table-tag)