respect underline position & thickness

pitfall/pitfall/core.rkt

@@ -38,6 +38,8 @@
                   id
                   ascender
                   descender
+                  underline-position
+                  underline-thickness
                   line-gap
                   bbox
                   ref

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)))
+  (match-define (list ascender descender underline-position underline-thickness line-gap)
-  (define descender (exactify (* (font-descent font) scale)))
+    (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 gid (subset-add-glyph! (efont-subset ef) (glyph-id glyph)))
-                    (define subset-idx (to-hex gid))
+                 (define subset-idx (to-hex gid))
-                    (vector-set! subset-idxs idx subset-idx)
+                 (vector-set! subset-idxs idx subset-idx)
-
+
-                    ;; set the advance width of the posn
+                 ;; set the advance width of the posn
-                    (set-glyph-position-advance-width! posn (glyph-advance-width glyph))
+                 (set-glyph-position-advance-width! posn (glyph-advance-width glyph))
-                    ;; scale all values in posn (incl advance width)
+                 ;; scale all values in posn (incl advance width)
-                    (scale-glyph-position! posn (efont-scale ef))
+                 (scale-glyph-position! posn (efont-scale ef))
-                    ;; update the return value
+                 ;; update the return value
-                    (vector-set! new-positions idx posn)
+                 (vector-set! new-positions idx posn)
-
+
-                    ;; put the scaled width in the width cache (by fetching it out of 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-widths ef) gid (λ () (glyph-position-advance-width posn)))
-                    (hash-ref! (efont-unicode ef) gid (λ () (glyph-codepoints glyph))))
+                 (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 codepoints (hash-ref (efont-unicode ef) idx))
-              (define encoded
+      (define encoded
-                ; encode codePoints to utf16
+        ; encode codePoints to utf16
-                (for/fold ([hexes null]
+        (for/fold ([hexes null]
-                           #:result (reverse hexes))
+                   #:result (reverse hexes))
-                          ([value (in-list codepoints)])
+                  ([value (in-list codepoints)])
-                  (cond
+          (cond
-                    [(> value #xffff)
+            [(> value #xffff)
-                     (let ([value (- value #x10000)])
+             (let ([value (- value #x10000)])
-                       (define b1 (bitwise-ior (bitwise-and (arithmetic-shift value -10) #x3ff) #xd800))
+               (define b1 (bitwise-ior (bitwise-and (arithmetic-shift value -10) #x3ff) #xd800))
-                       (define b2 (bitwise-ior (bitwise-and value #x3ff) #xdc00))
+               (define b2 (bitwise-ior (bitwise-and value #x3ff) #xdc00))
-                       (list* (to-hex b2) (to-hex b1) hexes))]
+               (list* (to-hex b2) (to-hex b1) hexes))]
-                    [else (cons (to-hex value) hexes)])))
+            [else (cons (to-hex value) hexes)])))
-              (format "<~a>" (string-join encoded " "))))
+      (format "<~a>" (string-join encoded " "))))
 
   (define unicode-cmap-str #<<HERE
 /CIDInit /ProcSet findresource begin

pitfall/pitfall/font-standard.rkt

@@ -24,11 +24,13 @@
   (define kern-pairs (make-hash kps))
   (define ascender (string->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)

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))))
+  (define stroke-width
-  (line-width doc new-line-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
+  (define vert-line-adj
-                           (* (current-line-height doc) vert-em-adjustment)
+    (+ y
-                           (- (if underline? new-line-width 0))))
+       (* (current-line-height doc) vert-em-adjustment)
-  (move-to doc x vert-line-pos)
+       (- (cond
-  (line-to doc (+ x width) vert-line-pos)
+            [(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