methodize fonts

main
Matthew Butterick 6 years ago
parent 83b7d0b51a
commit 8bc4109a91

@ -19,9 +19,13 @@
(define current-pdf-version (make-parameter 1.3))
(define current-auto-first-page (make-parameter #t))
(define current-auto-helvetica (make-parameter #t))
(define current-default-margins (make-parameter (margin 72 72 72 72)))
(define current-font (make-parameter #f))
(define current-font-size (make-parameter 12))
;; helpers
(define (numberizer x #:round [round? #true])

@ -37,9 +37,8 @@
'CreationDate (seconds->date (if (test-mode) 0 (current-seconds)) #f))])
;; initialize mixins
(inherit-field @ctm) ; from vector
(send this initFonts)
(inherit-field @font-families)
(inherit-field @ctm) ; from vector mixin
(inherit-field @font-families) (inherit font) ; from font mixin
(send this initText)
(send this initImages)
@ -47,10 +46,11 @@
(current-compress-streams? (hash-ref @options 'compress #t))
(current-auto-first-page (hash-ref @options 'autoFirstPage #t))
(when (current-auto-first-page) (add-page))
(when (current-auto-helvetica) (font "Helvetica"))
;; copy options
(for ([(key val) (in-hash (hash-ref @options 'info (hasheq)))])
(hash-set! @info key val))
(hash-set! @info key val))
(define/public (page) (first @pages))
@ -82,15 +82,15 @@
(write-bytes-out "%ÿÿÿÿ")
(for ([page (in-list @pages)])
(send page end))
(send page end))
(define doc-info (ref))
(for ([(key val) (in-hash @info)])
(send doc-info set-key! key (if (string? val) (String val) val)))
(send doc-info set-key! key (if (string? val) (String val) val)))
(send doc-info end)
(for ([font (in-hash-values @font-families)])
(send font finalize))
(send font finalize))
(send* (send @root get-key 'Pages)
[set-key! 'Count (length @pages)]
@ -104,8 +104,8 @@
(write-bytes-out (format "0 ~a" (add1 (length @refs))))
(write-bytes-out "0000000000 65535 f ")
(for ([ref (in-list (reverse @refs))])
(write-bytes-out
(string-append (~r (get-field offset ref) #:min-width 10 #:pad-string "0") " 00000 n ")))
(write-bytes-out
(string-append (~r (get-field offset ref) #:min-width 10 #:pad-string "0") " 00000 n ")))
(write-bytes-out "trailer")
(write-bytes-out (convert (mhasheq 'Size (add1 (length @refs))
'Root @root

@ -12,97 +12,57 @@
(define (fonts-mixin [% mixin-tester%])
(class %
(super-new)
;; Lookup table for embedded fonts
(field [@font-families #f]
[_fontCount #f]
;; Font state
[_fontSize #f]
[_font #f]
[_registeredFonts #f])
(field [@font-families (mhash)]
[@font-count 0]
[(@current-font-size current-font-size) 12] ; font state used by text.rkt
[(@current-font current-font) #f] ; font state used by text.rkt
[@registered-fonts (mhash)])
(define/public (font 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)]))
;; check registered fonts if src is a string
(define cache-key (match src
[(? string?) #:when (hash-has-key? @registered-fonts src)
(define ck src)
(set! src (· (hash-ref @registered-fonts ck) src))
(set! family (· (hash-ref @registered-fonts ck) family))
ck]
[_ (match (or family src)
[(? string? str) str]
[_ #false])]))
(when size (font-size size))
(cond ;; fast path: check if the font is already in the PDF
[(hash-ref @font-families cache-key #f)
=> (λ (val) (set! @current-font val))]
[else ;; load the font
(set! @font-count (add1 @font-count))
(define id (format "F~a" @font-count))
(set! @current-font (PDFFont-open this src family id))
;; check for existing font familes with the same name already in the PDF
;; useful if the font was passed as a buffer
(match (hash-ref @font-families (· @current-font name) #f)
[(? values font) (set! @current-font font)]
[_ ;; save the font for reuse later
(when cache-key (hash-set! @font-families cache-key @current-font))
(hash-set! @font-families (· @current-font name) @current-font)])])
this)
(define/public (font-size size)
(set! @current-font-size size)
this)
(define/public (current-line-height [includeGap #f])
(send @current-font lineHeight @current-font-size includeGap))
(define/public (register-font name src [family #f])
(hash-set! @registered-fonts name
(mhash 'src src 'family family))
this)))
(as-methods
initFonts
font
fontSize
currentLineHeight
registerFont)))
(define/contract (initFonts this)
(->m void?)
(set-field! @font-families this (mhash))
(set-field! _fontCount this 0)
(set-field! _fontSize this 12)
(set-field! _font this #f)
(set-field! _registeredFonts this (mhash))
;; set the default font
(send this font "Helvetica")
(void))
(define/contract (font this src [size-or-family #f] [maybe-size #f])
((any/c) ((or/c string? number? #f) (or/c number? #f)) . ->*m . object?)
(match-define (list family size) (if (number? size-or-family)
(list #f size-or-family)
(list size-or-family maybe-size)))
;; check registered fonts if src is a string
(define cacheKey (let ([this-rfs (· this _registeredFonts)])
(cond
[(and (string? src) (hash-has-key? this-rfs src))
(define ck src)
(set! src (· (hash-ref this-rfs ck) src))
(set! family (· (hash-ref this-rfs ck) family))
ck]
[else (let ([ck (or family src)])
(and (string? ck) ck))])))
(when size (fontSize this size))
;; fast path: check if the font is already in the PDF
(cond
[(hash-ref (· this @font-families) cacheKey #f) =>
(λ (val)
(set-field! _font this val))]
;; load the font
[else
#;(println (format "Load font: ~a" src))
(define id (format "F~a" (increment-field! _fontCount this)))
(set-field! _font this (PDFFont-open this src family id))
;; check for existing font familes with the same name already in the PDF
;; useful if the font was passed as a buffer
(let* ([this-ff (· this @font-families)]
[this-f (· this _font)]
[font (hash-ref this-ff (· this-f name) #f)])
(cond
[font (set-field! _font this font)]
;; save the font for reuse later
[else
(when cacheKey (hash-set! this-ff cacheKey this-f))
(hash-set! this-ff (· this-f name) this-f)]))])
this)
(define/contract (fontSize this size)
(number? . ->m . object?)
(set-field! _fontSize this size)
this)
(define/contract (currentLineHeight this [includeGap #f])
(() (boolean?) . ->*m . number?)
(send (· this _font) lineHeight (· this _fontSize) includeGap))
(define/contract (registerFont this name src [family #f])
((string? path-string?) ((or/c string? #f)) . ->*m . object?)
(hash-set! (· this _registeredFonts) name
(mhash 'src src 'family family))
this)
(module+ test
(define fo (new (fonts-mixin))))

@ -52,7 +52,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
(define/contract (moveDown this [lines 1] #:factor [factor 1])
(() (number? #:factor number?) . ->*m . object?)
(increment-field! y this (* factor (send this currentLineHeight #t) (+ lines (· this _line-gap))))
(increment-field! y this (* factor (send this current-line-height #t) (+ lines (· this _line-gap))))
this)
@ -89,7 +89,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
(define/contract (widthOfString this str [options (mhash)])
((string?) (hash?) . ->*m . number?)
#;(report str 'measuring-width-of)
(+ (send (· this _font) widthOfString str (· this _fontSize) (hash-ref options 'features #f))
(+ (send (· this current-font) widthOfString str (· this current-font-size) (hash-ref options 'features #f))
(* (hash-ref options 'characterSpacing 0) (sub1 (string-length str)))))
@ -128,7 +128,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
;; 181120 unsuppress the size tracking for now because it breaks test 04
(if (not wrapper)
(increment-field! x this (send this widthOfString text))
(increment-field! y (+ (send this currentLineHeight #t) line-gap)))
(increment-field! y (+ (send this current-line-height #t) line-gap)))
(void))
@ -150,7 +150,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
;; create link annotations if the link option is given
(when (· options link)
(send this link x y-in (force renderedWidth) (· this currentLineHeight) (· options link)))
(send this link x y-in (force renderedWidth) (· this current-line-height) (· options link)))
;; create underline or strikethrough line
@ -159,12 +159,12 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
(unless (· options stroke)
(define fill-colorArgs (· this @current-fill-color))
(send this stroke-color . fill-colorArgs))
(define line-width (if (< (· this _fontSize) 10)
(define line-width (if (< (· this current-font-size) 10)
0.5
(floor (/ (· this _fontSize) 10))))
(floor (/ (· this current-font-size) 10))))
(send this line-width line-width)
(define d (if (· options underline) 1 2))
(define lineY (+ y-in (/ (· this currentLineHeight) d)))
(define lineY (+ y-in (/ (· this current-line-height) d)))
(when (· options underline)
(increment! lineY (- line-width)))
@ -176,10 +176,10 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
;; flip coordinate system
(send this save)
(send this transform 1 0 0 -1 0 (· this page height))
(define y (- (· this page height) y-in (* (/ (· this _font ascender) 1000) (· this _fontSize))))
(define y (- (· this page height) y-in (* (/ (· this current-font ascender) 1000) (· this current-font-size))))
;; add current font to page if necessary
(hash-ref! (· this page fonts) (· this _font id) (λ () (· this _font ref)))
(hash-ref! (· this page fonts) (· this current-font id) (λ () (· this current-font ref)))
;; begin the text object
(send this addContent "BT")
@ -188,7 +188,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
(send this addContent (format "1 0 0 1 ~a ~a Tm" (number x) (number y)))
;; font and font size
(send this addContent (format "/~a ~a Tf" (· this _font id) (number (· this _fontSize))))
(send this addContent (format "/~a ~a Tf" (· this current-font id) (number (· this current-font-size))))
;; rendering mode
(let ([mode (cond
@ -211,9 +211,9 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
(match-define (list encoded-char-strs positions)
(if (not (zero? wordSpacing))
(error 'unimplemented-brach) ; todo
(send (· this _font) encode text (hash-ref options 'features #f))))
(send (· this current-font) encode text (hash-ref options 'features #f))))
(define scale (/ (· this _fontSize) 1000.0))
(define scale (/ (· this current-font-size) 1000.0))
(define commands empty)
(define last 0)

@ -5,12 +5,12 @@
(define (proc doc)
;; Register a font name for use later
(send doc registerFont "Charter" (path->string charter-path))
(send doc register-font "Charter" (path->string charter-path))
;; Set the font, draw some text
(send* doc
[font "Charter"]
[fontSize 25]
[font-size 25]
[text "Some text with an embedded font" 100 100 (hash
'width #f)]))

@ -5,12 +5,12 @@
(define (proc doc)
;; Register a font name for use later
(send doc registerFont "Charter" (path->string charter-path))
(send doc register-font "Charter" (path->string charter-path))
;; Set the font, draw some text
(send* doc
[font "Charter"]
[fontSize 25]
[font-size 25]
[text "Åcçénts äre în" 100 100 (hash 'width #f)]))
;; test against non-subsetted font version

@ -6,12 +6,12 @@
(define (proc doc)
;; Register a font name for use later
(send doc registerFont "the-font" (path->string ttf-path))
(send doc register-font "the-font" (path->string ttf-path))
;; Set the font, draw some text
(send* doc
[font "the-font"]
[fontSize 25]
[font-size 25]
[text "Hola Hola" 100 100 (hash 'width #f)]))
;; test against non-subsetted font version

@ -7,12 +7,12 @@
(define (proc doc)
;; Register a font name for use later
(send doc registerFont "the-font" (path->string ttf-path))
(send doc register-font "the-font" (path->string ttf-path))
;; Set the font, draw some text
(send* doc
[font "the-font"]
[fontSize 25]
[font-size 25]
[text "HTAVATH" 100 100 (hash 'width #f)]))

@ -7,12 +7,12 @@
(define (proc doc)
;; Register a font name for use later
(send doc registerFont "the-font" (path->string ttf-path))
(send doc register-font "the-font" (path->string ttf-path))
;; Set the font, draw some text
(send* doc
[font "the-font"]
[fontSize 100]
[font-size 100]
[text "Wofine" 100 100 (hash 'width #f)]))

@ -7,12 +7,12 @@
(define (proc doc)
;; Register a font name for use later
(send doc registerFont "the-font" (path->string ttf-path))
(send doc register-font "the-font" (path->string ttf-path))
;; Set the font, draw some text
(send* doc
[font "the-font"]
[fontSize 50]
[font-size 50]
[text "The fifth rifle" 100 100 (hash 'width #f)]))

@ -7,12 +7,12 @@
(define (proc doc)
;; Register a font name for use later
(send doc registerFont "the-font" (path->string ttf-path))
(send doc register-font "the-font" (path->string ttf-path))
;; Set the font, draw some text
(send* doc
[font "the-font"]
[fontSize 25]
[font-size 25]
[text "In Xanadu did Kubla Khan" 100 100 (hash 'width #f)]
[text "A stately pleasure dome decree:" 100 140 (hash 'width #f)]
[text "Where Alph, the sacred river, ran" 100 180 (hash 'width #f)]

@ -8,12 +8,12 @@
(define (proc doc)
;; Register a font name for use later
(send doc registerFont "the-font" (path->string ttf-path))
(send doc register-font "the-font" (path->string ttf-path))
;; Set the font, draw some text
(send* doc
[font "the-font"]
[fontSize 100]
[font-size 100]
[text "A&B" 100 100 (hash 'width #f)]
[text "X&Y" 100 200 (hash 'width #f 'features '(ss03))]))

@ -8,12 +8,12 @@
(define (proc doc)
;; Register a font name for use later
(send doc registerFont "the-font" (path->string otf-path))
(send doc register-font "the-font" (path->string otf-path))
;; Set the font, draw some text
(send* doc
[font "the-font"]
[fontSize 40]
[font-size 40]
[text "Embedded OTF" 100 100 (hash 'width #f)]))
;; test against non-subsetted font version

@ -4,59 +4,59 @@
(define (proc doc)
(send* doc
[font "Courier-Bold"]
[fontSize 10]
[font-size 10]
[text "Hello"]
[translate -30 30]
[font "Courier-BoldOblique"]
[fontSize 11]
[font-size 11]
[text "Hello"]
[translate -30 30]
[font "Courier-Oblique"]
[fontSize 12]
[font-size 12]
[text "Hello"]
[translate -30 30]
[font "Courier"]
[fontSize 14]
[font-size 14]
[text "Hello"]
[translate -30 30]
[font "Helvetica-Bold"]
[fontSize 16]
[font-size 16]
[text "Hello"]
[translate -30 30]
[font "Helvetica-BoldOblique"]
[fontSize 18]
[font-size 18]
[text "Hello"]
[translate -30 30]
[font "Helvetica-Oblique"]
[fontSize 20]
[font-size 20]
[text "Hello"]
[translate -30 30]
[font "Helvetica"]
[fontSize 22]
[font-size 22]
[text "Hello"]
[translate -30 30]
[font "Symbol"]
[fontSize 24]
[font-size 24]
[text "Hello"]
[translate -30 30]
[font "Times-Bold"]
[fontSize 26]
[font-size 26]
[text "Hello"]
[translate -30 30]
[font "Times-BoldItalic"]
[fontSize 28]
[font-size 28]
[text "Hello"]
[translate -30 30]
[font "Times-Italic"]
[fontSize 30]
[font-size 30]
[text "Hello"]
[translate -30 30]
[font "Times-Roman"]
[fontSize 32]
[font-size 32]
[text "Hello"]
[translate -30 30]
[font "ZapfDingbats"]
[fontSize 34]
[font-size 34]
[text "Hello"]))
(define-runtime-path this "test4rkt.pdf")

@ -6,7 +6,7 @@
(define (proc doc)
(send* doc
[font "Times-Italic"]
[fontSize 25]
[font-size 25]
[text "Some fantastic text!" 100 100 (hash 'lineBreak #f)]
[image death 100 160 (hash 'width 412)]))

@ -6,7 +6,7 @@
(define (proc doc)
(send* doc
[font "Times-Italic"]
[fontSize 25]
[font-size 25]
[text "Here comes a JPEG!" 100 100 (hash 'lineBreak #f)]
[image test-jpeg 100 160 (hash 'width 412)]))

@ -6,7 +6,7 @@
(define (proc doc)
(send* doc
[font "Helvetica-Bold"]
[fontSize 25]
[font-size 25]
[text "Another fantastic pic" 100 100 (hash 'lineBreak #f)]
[image pic 100 160 (hash 'width 412)]))

@ -14,20 +14,20 @@ doc.info['Title'] = 'Test Document'
doc.info['Author'] = 'Devon Govett'
# Register a font name for use later
doc.registerFont('Charter', 'charter.ttf')
doc.register-font('Charter', 'charter.ttf')
# Set the font, draw some text, and embed an image
doc.font('Charter')
.fontSize(25)
.font-size(25)
.text('Some text with an embedded font!', 100, 100)
.fontSize(18)
.font-size(18)
.text('PNG and JPEG images:')
.image('test.png', 100, 160, width: 412)
.image('test.jpeg', 190, 400, height: 300)
# Add another page
doc.add-page()
.fontSize(25)
.font-size(25)
.text 'Here is some vector graphics...', 100, 100
# Draw a triangle and a circle

Loading…
Cancel
Save