diff --git a/pitfall/pitfall/core.rkt b/pitfall/pitfall/core.rkt index 537f7502..6860abab 100644 --- a/pitfall/pitfall/core.rkt +++ b/pitfall/pitfall/core.rkt @@ -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]) diff --git a/pitfall/pitfall/document.rkt b/pitfall/pitfall/document.rkt index 092e2319..273be4f1 100644 --- a/pitfall/pitfall/document.rkt +++ b/pitfall/pitfall/document.rkt @@ -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 diff --git a/pitfall/pitfall/fonts.rkt b/pitfall/pitfall/fonts.rkt index aaf4fa6a..2d2c8467 100644 --- a/pitfall/pitfall/fonts.rkt +++ b/pitfall/pitfall/fonts.rkt @@ -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)))) diff --git a/pitfall/pitfall/text.rkt b/pitfall/pitfall/text.rkt index 4afa9fa0..bca25654 100644 --- a/pitfall/pitfall/text.rkt +++ b/pitfall/pitfall/text.rkt @@ -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) diff --git a/pitfall/ptest/test12.rkt b/pitfall/ptest/test12.rkt index efdf539e..b1338aa2 100644 --- a/pitfall/ptest/test12.rkt +++ b/pitfall/ptest/test12.rkt @@ -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)])) diff --git a/pitfall/ptest/test13.rkt b/pitfall/ptest/test13.rkt index ba3f5bac..324da34f 100644 --- a/pitfall/ptest/test13.rkt +++ b/pitfall/ptest/test13.rkt @@ -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 diff --git a/pitfall/ptest/test14.rkt b/pitfall/ptest/test14.rkt index 3ce01cd1..5c75cdb3 100644 --- a/pitfall/ptest/test14.rkt +++ b/pitfall/ptest/test14.rkt @@ -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 diff --git a/pitfall/ptest/test15.rkt b/pitfall/ptest/test15.rkt index 1f5505d8..a123da8a 100644 --- a/pitfall/ptest/test15.rkt +++ b/pitfall/ptest/test15.rkt @@ -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)])) diff --git a/pitfall/ptest/test16.rkt b/pitfall/ptest/test16.rkt index fcc119e9..3587864c 100644 --- a/pitfall/ptest/test16.rkt +++ b/pitfall/ptest/test16.rkt @@ -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)])) diff --git a/pitfall/ptest/test17.rkt b/pitfall/ptest/test17.rkt index 2383b0d8..26a849f8 100644 --- a/pitfall/ptest/test17.rkt +++ b/pitfall/ptest/test17.rkt @@ -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)])) diff --git a/pitfall/ptest/test18.rkt b/pitfall/ptest/test18.rkt index 1ba0f37d..7413cca8 100644 --- a/pitfall/ptest/test18.rkt +++ b/pitfall/ptest/test18.rkt @@ -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)] diff --git a/pitfall/ptest/test19.rkt b/pitfall/ptest/test19.rkt index e5861924..451ed4fe 100644 --- a/pitfall/ptest/test19.rkt +++ b/pitfall/ptest/test19.rkt @@ -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))])) diff --git a/pitfall/ptest/test20.rkt b/pitfall/ptest/test20.rkt index 0c0291ae..34064f5a 100644 --- a/pitfall/ptest/test20.rkt +++ b/pitfall/ptest/test20.rkt @@ -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 diff --git a/pitfall/ptest/test4.rkt b/pitfall/ptest/test4.rkt index 1e119c63..fad4aab4 100644 --- a/pitfall/ptest/test4.rkt +++ b/pitfall/ptest/test4.rkt @@ -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") diff --git a/pitfall/ptest/test5.rkt b/pitfall/ptest/test5.rkt index 2027a41e..13764781 100644 --- a/pitfall/ptest/test5.rkt +++ b/pitfall/ptest/test5.rkt @@ -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)])) diff --git a/pitfall/ptest/test7.rkt b/pitfall/ptest/test7.rkt index ae2cbd49..aaee8225 100644 --- a/pitfall/ptest/test7.rkt +++ b/pitfall/ptest/test7.rkt @@ -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)])) diff --git a/pitfall/ptest/test8.rkt b/pitfall/ptest/test8.rkt index 5c91d3d5..66929fb0 100644 --- a/pitfall/ptest/test8.rkt +++ b/pitfall/ptest/test8.rkt @@ -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)])) diff --git a/pitfall/ptest/testrkt.rkt b/pitfall/ptest/testrkt.rkt index 585ccf39..c046886e 100644 --- a/pitfall/ptest/testrkt.rkt +++ b/pitfall/ptest/testrkt.rkt @@ -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