diff --git a/fontland/fontland/font.rkt b/fontland/fontland/font.rkt index ffcfaf76..cf8a3a79 100644 --- a/fontland/fontland/font.rkt +++ b/fontland/fontland/font.rkt @@ -5,6 +5,7 @@ "bbox.rkt" "glyphrun.rkt" "directory.rkt" + "woff-directory.rkt" "struct.rkt" "table-stream.rkt" xenomorph @@ -17,13 +18,15 @@ racket/promise) (provide (all-defined-out)) + + +(define ft-library (delay (FT_Init_FreeType))) + #| approximates https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js |# -(define ft-library (delay (FT_Init_FreeType))) - (define (+ttf-font port [decoded-tables (mhash)] [src (path->string (object-name port))] @@ -68,6 +71,30 @@ https://github.com/mbutterick/fontkit/blob/master/src/TTFFont.js (hash-ref head-table 'xMax) (hash-ref head-table 'yMax))) +#| +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) + ;; 181228: disk-based caching (either with sqlite or `with-cache`) is a loser ;; reads & writes aren't worth it vs. recomputing ;; (though this is good news, as it avoids massive disk caches hanging around) @@ -109,14 +136,6 @@ approximates https://github.com/mbutterick/fontkit/blob/master/src/index.js |# -;; Register font formats -(define font-formats (list +ttf-font)) -;;fontkit.registerFormat(WOFFFont); ;; todo -;;fontkit.registerFormat(WOFF2Font); ;; todo -;;fontkit.registerFormat(TrueTypeCollection); ;; todo -;;fontkit.registerFormat(DFont); ;; todo - - #| approximates https://github.com/mbutterick/fontkit/blob/master/src/base.js @@ -124,40 +143,39 @@ https://github.com/mbutterick/fontkit/blob/master/src/base.js (define (open-font str-or-path) (define filename (if (path? str-or-path) (path->string str-or-path) str-or-path)) - (create-font (open-input-file filename))) + (define port (open-input-file filename)) + ;; rather than use a `probe` function, + ;; just try making a font with each format and see what happens + (or + (for/or ([font-constructor (in-list (list +ttf-font +woff-font))]) + (with-handlers ([probe-fail? (λ (exn) #f)]) + (font-constructor port))) + (error 'create-font "unknown font format"))) (struct probe-fail exn ()) (define (do-probe-fail!) (raise (probe-fail "fail" (current-continuation-marks)))) -(define (create-font port) - (or - ;; rather than use a `probe` function, - ;; just try making a font with each format and see what happens - (for/first ([font-format (in-list font-formats)]) - (with-handlers ([probe-fail? (λ (exn) #f)]) - (font-format port))) - (error 'create-font "unknown font format"))) - (module+ test (require rackunit racket/struct racket/vector) (define charter (open-font charter-path)) + (define charter-woff (open-font charter-woff-path)) (define fira (open-font (path->string fira-path))) (define otf (open-font (path->string fira-otf-path))) - (check-equal? (font-postscript-name charter) "Charter") - (check-equal? (font-units-per-em charter) 1000) - (check-equal? (font-ascent charter) 980) - (check-equal? (font-descent charter) -238) - (check-equal? (font-linegap charter) 0) - (check-equal? (font-underline-position charter) -178) - (check-equal? (font-underline-thickness charter) 58) - (check-equal? (font-italic-angle charter) 0) - (check-equal? (font-cap-height charter) 671) - (check-equal? (font-x-height charter) 481) - (check-equal? (bbox->list (font-bbox charter)) '(-161 -236 1193 963)) - (check-equal? (glyph-position-x-advance (vector-ref (glyphrun-positions (layout charter "f")) 0)) 321) - (check-true (has-table? charter #"cmap")) - (check-exn exn:fail:contract? (λ () (get-table charter 'nonexistent-table-tag))) + (for ([charter (list charter charter-woff)]) + (check-equal? (font-postscript-name charter) "Charter") + (check-equal? (font-units-per-em charter) 1000) + (check-equal? (font-ascent charter) 980) + (check-equal? (font-descent charter) -238) + (check-equal? (font-linegap charter) 0) + (check-equal? (font-underline-thickness charter) 58) + (check-equal? (font-italic-angle charter) 0) + (check-equal? (font-cap-height charter) 671) + (check-equal? (font-x-height charter) 481) + (check-equal? (bbox->list (font-bbox charter)) '(-161 -236 1193 963)) + (check-equal? (glyph-position-x-advance (vector-ref (glyphrun-positions (layout charter "f")) 0)) 321) + (check-true (has-table? charter #"cmap")) + (check-exn exn:fail:contract? (λ () (get-table charter 'nonexistent-table-tag)))) (check-true (let ([gr (layout fira "Rifle")]) (and (equal? (vector-map glyph-id (glyphrun-glyphs gr)) '#(227 480 732 412)) diff --git a/fontland/fontland/main.rkt b/fontland/fontland/main.rkt index b8165e1e..0306534b 100644 --- a/fontland/fontland/main.rkt +++ b/fontland/fontland/main.rkt @@ -12,4 +12,5 @@ "glyph.rkt" "table-stream.rkt" "subset.rkt" - "struct.rkt") \ No newline at end of file + "struct.rkt" + "zlib.rkt") \ No newline at end of file diff --git a/fontland/fontland/table-stream.rkt b/fontland/fontland/table-stream.rkt index 36a79c15..67393449 100644 --- a/fontland/fontland/table-stream.rkt +++ b/fontland/fontland/table-stream.rkt @@ -2,6 +2,7 @@ (require xenomorph "tables.rkt" "struct.rkt" + "zlib.rkt" (for-syntax "tables.rkt")) (provide (all-defined-out)) @@ -34,7 +35,11 @@ (define (get-table-stream this tag) (define directory (force (ttf-font-directory this))) (define table (hash-ref (hash-ref directory 'tables) tag)) - (and table (pos (ttf-font-port this) (hash-ref table 'offset)) (ttf-font-port this))) + (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)))) (define (decode-table this table-tag) (unless (hash-has-key? table-codecs table-tag) diff --git a/fontland/fontland/zlib.rkt b/fontland/fontland/zlib.rkt new file mode 100644 index 00000000..1a223d74 --- /dev/null +++ b/fontland/fontland/zlib.rkt @@ -0,0 +1,31 @@ +#lang racket/base + +(provide deflate inflate) + +;; see https://groups.google.com/d/topic/racket-users/3CvjHLAmwSQ/discussion +;; for discrepancies between gzip gunzip and zlib + +(require (prefix-in gzip: file/gzip) + (prefix-in gunzip: file/gunzip) png-image) + +(define (deflate bstr) + ;; https://www.ietf.org/rfc/rfc1950.txt + (define rfc-1950-header (bytes #x78 #x9c)) + (define op (open-output-bytes)) + (gzip:deflate (open-input-bytes bstr) op) + (bytes-append rfc-1950-header + (get-output-bytes op) + (integer->integer-bytes (bytes-adler32 bstr) 4 #f 'want-big-endian))) + +(define (inflate bstr) + (define op (open-output-bytes)) + (gunzip:inflate (open-input-bytes (subbytes bstr 2)) op) + (get-output-bytes op)) + +(module+ test + (require rackunit) + (for ([i (in-range 100)]) + (define random-bytes + (apply bytes (for/list ([bidx (in-range 100)]) + (random 256)))) + (check-equal? random-bytes (inflate (deflate random-bytes))))) \ No newline at end of file