From 170e13b719de4baaa7e3cddb9e3f0e03235e98ca Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 27 Mar 2019 08:44:52 -0700 Subject: [PATCH] start justification --- quad/qtest/markdown.rkt | 89 +++++++++++++++++++++++------------------ quad/quad/position.rkt | 17 ++++---- 2 files changed, 61 insertions(+), 45 deletions(-) diff --git a/quad/qtest/markdown.rkt b/quad/qtest/markdown.rkt index 0fb389ce..14526410 100644 --- a/quad/qtest/markdown.rkt +++ b/quad/qtest/markdown.rkt @@ -18,7 +18,7 @@ (define-tag-function (p attrs exprs) ;; no font-family so that it adopts whatever the surrounding family is - (qexpr (append `((keep-first "2")(keep-last "3")(font-size "12") (character-tracking "0") (hyphenate "true") (display ,(symbol->string (gensym)))) attrs) exprs)) + (qexpr (append `((keep-first "2")(keep-last "3")(line-align "justify")(font-size "12") (character-tracking "0") (hyphenate "true") (display ,(symbol->string (gensym)))) attrs) exprs)) (define-tag-function (hr attrs exprs) hrbr) @@ -146,7 +146,7 @@ (font-size doc (quad-ref q 'font-size default-font-size)) (font doc (path->string (quad-ref q font-path-key default-font-face))) (+ (string-width doc str - #:tracking (quad-ref q 'character-tracking 0)) + #:tracking (quad-ref q 'character-tracking 0)) ;; add one more dose because `string-width` only adds it intercharacter, ;; and this quad will be adjacent to another ;; (so we need to account for the "inter-quad" space @@ -204,21 +204,35 @@ (and (pair? (quad-elems q)) (member (unsafe-car (quad-elems q)) softies))) -(define (consolidate-runs pcs #:finalize [finalize-proc reverse]) - (for/fold ([runs empty] - [pcs pcs] - #:result (finalize-proc runs)) - ([i (in-naturals)] - #:break (empty? pcs)) - (define-values (run-pcs rest) (splitf-at pcs (λ (p) (same-run? (car pcs) p)))) - (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))))] - [size (delay (pt (for/sum ([pc (in-list run-pcs)]) - (pt-x (size pc))) - (pt-y (size (car pcs)))))])) - (values (cons new-run runs) rest))) +(define (consolidate-runs pcs ending-q) + (define reversed-runs + (for/fold ([runs empty] + [pcs pcs] + #:result runs) + ([i (in-naturals)] + #:break (empty? pcs)) + (define-values (run-pcs rest) (splitf-at pcs (λ (p) (same-run? (car pcs) p)))) + (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))))] + [size (delay (pt (for/sum ([pc (in-list run-pcs)]) + (pt-x (size pc))) + (pt-y (size (car pcs)))))])) + (values (cons new-run runs) rest))) + ;; naive handling of soft hyphen: + ;; if soft hyphen cause the break, then append a printing hyphen to the end of the run. + ;; this assumes that there is room for the hyphen on the line + ;; and does not take into account hyphen-break transformations found in other languages. + ;; However we do want the hyphen joined into the string so the final shaping / positioning is correct + ;; for instance, kerning between last letter and hyphen. + (reverse (if (and ending-q (equal? (quad-elems ending-q) '("\u00AD"))) + (cons (let* ([last-run (car reversed-runs)] + [str+hyphen (string-append (car (quad-elems last-run)) "-")]) + (struct-copy quad last-run + [elems (list str+hyphen)] + [size (make-size-promise last-run str+hyphen)])) (cdr reversed-runs)) + reversed-runs))) (define-quad line-break quad ()) (define lbr (make-line-break #:printable #f)) @@ -261,6 +275,19 @@ [substr (in-list (regexp-match* (regexp (string hyphen-char)) hstr #:gap-select? #t))]) (struct-copy quad q [elems (list substr)]))])))) +(define (fill-wrap qs ending-q) + (match-define (list line-width line-height) (quad-size q:line)) + (match (quad-ref (car qs) 'line-align #f) + ["justify" + (define words (for/list ([q (in-list qs)] + #:unless (equal? (car (quad-elems q)) " ")) + q)) + (define words-width (pt-x (apply pt+ (map size words)))) + (define empty-hspace (- line-width words-width)) + (define space-width (/ empty-hspace (sub1 (length words)))) + (add-between words (make-quad #:size (pt space-width line-height)))] + [_ qs])) + (define (line-wrap qs wrap-size) (wrap qs (λ (q idx) (- wrap-size (quad-ref q 'inset-left 0) (quad-ref q 'inset-right 0))) @@ -273,9 +300,10 @@ #:finish-wrap (λ (pcs-in opening-q ending-q idx) ;; remove unused soft hyphens so they don't affect final shaping - (define pcs (for/list ([pc (in-list pcs-in)] - #:unless (equal? (quad-elems pc) '("\u00AD"))) - pc)) + (define pcs-printing (for/list ([pc (in-list pcs-in)] + #:unless (equal? (quad-elems pc) '("\u00AD"))) + pc)) + (define pcs (fill-wrap pcs-printing ending-q)) (append (cond [(empty? pcs) null] @@ -290,23 +318,7 @@ (line-width doc 3) (stroke doc "#999"))]))] [else - (match (consolidate-runs pcs - #:finalize (λ (reversed-runs) - (reverse (if (and ending-q (equal? (quad-elems ending-q) '("\u00AD"))) - ;; naive handling of soft hyphen: - ;; if soft hyphen cause the break, then append a printing hyphen to the end of the run. - ;; this assumes that there is room for the hyphen on the line - ;; and does not take into account hyphen-break transformations - ;; found in other languages. - ;; However we do want the hyphen joined into the string - ;; so the final shaping / positioning is correct - ;; for instance, kerning between last letter and hyphen. - (cons (let ([r (car reversed-runs)]) - (define new-str (string-append (car (quad-elems r)) "-")) - (struct-copy quad r - [elems (list new-str)] - [size (make-size-promise r new-str)])) (cdr reversed-runs)) - reversed-runs)))) + (match (consolidate-runs pcs ending-q) [(? pair? elems) (define elem (unsafe-car elems)) (match-define (list line-width line-height) (quad-size q:line)) @@ -326,7 +338,8 @@ (define h-factor (match (quad-ref elem 'line-align "left") ["left" 0] ["center" 0.5] - ["right" 1])) + ["right" 1] + [_ 0])) (define empty-hspace (- line-width (quad-ref elem 'inset-left 0) elems-width diff --git a/quad/quad/position.rkt b/quad/quad/position.rkt index 347bcf52..6456426f 100644 --- a/quad/quad/position.rkt +++ b/quad/quad/position.rkt @@ -37,7 +37,10 @@ ((if (number? val) values string->number) val)) (define (vertical-baseline-offset q) - (* (/ (ascender q) (units-per-em q) 1.0) (fontsize q))) + (cond + [(quad-ref q font-path-key #f) + (* (/ (ascender q) (units-per-em q) 1.0) (fontsize q))] + [else 0])) (define (anchor->local-point q anchor) ;; calculate the location of the anchor on the bounding box relative to '(0 0) (aka "locally") @@ -159,13 +162,13 @@ (check-equal? (inner-point (position (q #:size size #:inner 'w #:offset off) orig)) (pt+ '(0 5) off)))) #;(module+ test - (require racket/runtime-path fontland/font) - (define-runtime-path fira "fira.ttf") + (require racket/runtime-path fontland/font) + (define-runtime-path fira "fira.ttf") - (define q1 (q (list 'in 'bi 'out 'bo 'size '(10 10) font-path-key fira 'fontsize 12))) - (define q2 (q (list 'in 'bi 'out 'bo 'size '(10 10) font-path-key fira 'fontsize 24))) - (define q3 (q (list 'in 'bi 'out 'bo 'size '(10 10) font-path-key fira 'fontsize 6))) - #;(position (q #f q1 q2 q3))) + (define q1 (q (list 'in 'bi 'out 'bo 'size '(10 10) font-path-key fira 'fontsize 12))) + (define q2 (q (list 'in 'bi 'out 'bo 'size '(10 10) font-path-key fira 'fontsize 24))) + (define q3 (q (list 'in 'bi 'out 'bo 'size '(10 10) font-path-key fira 'fontsize 6))) + #;(position (q #f q1 q2 q3))) #;(module+ test