mbutterick
/
typesetting
2
1
Fork 0
Code Issues 13 Pull Requests Projects Releases Wiki Activity

stylize

Browse Source
main
Matthew Butterick 6 years ago
parent 31f9e9d42b
commit 83acf28272
1 changed files with 59 additions and 77 deletions
Show Stats Download Patch File Download Diff File

136
pitfall/pitfall/text.rkt
Unescape Escape View File

@ -6,7 +6,6 @@
racket/string racket/string
racket/list racket/list
sugar/unstable/class sugar/unstable/class
sugar/unstable/js
sugar/unstable/dict sugar/unstable/dict
sugar/list sugar/list
racket/promise racket/promise
@ -36,36 +35,36 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
(define/public (text str [x #f] [y #f] [options (mhash)]) (define/public (text str [x #f] [y #f] [options (mhash)])
(when x (set! @x x)) (when x (set! @x x))
(when y (set! @y y)) (when y (set! @y y))
(_line str options) (line str options)
this) this)
(define/public (string-width str [options (mhash)]) (define/public (string-width str [options (mhash)])
(+ (send (· this current-font) string-width str (· this current-font-size) (hash-ref options 'features #f)) (+ (send (get-field current-font this) string-width str (get-field current-font-size this) (hash-ref options 'features #f))
(* (hash-ref options 'characterSpacing 0) (sub1 (string-length str))))) (* (hash-ref options 'characterSpacing 0) (sub1 (string-length str)))))
(define/public (_line str [options (mhasheq)]) (define/public (line str [options (mhasheq)])
(_fragment str @x @y options) (fragment str @x @y options)
(define line-gap (or (· options line-gap) @line-gap 0)) (define line-gap (or (hash-ref options 'line-gap #f) @line-gap 0))
;; 181224 unsuppress size tracking in test mode to preserve test 04 ;; 181224 unsuppress size tracking in test mode to preserve test 04
;; otherwise we'll be doing our own line measurement ;; otherwise we'll be doing our own line measurement
(when (test-mode) (set! @x (+ @x (send this string-width str)))) (when (test-mode) (set! @x (+ @x (send this string-width str))))
(void)) (void))
(define/public (_fragment text x y-in options) (define/public (fragment text x y-in options)
(define wordSpacing (hash-ref options 'wordSpacing 0)) (define word-spacing (hash-ref options 'wordSpacing 0))
(define characterSpacing (hash-ref options 'characterSpacing 0)) (define character-spacing (hash-ref options 'characterSpacing 0))
;; calculate the actual rendered width of the string after word and character spacing ;; calculate the actual rendered width of the string after word and character spacing
(define renderedWidth (define rendered-width
;; wrap this in delay so it's only calculated if needed ;; wrap this in delay so it's only calculated if needed
(delay (delay
(+ (or (hash-ref options 'textWidth #f) (string-width text options)) (+ (or (hash-ref options 'textWidth #f) (string-width text options))
(* wordSpacing (sub1 (or (hash-ref options 'wordCount #f) 0))) (* word-spacing (sub1 (or (hash-ref options 'wordCount #f) 0)))
(* characterSpacing (sub1 (string-length text)))))) (* character-spacing (sub1 (string-length text))))))
;; create link annotations if the link option is given ;; create link annotations if the link option is given
(when (hash-ref options 'link #f) (when (hash-ref options 'link #f)
(send this link x y-in (force renderedWidth) (send this current-line-height) (hash-ref options 'link))) (send this link x y-in (force rendered-width) (send this current-line-height) (hash-ref options 'link)))
;; create underline or strikethrough line ;; create underline or strikethrough line
(when (or (hash-ref options 'underline #f) (hash-ref options 'strike #f)) (when (or (hash-ref options 'underline #f) (hash-ref options 'strike #f))
@ -78,43 +77,39 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
(floor (/ (get-field current-font-size this) 10)))) (floor (/ (get-field current-font-size this) 10))))
(send this line-width line-width) (send this line-width line-width)
(define d (if (hash-ref options 'underline) 1 2)) (define d (if (hash-ref options 'underline) 1 2))
(define lineY (+ y-in (/ (send this current-line-height) d))) (define line-y (+ y-in (/ (send this current-line-height) d)))
(when (hash-ref options 'underline) (when (hash-ref options 'underline)
(set! lineY (+ lineY (- line-width)))) (set! line-y (+ line-y (- line-width))))
(send this move-to x lineY) (send this move-to x line-y)
(send this line-to (+ x (force renderedWidth)) lineY) (send this line-to (+ x (force rendered-width)) line-y)
(send this stroke) (send this stroke)
(send this restore)) (send this restore))
;; flip coordinate system ;; flip coordinate system
(send this save) (send this save)
(send this transform 1 0 0 -1 0 (· this page height)) (send this transform 1 0 0 -1 0 (get-field height (send this page)))
(define y (- (· this page height) y-in (* (/ (· this current-font ascender) 1000) (· this current-font-size)))) (define y (- (get-field height (send this page))
y-in
(* (/ (get-field ascender (get-field current-font this)) 1000)
(get-field current-font-size this))))
;; add current font to page if necessary ;; add current font to page if necessary
(hash-ref! (· this page fonts) (· this current-font id) (λ () (· this current-font make-font-ref))) (hash-ref! (send (send this page) fonts) (get-field id (get-field current-font this))
(λ () (send (get-field current-font this) make-font-ref)))
;; begin the text object (send this addContent "BT") ; begin the text object
(send this addContent "BT") (send this addContent (format "1 0 0 1 ~a ~a Tm" (numberizer x) (numberizer y))) ; text position
(send this addContent (format "/~a ~a Tf" (get-field id (get-field current-font this))
;; text position (numberizer (get-field current-font-size this)))) ; font and font size
(send this addContent (format "1 0 0 1 ~a ~a Tm" (numberizer x) (numberizer y)))
;; font and font size
(send this addContent (format "/~a ~a Tf" (· this current-font id) (numberizer (· this current-font-size))))
;; rendering mode
(let ([mode (cond (let ([mode (cond
[(and (hash-ref options 'fill #f) (hash-ref options 'stroke #f)) 2] [(and (hash-ref options 'fill #f) (hash-ref options 'stroke #f)) 2]
[(hash-ref options 'stroke #f) 1] [(hash-ref options 'stroke #f) 1]
[else 0])]) [else 0])])
(when (and mode (not (zero? mode))) (when (and mode (not (zero? mode)))
(send this addContent (format "~a Tr" mode)))) (send this addContent (format "~a Tr" mode))))
(when (not (zero? character-spacing))
;; Character spacing (send this addContent (format "~a Tc" character-spacing)))
(when (not (zero? characterSpacing))
(send this addContent (format "~a Tc" characterSpacing)))
;; Add the actual text ;; Add the actual text
;; If we have a word spacing value, we need to encode each word separately ;; If we have a word spacing value, we need to encode each word separately
@ -123,65 +118,52 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
;; 180321: the first call to this operation is very slow from Quad ;; 180321: the first call to this operation is very slow from Quad
;; 181126: because `encode` calls `layout` ;; 181126: because `encode` calls `layout`
(match-define (list encoded-char-strs positions) (match-define (list encoded-char-strs positions)
(if (not (zero? wordSpacing)) (send (get-field current-font this) encode text (hash-ref options 'features #f)))
(error 'unimplemented-brach) ; todo
(send (· this current-font) encode text (hash-ref options 'features #f))))
(define scale (/ (· this current-font-size) 1000.0)) (define scale (/ (get-field current-font-size this) 1000.0))
(define commands empty) (define commands empty)
(define last 0)
;; Adds a segment of text to the TJ command buffer ;; Adds a segment of text to the TJ command buffer
(define (addSegment cur) (define last-segment 0)
(when (< last cur) (define (add-segment cur)
(let* ([hex (string-append* (sublist encoded-char-strs last cur))] (when (< last-segment cur)
[posn (list-ref positions (sub1 cur))] (define hex (string-append* (sublist encoded-char-strs last-segment cur)))
[advance (- (glyph-position-x-advance posn) (glyph-position-advance-width posn))]) (define posn (list-ref positions (sub1 cur)))
(push-end! commands (format "<~a> ~a" hex (numberizer (- advance)))))) (define advance (- (glyph-position-x-advance posn) (glyph-position-advance-width posn)))
(set! last cur)) (set! commands (cons (format "<~a> ~a" hex (numberizer (- advance))) commands)))
(set! last-segment cur))
;; Flushes the current TJ commands to the output stream ;; Flushes the current TJ commands to the output stream
(define (flush i) (define (flush idx)
(addSegment i) (add-segment idx)
(when (positive? (length commands)) (when (positive? (length commands))
(send this addContent (format "[~a] TJ" (string-join commands " "))) (send this addContent (format "[~a] TJ" (string-join (reverse commands) " ")))
(set! commands empty))) (set! commands empty)))
(for/fold ([hadOffset #f] [x x]) (for/fold ([had-offset #f] [x x])
([(posn i) (in-indexed positions)]) ([(posn idx) (in-indexed positions)])
(define havingOffset (define having-offset
(cond (cond
;; If we have an x or y offset, we have to break out of the current TJ command ;; If we have an x or y offset, we have to break out of the current TJ command
;; so we can move the text position. ;; so we can move the text position.
[(or (not (zero? (glyph-position-x-offset posn))) (not (zero? (glyph-position-y-offset posn)))) [(or (not (zero? (glyph-position-x-offset posn))) (not (zero? (glyph-position-y-offset posn))))
;; Flush the current buffer (flush idx)
(flush i) (send this addContent ; Move the text position and flush just the current character
;; Move the text position and flush just the current character (format "1 0 0 1 ~a ~a Tm"
(send this addContent (format "1 0 0 1 ~a ~a Tm" (numberizer (+ x (* (glyph-position-x-offset posn) scale)))
(numberizer (+ x (* (glyph-position-x-offset posn) scale))) (numberizer (+ y (* (glyph-position-y-offset posn) scale)))))
(numberizer (+ y (* (glyph-position-y-offset posn) scale))))) (flush (add1 idx))
(flush (add1 i)) #true]
#t]
[else [else
;; If the last character had an offset, reset the text position ;; If the last character had an offset, reset the text position
(when hadOffset (when had-offset
(send this addContent (format "1 0 0 1 ~a ~a Tm" (numberizer x) (numberizer y)))) (send this addContent (format "1 0 0 1 ~a ~a Tm" (numberizer x) (numberizer y))))
;; Group segments that don't have any advance adjustments ;; Group segments that don't have any advance adjustments
(unless (zero? (- (glyph-position-x-advance posn) (glyph-position-advance-width posn))) (unless (zero? (- (glyph-position-x-advance posn) (glyph-position-advance-width posn)))
(addSegment (add1 i))) (add-segment (add1 idx)))
#false]))
#f])) (values having-offset (+ x (* (glyph-position-x-advance posn) scale))))
(values havingOffset (+ x (* (glyph-position-x-advance posn) scale))))
;; Flush any remaining commands (flush (length positions))
(let ([i (length positions)]) (send this addContent "ET") ; end the text object
(flush i)) (send this restore)))) ; restore flipped coordinate system
;; end the text object
(send this addContent "ET")
;; restore flipped coordinate system
(send this restore)
(void))))

Write Preview
Loading…
Cancel
Save