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

move justify-overfill calculation

Browse Source
main
Matthew Butterick 3 years ago
parent 6ca1ca15da
commit da0fa8588b
1 changed files with 145 additions and 145 deletions
Show Stats Download Patch File Download Diff File

290
quad/quadwriter/line.rkt
Unescape Escape View File

@ -158,156 +158,156 @@
;; ok to put back absolute quads at end, because it doesn't affect their layout ;; ok to put back absolute quads at end, because it doesn't affect their layout
(append other-qs absolute-qs))])])])) (append other-qs absolute-qs))])])]))
(define (make-paragraph-spacer maybe-first-line-q key default-val) (define (make-paragraph-spacer maybe-first-line-q key default-val)
(define arbitrary-width 20) (define arbitrary-width 20)
(make-quad #:type line-spacer-quad (make-quad #:type line-spacer-quad
#:size (pt arbitrary-width (cond #:size (pt arbitrary-width (cond
[(and maybe-first-line-q (quad-ref maybe-first-line-q key))] [(and maybe-first-line-q (quad-ref maybe-first-line-q key))]
[else default-val])) [else default-val]))
#:from 'sw #:from 'sw
#:to 'nw #:to 'nw
#:printable only-prints-in-middle #:printable only-prints-in-middle
#:draw-start (if (draw-debug-line?) draw-debug void))) #:draw-start (if (draw-debug-line?) draw-debug void)))
(define ((line-wrap-finish line-prototype-q default-block-id) wrap-qs q-before q-after idx) (define ((line-wrap-finish line-prototype-q default-block-id) wrap-qs q-before q-after idx)
;; we curry line-q so that the wrap size can be communicated to this operation ;; we curry line-q so that the wrap size can be communicated to this operation
;; remove unused soft hyphens so they don't affect final shaping ;; remove unused soft hyphens so they don't affect final shaping
(define wrap-qs-printing (for/list ([wq (in-list wrap-qs)] (define wrap-qs-printing (for/list ([wq (in-list wrap-qs)]
#:unless (equal? (quad-elems wq) '("\u00AD"))) #:unless (equal? (quad-elems wq) '("\u00AD")))
wq)) wq))
(define new-lines (define new-lines
(cond (cond
[(empty? wrap-qs-printing) null] [(empty? wrap-qs-printing) null]
[(hr-break-quad? q-after) (list (make-hr-quad line-prototype-q))] [(hr-break-quad? q-after) (list (make-hr-quad line-prototype-q))]
[else [else
;; render hyphen first so that all printable characters are available for size-dependent ops. ;; render hyphen first so that all printable characters are available for size-dependent ops.
(define pcs-with-hyphen (render-hyphen wrap-qs-printing q-after)) (define pcs-with-hyphen (render-hyphen wrap-qs-printing q-after))
;; fill wrap so that consolidate-runs works properly ;; fill wrap so that consolidate-runs works properly
;; (justified lines won't be totally consolidated) ;; (justified lines won't be totally consolidated)
(define last-line-in-paragraph? (not q-after)) (define last-line-in-paragraph? (not q-after))
(define pcs (fill-line-wrap pcs-with-hyphen line-prototype-q last-line-in-paragraph?)) (define pcs (fill-line-wrap pcs-with-hyphen line-prototype-q last-line-in-paragraph?))
(match (consolidate-runs pcs) (match (consolidate-runs pcs)
[(and (cons elem-first _) elems) [(and (cons elem-first _) elems)
(match-define (list line-width line-height) (quad-size line-prototype-q)) (match-define (list line-width line-height) (quad-size line-prototype-q))
(list (list
(quad-copy line-quad line-prototype-q (quad-copy line-quad line-prototype-q
;; move block attrs up, so they are visible in col wrap ;; move block attrs up, so they are visible in col wrap
[attrs (let ([h (copy-block-attrs (quad-attrs elem-first) (hash-copy (quad-attrs line-prototype-q)))]) [attrs (let ([h (copy-block-attrs (quad-attrs elem-first) (hash-copy (quad-attrs line-prototype-q)))])
;; we want every group of lines in a paragraph to have a block id ;; we want every group of lines in a paragraph to have a block id
;; so that it will be wrapped as a block later. ;; so that it will be wrapped as a block later.
;; we only set this if there is no value for :display. ;; we only set this if there is no value for :display.
(hash-ref! h :display default-block-id) (hash-ref! h :display default-block-id)
h)] h)]
;; line width is static ;; line width is static
;; line height is the max 'line-height value or the natural height of q:line ;; line height is the max 'line-height value or the natural height of q:line
[size (pt line-width (match (filter-map (λ (q) (or (quad-ref q :line-height) (pt-y (size q)))) pcs) [size (pt line-width (match (filter-map (λ (q) (or (quad-ref q :line-height) (pt-y (size q)))) pcs)
[(? null?) line-height] [(? null?) line-height]
[line-heights (apply max line-heights)]))] [line-heights (apply max line-heights)]))]
;; handle list indexes. drop new quad into line to hold list index ;; handle list indexes. drop new quad into line to hold list index
;; could also use this for line numbers ;; could also use this for line numbers
[elems [elems
;; we assume here that a list item has already had extra inset-left ;; we assume here that a list item has already had extra inset-left
;; with room for a bullet ;; with room for a bullet
;; which we just insert at the front. ;; which we just insert at the front.
;; this is safe because line has already been filled. ;; this is safe because line has already been filled.
(append (append
;; only put bullet into line if we're at the first line of the list item ;; only put bullet into line if we're at the first line of the list item
(match (and (eq? idx 1) (quad-ref elem-first :list-index)) (match (and (eq? idx 1) (quad-ref elem-first :list-index))
[#false null] [#false null]
[bullet [bullet
(define bq (quad-copy string-quad q:string ;; copy q:string to get draw routine (define bq (quad-copy string-quad q:string ;; copy q:string to get draw routine
;; borrow attrs from elem ;; borrow attrs from elem
[attrs (quad-attrs elem-first)] [attrs (quad-attrs elem-first)]
;; use bullet as elems ;; use bullet as elems
[elems (list (if (number? bullet) (format "~a." bullet) bullet))] [elems (list (if (number? bullet) (format "~a." bullet) bullet))]
;; size doesn't matter because nothing refers to this quad ;; size doesn't matter because nothing refers to this quad
;; just for debugging box ;; just for debugging box
[size (pt 15 (pt-y (size line-prototype-q)))])) [size (pt 15 (pt-y (size line-prototype-q)))]))
(from-parent (list bq) 'sw)]) (from-parent (list bq) 'sw)])
(from-parent (from-parent
(match (quad-ref elem-first :inset-left 0) (match (quad-ref elem-first :inset-left 0)
[0 elems] [0 elems]
[inset-val (cons (make-quad [inset-val (cons (make-quad
#:draw-end q:string-draw-end #:draw-end q:string-draw-end
#:to 'sw #:to 'sw
#:size (pt inset-val 5) #:size (pt inset-val 5)
#:type offsetter-quad) #:type offsetter-quad)
elems)]) 'sw))]))] elems)]) 'sw))]))]
[_ null])])) [_ null])]))
(define maybe-first-line (and (pair? new-lines) (car new-lines))) (define maybe-first-line (and (pair? new-lines) (car new-lines)))
(append (match q-before (append (match q-before
[#false (list (make-paragraph-spacer maybe-first-line :space-before 0))] ; paragraph break [#false (list (make-paragraph-spacer maybe-first-line :space-before 0))] ; paragraph break
[_ null]) [_ null])
new-lines new-lines
(match q-after (match q-after
[(? column-break-quad? column-break) (list column-break)] ; hard column (or section or page) break [(? column-break-quad? column-break) (list column-break)] ; hard column (or section or page) break
[#false (list (make-paragraph-spacer maybe-first-line :space-after (* default-line-height 0.6)))] ; paragraph break [#false (list (make-paragraph-spacer maybe-first-line :space-after (* default-line-height 0.6)))] ; paragraph break
[_ null]))) ; hard line break [_ null]))) ; hard line break
(define softies (map string '(#\space #\- #\u00AD))) (define softies (map string '(#\space #\- #\u00AD)))
(define (soft-break-for-line? q) (define (soft-break-for-line? q)
(and (pair? (quad-elems q)) (and (pair? (quad-elems q))
(member (unsafe-car (quad-elems q)) softies))) (member (unsafe-car (quad-elems q)) softies)))
(define (permitted-justify-overfill q)
(match (quad-ref q :line-align)
;; allow justified lines to go wider,
;; and then fill-wrap will tighten thes word spaces
;; this makes justified paragraphs more even, becuase
;; some lines are a little tight, as opposed to all of them being loose
;; this has to be based on a certain quad, not set globally for the line-wrap operation,
;; because different paragraphs might have different alignment settings.
["justify" 1.04]
[_ 1]))
(define (line-wrap qs wrap-size [debug #false]) (define (line-wrap qs wrap-size [debug #false])
(unless (positive? wrap-size) (unless (positive? wrap-size)
(raise-argument-error 'line-wrap "positive number" wrap-size)) (raise-argument-error 'line-wrap "positive number" wrap-size))
(match qs (match qs
[(cons q _) [(cons q _)
(define line-q (quad-copy line-quad q:line [size (pt wrap-size (quad-ref q :line-height default-line-height))])) (define line-q (quad-copy line-quad q:line [size (pt wrap-size (quad-ref q :line-height default-line-height))]))
(define permitted-justify-overfill ;; group lines into sublists separated by para-breaks, but then omit the para-breaks themselves
(match (quad-ref q :line-align) ;; because they've served their purpose (leave the others, to be expressed later)
;; allow justified lines to go wider, ;; however, leave line-breaks in, because they will be handled by wrap.
;; and then fill-wrap will tighten thes word spaces (define para-qss (let loop ([qs qs][acc null])
;; this makes justified paragraphs more even, becuase (match qs
;; some lines are a little tight, as opposed to all of them being loose [(? null?) (reverse acc)]
["justify" 1.04] [(cons (? para-break-quad?) rest)
[_ 1])) (loop rest acc)]
;; group lines into sublists separated by para-breaks, but then omit the para-breaks themselves [(cons (? column-break-quad? bq) rest)
;; because they've served their purpose (leave the others, to be expressed later) (loop rest (cons bq acc))]
;; however, leave line-breaks in, because they will be handled by wrap. [(list* (and (not (? para-break-quad?)) nbqs) ... rest)
(define para-qss (let loop ([qs qs][acc null]) (loop rest (cons nbqs acc))])))
(match qs (define res
[(? null?) (reverse acc)] (apply append
[(cons (? para-break-quad?) rest) (for/list ([para-qs (in-list para-qss)])
(loop rest acc)] (define block-id (gensym))
[(cons (? column-break-quad? bq) rest) (match para-qs
(loop rest (cons bq acc))] [(? break-quad? bq) (list bq)]
[(list* (and (not (? para-break-quad?)) nbqs) ... rest) [(cons pq _)
(loop rest (cons nbqs acc))]))) (wrap para-qs
(define res (* (- wrap-size
(apply append (quad-ref pq :inset-left 0)
(for/list ([para-qs (in-list para-qss)]) (quad-ref pq :inset-right 0))
(define block-id (gensym)) (permitted-justify-overfill pq))
(match para-qs debug
[(? break-quad? bq) (list bq)] ;; during wrap, anchored qs are treated as having distance 0
[(cons pq _) ;; so they can staty in right place, so that relative queries will work.
(wrap para-qs ;; but they won't affect where lines break
(* (- wrap-size #:distance (λ (q last-dist wrap-qs)
(quad-ref pq :inset-left 0) (+ last-dist (cond
(quad-ref pq :inset-right 0)) [(quad-ref q :parent) 0]
permitted-justify-overfill) [(printable? q) (distance q)]
debug [else 0])))
#:nicely (match (or (current-line-wrap) (quad-ref pq :line-wrap))
;; during wrap, anchored qs are treated as having distance 0 [(or "best" "kp") #true]
;; so they can staty in right place, so that relative queries will work. [_ #false])
;; but they won't affect where lines break #:hard-break line-break-quad?
#:distance (λ (q last-dist wrap-qs) #:soft-break soft-break-for-line?
(+ last-dist (cond #:finish-wrap (line-wrap-finish line-q block-id))]))))
[(quad-ref q :parent) 0] res]
[(printable? q) (distance q)] [_ null]))
[else 0])))
#:nicely (match (or (current-line-wrap) (quad-ref pq :line-wrap))
[(or "best" "kp") #true]
[_ #false])
#:hard-break line-break-quad?
#:soft-break soft-break-for-line?
#:finish-wrap (line-wrap-finish line-q block-id))]))))
res]
[_ null]))
Write Preview
Loading…
Cancel
Save