diff --git a/pitfall/pitfall/core.rkt b/pitfall/pitfall/core.rkt index 92d9746f..d42fdd5e 100644 --- a/pitfall/pitfall/core.rkt +++ b/pitfall/pitfall/core.rkt @@ -38,6 +38,8 @@ id ascender descender + underline-position + underline-thickness line-gap bbox ref diff --git a/pitfall/pitfall/font-embedded.rkt b/pitfall/pitfall/font-embedded.rkt index 674a030f..66bd557d 100644 --- a/pitfall/pitfall/font-embedded.rkt +++ b/pitfall/pitfall/font-embedded.rkt @@ -23,12 +23,12 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee (for/sum ([c (in-list (list COND ...))] [v (in-list (list VAL ...))] #:when c) - v)) + v)) (define (to-hex . codepoints) (string-append* (for/list ([code (in-list codepoints)]) - (~r code #:base 16 #:min-width 4 #:pad-string "0")))) + (~r code #:base 16 #:min-width 4 #:pad-string "0")))) (struct efont pdf-font (font subset unicode widths scale encoding-cache) #:mutable) @@ -48,13 +48,13 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee (define widths (mhasheq 0 (glyph-advance-width (get-glyph font 0)))) (define name (font-postscript-name font)) (define scale (/ 1000.0 (font-units-per-em font))) - (define ascender (exactify (* (font-ascent font) scale))) - (define descender (exactify (* (font-descent font) scale))) + (match-define (list ascender descender underline-position underline-thickness line-gap) + (for/list ([proc (in-list (list font-ascent font-descent font-underline-position font-underline-thickness font-linegap))]) + (exactify (* (proc font) scale)))) (define bbox (font-bbox font)) - (define line-gap (exactify (* (font-linegap font) scale))) (define encoding-cache (make-hash)) ; needs to be per font, not in top level of module (efont - name id ascender descender line-gap bbox #f #f efont-embedded efont-encode efont-measure-string + name id ascender descender underline-position underline-thickness line-gap bbox #f #f efont-embedded efont-encode efont-measure-string font subset unicode widths scale encoding-cache)) (define (efont-encode ef str [features-in null]) @@ -70,20 +70,20 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee (for ([glyph (in-vector glyphs)] [posn (in-vector positions)] [idx (in-range len)]) - (define gid (subset-add-glyph! (efont-subset ef) (glyph-id glyph))) - (define subset-idx (to-hex gid)) - (vector-set! subset-idxs idx subset-idx) - - ;; set the advance width of the posn - (set-glyph-position-advance-width! posn (glyph-advance-width glyph)) - ;; scale all values in posn (incl advance width) - (scale-glyph-position! posn (efont-scale ef)) - ;; update the return value - (vector-set! new-positions idx posn) - - ;; put the scaled width in the width cache (by fetching it out of posn) - (hash-ref! (efont-widths ef) gid (λ () (glyph-position-advance-width posn))) - (hash-ref! (efont-unicode ef) gid (λ () (glyph-codepoints glyph)))) + (define gid (subset-add-glyph! (efont-subset ef) (glyph-id glyph))) + (define subset-idx (to-hex gid)) + (vector-set! subset-idxs idx subset-idx) + + ;; set the advance width of the posn + (set-glyph-position-advance-width! posn (glyph-advance-width glyph)) + ;; scale all values in posn (incl advance width) + (scale-glyph-position! posn (efont-scale ef)) + ;; update the return value + (vector-set! new-positions idx posn) + + ;; put the scaled width in the width cache (by fetching it out of posn) + (hash-ref! (efont-widths ef) gid (λ () (glyph-position-advance-width posn))) + (hash-ref! (efont-unicode ef) gid (λ () (glyph-codepoints glyph)))) (list subset-idxs new-positions)))) @@ -129,7 +129,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee ;; generate a random tag (6 uppercase letters. 65 is the char code for 'A') (when (test-mode) (random-seed 0)) (define tag (list->string (for/list ([i (in-range 6)]) - (integer->char (random 65 (+ 65 26)))))) + (integer->char (random 65 (+ 65 26)))))) (define name (string->symbol (string-append tag "+" (font-postscript-name (efont-font ef))))) (define descriptor (make-ref (mhasheq @@ -159,7 +159,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee 'Supplement 0) 'FontDescriptor descriptor 'W (list 0 (for/list ([idx (in-range (length (hash-keys (efont-widths ef))))]) - (hash-ref (efont-widths ef) idx (λ () (error 'embed (format "hash key ~a not found" idx))))))))) + (hash-ref (efont-widths ef) idx (λ () (error 'embed (format "hash key ~a not found" idx))))))))) (ref-end descendant-font) (dict-set*! (pdf-font-ref ef) @@ -176,20 +176,20 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee (define cmap-ref (make-ref)) (define entries (for/list ([idx (in-range (length (hash-keys (efont-unicode ef))))]) - (define codepoints (hash-ref (efont-unicode ef) idx)) - (define encoded - ; encode codePoints to utf16 - (for/fold ([hexes null] - #:result (reverse hexes)) - ([value (in-list codepoints)]) - (cond - [(> value #xffff) - (let ([value (- value #x10000)]) - (define b1 (bitwise-ior (bitwise-and (arithmetic-shift value -10) #x3ff) #xd800)) - (define b2 (bitwise-ior (bitwise-and value #x3ff) #xdc00)) - (list* (to-hex b2) (to-hex b1) hexes))] - [else (cons (to-hex value) hexes)]))) - (format "<~a>" (string-join encoded " ")))) + (define codepoints (hash-ref (efont-unicode ef) idx)) + (define encoded + ; encode codePoints to utf16 + (for/fold ([hexes null] + #:result (reverse hexes)) + ([value (in-list codepoints)]) + (cond + [(> value #xffff) + (let ([value (- value #x10000)]) + (define b1 (bitwise-ior (bitwise-and (arithmetic-shift value -10) #x3ff) #xd800)) + (define b2 (bitwise-ior (bitwise-and value #x3ff) #xdc00)) + (list* (to-hex b2) (to-hex b1) hexes))] + [else (cons (to-hex value) hexes)]))) + (format "<~a>" (string-join encoded " ")))) (define unicode-cmap-str #<number (hash-ref attributes 'Ascender "0"))) (define descender (string->number (hash-ref attributes 'Descender "0"))) + (define underline-position (string->number (hash-ref attributes 'UnderlinePosition "-100"))) + (define underline-thickness (string->number (hash-ref attributes 'UnderlineThickness "50"))) (define bbox (for/list ([attr (in-list (string-split (hash-ref attributes 'FontBBox)))]) (or (string->number attr) 0))) (define line-gap (- (third bbox) (first bbox) ascender descender)) (sfont - name id ascender descender line-gap bbox #f #f sfont-embed sfont-encode sfont-measure-string + name id ascender descender underline-position underline-thickness line-gap bbox #f #f sfont-embed sfont-encode sfont-measure-string attributes glyph-widths kern-pairs)) (define (sfont-embed sf) diff --git a/pitfall/pitfall/text.rkt b/pitfall/pitfall/text.rkt index 8c679c8f..afb08d17 100644 --- a/pitfall/pitfall/text.rkt +++ b/pitfall/pitfall/text.rkt @@ -21,17 +21,28 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee |# (define (do-horiz-line doc x y width [underline? #f]) + (define (scale-to-em x) (* (pdf-current-font-size doc) (/ x 1000.0))) (save doc) (when underline? (apply stroke-color doc (pdf-current-fill-color doc))) - (define new-line-width (max 0.5 (floor (/ (pdf-current-font-size doc) 10)))) - (line-width doc new-line-width) + (define stroke-width + (cond + [(or (not underline?) (test-mode)) (max 0.5 (floor (/ (pdf-current-font-size doc) 10)))] + [else + (scale-to-em (pdf-font-underline-thickness (pdf-current-font doc)))])) + (line-width doc stroke-width) (define vert-em-adjustment (if underline? 1 0.6)) - (define vert-line-pos (+ y - (* (current-line-height doc) vert-em-adjustment) - (- (if underline? new-line-width 0)))) - (move-to doc x vert-line-pos) - (line-to doc (+ x width) vert-line-pos) + (define vert-line-adj + (+ y + (* (current-line-height doc) vert-em-adjustment) + (- (cond + [(test-mode) stroke-width] + [underline? + ;; underline-position field is negative, by convention, so we change the sign + (scale-to-em (- (pdf-font-underline-position (pdf-current-font doc))))] + [else 0])))) + (move-to doc x vert-line-adj) + (line-to doc (+ x width) vert-line-adj) (stroke doc) (restore doc)) @@ -108,8 +119,6 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee (define x (pdf-x doc)) (define y (pdf-y doc)) - ;; 180109: character spacing works in pdf, but quad doesn't account for it yet - (define character-tracking (or character-tracking-arg 0)) ;; calculate the actual rendered width of the string after word and character spacing (define rendered-width