From 1da4c0e511640e7913a13ef5cf9d53c2207f9e8d Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 9 Jan 2019 13:33:40 -0800 Subject: [PATCH] line spacer --- quad/qtest/hyphenate.rkt | 2 +- quad/qtest/markdown.rkt | 31 +++++++++++++++---------------- 2 files changed, 16 insertions(+), 17 deletions(-) diff --git a/quad/qtest/hyphenate.rkt b/quad/qtest/hyphenate.rkt index a0c5184f..a76603a0 100644 --- a/quad/qtest/hyphenate.rkt +++ b/quad/qtest/hyphenate.rkt @@ -1,6 +1,6 @@ #lang qtest/markdown -A simple _hyphenation engine_ that uses the Knuth–Liang hyphenation algorithm originally developed for TeX. + A simple _hyphenation engine_ that uses the Knuth–Liang hyphenation algorithm originally developed for TeX. I **have added little** to their work. Accordingly, I take no credit, except a spoonful of *snako-bits.* diff --git a/quad/qtest/markdown.rkt b/quad/qtest/markdown.rkt index 8353c9fd..9d7972d6 100644 --- a/quad/qtest/markdown.rkt +++ b/quad/qtest/markdown.rkt @@ -58,9 +58,12 @@ (define q:line (q #:size (pt +inf.0 line-height) #:out 'sw #:printable #true)) -(define q:line-spacer (q #:size (pt +inf.0 (/ line-height 2)) - #:out 'sw - #:printable #true)) +(struct line-spacer quad () #:transparent) +(define q:line-spacer (q #:type line-spacer + #:size (pt +inf.0 (* line-height 0.7)) + #:out 'sw + #:printable (λ (q sig) + (not (memq sig '(start end)))))) (define softies (map string '(#\space #\- #\u00AD))) (define (soft-break-for-line? q) @@ -76,19 +79,13 @@ (define new-run (struct-copy quad q:string [attrs (quad-attrs (car pcs))] [elems (merge-adjacent-strings (apply append (for/list ([pc (in-list run-pcs)]) - (quad-elems pc))))] + (quad-elems pc))))] [size (delay (pt (for/sum ([pc (in-list run-pcs)]) - (pt-x (size pc))) + (pt-x (size pc))) (pt-y (size (car pcs)))))])) (values (cons new-run runs) rest))) -;; 190108 feels like this needs separate finish-wraps for soft and hard. -;; and maybe pass in the quad that triggered the wrap. -;; otherwise within line-wrap, the finish-wrap-proc can't tell the difference between -;; 1) ordinary word space (permits wrap to next line) -;; 2) hard line break (forces wrap to next line) -;; 3) paragraph break (forces wrap to next line and also triggers first-line behavior, -;; e.g., more space above or first-line indent.) + (define (line-wrap xs size) (break xs size #:hard-break-proc (λ (q) (equal? "¶" (car (quad-elems q)))) @@ -97,17 +94,19 @@ (append (if (= idx 1) (list q:line-spacer) null) (list (struct-copy quad q:line - [elems (consolidate-runs pcs)])))))) + [elems (consolidate-runs pcs)])))))) (define q:page (q #:offset '(36 36) #:pre-draw (λ (q doc) (add-page doc)))) (define q:doc (q #:pre-draw (λ (q doc) (start-doc doc)) - #:post-draw (λ (q doc) (end-doc doc)))) + #:post-draw (λ (q doc) (end-doc doc)))) (define (page-wrap xs vertical-height) - (break xs vertical-height #:finish-wrap-proc (λ (pcs q idx) (list (struct-copy quad q:page [elems pcs]))))) + (break xs vertical-height + #:soft-break-proc line-spacer? + #:finish-wrap-proc (λ (pcs q idx) (list (struct-copy quad q:page [elems pcs]))))) (define (run xs path) (define pdf (time-name make-pdf (make-pdf #:compress #t @@ -120,7 +119,7 @@ [x (time-name line-wrap (line-wrap x line-width))] [x (time-name page-wrap (page-wrap x vertical-height))] [x (time-name position (position (struct-copy quad q:doc [elems x])))]) - (time-name draw (draw x pdf)))) + (time-name draw (draw x pdf)))) (define-syntax (mb stx) (syntax-case stx ()