From 1d9f979e91903d8c6f223912f5499146cb5b19a6 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 27 Dec 2018 11:32:40 -0800 Subject: [PATCH] tidy --- pitfall/pitfall/document.rkt | 2 +- .../{embedded.rkt => embedded-font.rkt} | 69 ++++++++++--------- pitfall/pitfall/font-open.rkt | 20 ------ pitfall/pitfall/font.rkt | 14 ++-- pitfall/pitfall/fonts.rkt | 28 ++++---- pitfall/pitfall/standard-font.rkt | 18 ++--- 6 files changed, 64 insertions(+), 87 deletions(-) rename pitfall/pitfall/{embedded.rkt => embedded-font.rkt} (80%) delete mode 100644 pitfall/pitfall/font-open.rkt diff --git a/pitfall/pitfall/document.rkt b/pitfall/pitfall/document.rkt index d95a2e52..9c4bbd11 100644 --- a/pitfall/pitfall/document.rkt +++ b/pitfall/pitfall/document.rkt @@ -94,7 +94,7 @@ (ref-end doc-info) (for ([font (in-hash-values ($doc-font-families doc))]) - (send font end)) + (send font font-end)) (define pages-ref (dict-ref ($doc-root doc) 'Pages)) (dict-set! pages-ref 'Count (length ($doc-pages doc))) diff --git a/pitfall/pitfall/embedded.rkt b/pitfall/pitfall/embedded-font.rkt similarity index 80% rename from pitfall/pitfall/embedded.rkt rename to pitfall/pitfall/embedded-font.rkt index cd444e5f..b022b76f 100644 --- a/pitfall/pitfall/embedded.rkt +++ b/pitfall/pitfall/embedded-font.rkt @@ -12,7 +12,7 @@ sugar/unstable/dict "font.rkt" fontland) -(provide EmbeddedFont) +(provide embedded-font%) #| approximates @@ -32,14 +32,17 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee (for/list ([code (in-list codePoints)]) (~r code #:base 16 #:min-width 4 #:pad-string "0")))) -(define EmbeddedFont - (class PDFFont - (init-field font id) - (field [subset (create-subset font)] +(define embedded-font% + (class pdf-font% + (init-field name-in [id #f]) + (field [font (cond + [(string? name-in) (open-font name-in)] + [(path? name-in) (open-font (path->string name-in))])] + [subset (create-subset font)] ;; we make `unicode` and `width` fields integer-keyed hashes not lists ;; because they offer better random access and growability - [unicode (mhash 0 '(0))] ; always include the missing glyph (gid = 0) - [widths (mhash 0 (glyph-advance-width (get-glyph font 0)))] + [unicode (mhasheqv 0 '(0))] ; always include the missing glyph (gid = 0) + [widths (mhasheqv 0 (glyph-advance-width (get-glyph font 0)))] ;; always include the width of the missing glyph (gid = 0) [name (font-postscript-name font)] [scale (/ 1000 (font-units-per-em font))]) @@ -49,6 +52,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee [line-gap (* (font-linegap font) scale)]) (inherit-field [@ascender ascender] + [@bbox bbox] [@descender descender] [@dictionary dictionary]) @@ -94,9 +98,11 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee (ref-write font-file (get-output-bytes (encode-to-port subset))) (ref-end font-file) - (define family-class (if (has-table? font 'OS/2) - (floor (/ (hash-ref (get-OS/2-table font) 'sFamilyClass) 256)) ; >> 8 - 0)) + (define family-class + (if (has-table? font 'OS/2) + (floor (/ (hash-ref (get-OS/2-table font) 'sFamilyClass) 256)) ; >> 8 + 0)) + ;; font descriptor flags (match-define (list FIXED_PITCH SERIF SYMBOLIC SCRIPT _UNUSED NONSYMBOLIC ITALIC) (map (λ (x) (expt 2 x)) (range 7))) @@ -113,18 +119,16 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee (define tag (list->string (for/list ([i (in-range 6)]) (integer->char (random 65 (+ 65 26)))))) (define name (string->symbol (string-append tag "+" (font-postscript-name font)))) - (define bbox (font-bbox font)) (define descriptor (make-ref - (mhash + (mhasheq 'Type 'FontDescriptor 'FontName name 'Flags flags - 'FontBBox (map (λ (x) (* scale x)) - (bbox->list bbox)) + 'FontBBox (map (λ (x) (* scale x)) (bbox->list @bbox)) 'ItalicAngle (font-italic-angle font) 'Ascent @ascender 'Descent @descender - 'CapHeight (* (or (font-cap-height font) (font-ascent font)) scale) + 'CapHeight (* (or (font-cap-height font) @ascender) scale) 'XHeight (* (or (font-x-height font) 0) scale) 'StemV 0))) @@ -132,12 +136,12 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee (ref-end descriptor) (define descendant-font (make-ref - (mhash + (mhasheq 'Type 'Font - 'Subtype (string->symbol (string-append "CIDFontType" (if isCFF "0" "2"))) + 'Subtype (if isCFF 'CIDFontType0 'CIDFontType2) 'BaseFont name 'CIDSystemInfo - (mhash + (mhasheq 'Registry "Adobe" 'Ordering "Identity" 'Supplement 0) @@ -146,18 +150,18 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee (hash-ref widths idx (λ () (error 'embed (format "hash key ~a not found" idx))))))))) (ref-end descendant-font) - [dict-set! @dictionary 'Type 'Font] - [dict-set! @dictionary 'Subtype 'Type0] - [dict-set! @dictionary 'BaseFont name] - [dict-set! @dictionary 'Encoding 'Identity-H] - [dict-set! @dictionary 'DescendantFonts (list descendant-font)] - [dict-set! @dictionary 'ToUnicode (toUnicodeCmap)] + (dict-set*! @dictionary + 'Type 'Font + 'Subtype 'Type0 + 'BaseFont name + 'Encoding 'Identity-H + 'DescendantFonts (list descendant-font) + 'ToUnicode (to-unicode-cmap)) (ref-end @dictionary)) - - (define/public (toUnicodeCmap) - (define cmap (make-ref)) + (define/public (to-unicode-cmap) + (define cmap-ref (make-ref)) (define entries (for/list ([idx (in-range (length (hash-keys unicode)))]) (define codepoints (hash-ref unicode idx)) @@ -191,19 +195,18 @@ end HERE ) - (ref-write cmap (format unicode-cmap-str (to-hex (sub1 (length entries))) (string-join entries " "))) - (ref-end cmap) - cmap))) + (ref-write cmap-ref (format unicode-cmap-str (to-hex (sub1 (length entries))) (string-join entries " "))) + (ref-end cmap-ref) + cmap-ref))) (module+ test (require rackunit fontland sugar/unstable/js) - (define f (open-font "../ptest/assets/charter.ttf")) - (define ef (make-object EmbeddedFont f #f)) + (define ef (make-object embedded-font% "../ptest/assets/charter.ttf")) (check-equal? (send ef string-width "f" 1000) 321.0) (check-equal? (· ef ascender) 980) (check-equal? (· ef descender) -238) (check-equal? (· ef line-gap) 0) (check-equal? (bbox->list (· ef bbox)) '(-161 -236 1193 963)) (define H-gid 41) - (check-equal? (· ef widths) (mhash 0 278)) + (check-equal? (· ef widths) (mhasheqv 0 278)) (check-equal? (glyph-advance-width (get-glyph (· ef font) H-gid)) 738)) \ No newline at end of file diff --git a/pitfall/pitfall/font-open.rkt b/pitfall/pitfall/font-open.rkt deleted file mode 100644 index e1b6e119..00000000 --- a/pitfall/pitfall/font-open.rkt +++ /dev/null @@ -1,20 +0,0 @@ -#lang racket/base -(require - racket/class - "standard-font.rkt" - "font.rkt" - fontland - "embedded.rkt") -(provide PDFFont-open) - -(define (PDFFont-open src family id) - (cond - [(and (string? src) (standard-font? src)) (make-object StandardFont src id)] - [else - (define font - (cond - [(string? src) (open-font src)] - [(path? src) (open-font (path->string src))] - ;; todo: other font-loading cases - [else (raise-argument-error 'PDFFont-open "loadable font thingy" src)])) - (make-object EmbeddedFont font id)])) diff --git a/pitfall/pitfall/font.rkt b/pitfall/pitfall/font.rkt index 495752ca..47fca603 100644 --- a/pitfall/pitfall/font.rkt +++ b/pitfall/pitfall/font.rkt @@ -1,8 +1,11 @@ #lang racket/base (require racket/class "reference.rkt") -(provide PDFFont) +(provide pdf-font%) -(define PDFFont +;; 181227 structifying the fonts didn't do anything for speed +;; the class is implementation is equally fast, and less code + +(define pdf-font% (class object% (super-new) (init-field [(@ascender ascender) #f] @@ -19,7 +22,7 @@ (set! @dictionary (make-ref))) @dictionary) - (define/public (end) + (define/public (font-end) (unless (or @embedded (not @dictionary)) (embed) (set! @embedded #t))) @@ -27,8 +30,3 @@ (define/public (line-height size [include-gap #f]) (define gap (if include-gap @line-gap 0)) (* (/ (+ @ascender gap (- @descender)) 1000.0) size)))) - - - - - diff --git a/pitfall/pitfall/fonts.rkt b/pitfall/pitfall/fonts.rkt index 65ca1283..65ec6a8a 100644 --- a/pitfall/pitfall/fonts.rkt +++ b/pitfall/pitfall/fonts.rkt @@ -1,31 +1,28 @@ #lang debug racket/base (require "core.rkt" - racket/class racket/match - sugar/unstable/dict - "font-open.rkt") + racket/class + "standard-font.rkt" + "embedded-font.rkt") (provide (all-defined-out)) +(define (open-pdf-font name id) + (make-object (if (standard-font-name? name) standard-font% embedded-font%) name id)) + (define (current-line-height doc [include-gap #f]) (send ($doc-current-font doc) line-height ($doc-current-font-size doc) include-gap)) -(define (font doc src [size-or-family #f] [maybe-size #f]) - (match-define (list family size) - (match size-or-family - [(? number?) (list #f size-or-family)] - [_ (list size-or-family maybe-size)])) +(define (font doc src [size #f]) ;; check registered fonts if src is a string (define cache-key (match src [(? string?) #:when (hash-has-key? ($doc-registered-fonts doc) src) (define ck src) (set! src (hash-ref (hash-ref ($doc-registered-fonts doc) ck) 'src)) - (set! family (hash-ref (hash-ref ($doc-registered-fonts doc) ck) 'family)) ck] - [_ (match (or family src) - [(? string? str) str] - [_ #false])])) + [(? string?) src] + [_ #false])) (when size (font-size doc size)) @@ -34,7 +31,7 @@ [_ ; if not, load the font (define font-index (add1 (length (hash-keys ($doc-font-families doc))))) (define id (string->symbol (format "F~a" font-index))) - (set-$doc-current-font! doc (PDFFont-open src family id)) + (set-$doc-current-font! doc (open-pdf-font src id)) ;; check for existing font families with the same name already in the PDF (match (hash-ref ($doc-font-families doc) (get-field name ($doc-current-font doc)) #f) [(? values font) (set-$doc-current-font! doc font)] @@ -47,7 +44,6 @@ (set-$doc-current-font-size! doc size) doc) -(define (register-font doc name src [family #f]) - (hash-set! ($doc-registered-fonts doc) name (make-hash (list (cons 'src src) - (cons 'family family)))) +(define (register-font doc name src) + (hash-set! ($doc-registered-fonts doc) name (make-hasheq (list (cons 'src src)))) doc) diff --git a/pitfall/pitfall/standard-font.rkt b/pitfall/pitfall/standard-font.rkt index 39ca4883..86e6fe3e 100644 --- a/pitfall/pitfall/standard-font.rkt +++ b/pitfall/pitfall/standard-font.rkt @@ -12,12 +12,12 @@ racket/list with-cache) -(provide standard-font? StandardFont) +(provide standard-font-name? standard-font%) (define-runtime-path here ".") -(define StandardFont - (class PDFFont +(define standard-font% + (class pdf-font% (init-field name id) (match-define (list atts gws kps) (parse-afm (open-input-file (build-path here (format "data/~a.afm" name))))) @@ -95,16 +95,16 @@ Times-Roman ZapfDingbats))) -(define (standard-font? name) (and (member name standard-fonts) #t)) +(define (standard-font-name? name) (and (string? name) (member name standard-fonts) #t)) (module+ test (require rackunit) - (check-true (standard-font? "Helvetica")) - (check-true (standard-font? "Courier")) - (check-true (standard-font? "ZapfDingbats")) - (check-false (standard-font? "Not A Font Name")) + (check-true (standard-font-name? "Helvetica")) + (check-true (standard-font-name? "Courier")) + (check-true (standard-font-name? "ZapfDingbats")) + (check-false (standard-font-name? "Not A Font Name")) - (define stdfont (make-object StandardFont "Helvetica" #f))) + (define stdfont (make-object standard-font% "Helvetica" #f))) (define (make-kern-table-key left right)