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

better break conversion

Browse Source
main
Matthew Butterick 4 years ago
parent 111adae426
commit 7a01ac7878
1 changed files with 135 additions and 120 deletions
Show Stats Download Patch File Download Diff File

255
quad/quadwriter/layout.rkt
Unescape Escape View File

@ -121,18 +121,22 @@
(list string-size (quad-ref q :line-height default-line-height)))) (list string-size (quad-ref q :line-height default-line-height))))
(define (convert-break-quad q) (define (convert-break-quad q)
(define break-quad-type (match (quad-ref q :break) ;; this is verbose & ugly because `struct-copy` is a macro
["para" para-break-quad] ;; we want to use break prototypes but also preserve their type
["line" line-break-quad] (match (quad-ref q :break)
["page" page-break-quad] ["para" (struct-copy para-break-quad q:para-break
["column" column-break-quad] [attrs #:parent quad (quad-attrs q)])]
["hr" hr-break-quad] ["line" (struct-copy line-break-quad q:line-break
["section" section-break-quad] [attrs #:parent quad (quad-attrs q)])]
[_ #false])) ["page" (struct-copy page-break-quad q:page-break
(if break-quad-type [attrs #:parent quad (quad-attrs q)])]
(make-quad #:type break-quad-type ["column" (struct-copy column-break-quad q:column-break
#:attrs (quad-attrs q)) [attrs #:parent quad (quad-attrs q)])]
q)) ["hr" (struct-copy hr-break-quad q:hr-break
[attrs #:parent quad (quad-attrs q)])]
["section" (struct-copy section-break-quad q:section-break
[attrs #:parent quad (quad-attrs q)])]
[_ q]))
(module+ test (module+ test
(check-equal? (quad-ref (convert-break-quad (qexpr->quad '(q ((break "page") (foo "bar"))))) 'foo) "bar")) (check-equal? (quad-ref (convert-break-quad (qexpr->quad '(q ((break "page") (foo "bar"))))) 'foo) "bar"))
@ -259,15 +263,16 @@
(define (consolidate-runs pcs ending-q) (define (consolidate-runs pcs ending-q)
(let loop ([runs empty][pcs pcs]) (let loop ([runs empty][pcs pcs])
(match pcs (match pcs
[(? empty?) (reverse runs)]
[(cons (? string-quad? strq) rest) [(cons (? string-quad? strq) rest)
(define-values (run-pcs rest) (splitf-at pcs (λ (p) (same-run? strq p)))) (define-values (run-pcs rest) (splitf-at pcs (λ (p) (same-run? strq p))))
(define new-run (quad-copy q:string (define new-run
[attrs (quad-attrs strq)] (quad-copy q:string
[elems (merge-adjacent-strings (apply append (map quad-elems run-pcs)))] [attrs (quad-attrs strq)]
[size (delay (pt (sum-x run-pcs) (pt-y (size strq))))])) [elems (merge-adjacent-strings (apply append (map quad-elems run-pcs)))]
[size (delay (pt (sum-x run-pcs) (pt-y (size strq))))]))
(loop (cons new-run runs) rest)] (loop (cons new-run runs) rest)]
[(cons first rest) (loop (cons first runs) rest)]))) [(cons first rest) (loop (cons first runs) rest)]
[_ (reverse runs)])))
(define (render-hyphen qs ending-q) (define (render-hyphen qs ending-q)
;; naive handling of soft hyphen: ;; naive handling of soft hyphen:
@ -327,9 +332,9 @@
(append sublists (list last-sublist))])] (append sublists (list last-sublist))])]
[_ word-sublists])) [_ word-sublists]))
(define word-width (for/sum ([qs (in-list hung-word-sublists)]) (define word-width (for/sum ([qs (in-list hung-word-sublists)])
(sum-x qs))) (sum-x qs)))
(define word-space-width (for/sum ([qs (in-list word-space-sublists)]) (define word-space-width (for/sum ([qs (in-list word-space-sublists)])
(sum-x qs))) (sum-x qs)))
(define empty-hspace (- line-width (define empty-hspace (- line-width
(quad-ref (car qs) :inset-left 0) (quad-ref (car qs) :inset-left 0)
word-width word-width
@ -390,7 +395,7 @@
;; remove unused soft hyphens so they don't affect final shaping ;; remove unused soft hyphens so they don't affect final shaping
(define pcs-printing (for/list ([pc (in-list pcs-in)] (define pcs-printing (for/list ([pc (in-list pcs-in)]
#:unless (equal? (quad-elems pc) '("\u00AD"))) #:unless (equal? (quad-elems pc) '("\u00AD")))
pc)) pc))
(define new-lines (define new-lines
(cond (cond
[(empty? pcs-printing) null] [(empty? pcs-printing) null]
@ -405,49 +410,54 @@
[(? pair? elems) [(? pair? elems)
(define elem (unsafe-car elems)) (define elem (unsafe-car elems))
(match-define (list line-width line-height) (quad-size line-q)) (match-define (list line-width line-height) (quad-size line-q))
(define new-size (let () (define new-size
(define line-heights (let ([line-heights
(filter-map (λ (q) (or (quad-ref q :line-height) (pt-y (size q)))) pcs)) (filter-map
(pt line-width (if (empty? line-heights) line-height (apply max line-heights))))) (λ (q) (or (quad-ref q :line-height) (pt-y (size q))))
pcs)])
(pt line-width (if (empty? line-heights)
line-height
(apply max line-heights)))))
(list (list
(quad-copy line-q (quad-copy
;; move block attrs up, so they are visible in col wrap line-q
[attrs (copy-block-attrs (quad-attrs elem) ;; move block attrs up, so they are visible in col wrap
(hash-copy (quad-attrs line-q)))] [attrs (copy-block-attrs (quad-attrs elem)
;; line width is static (hash-copy (quad-attrs line-q)))]
;; line height is the max 'line-height value or the natural height of q:line ;; line width is static
[size new-size] ;; line height is the max 'line-height value or the natural height of q:line
;; handle list indexes. drop new quad into line to hold list index [size new-size]
;; could also use this for line numbers ;; handle list indexes. drop new quad into line to hold list index
[elems ;; could also use this for line numbers
;; we assume here that a list item has already had extra inset-left [elems
;; with room for a bullet ;; we assume here that a list item has already had extra inset-left
;; which we just insert at the front. ;; with room for a bullet
;; this is safe because line has already been filled. ;; which we just insert at the front.
(append ;; this is safe because line has already been filled.
;; only put bullet into line if we're at the first line of the list item (append
(match (and (eq? idx 1) (quad-ref elem :list-index)) ;; only put bullet into line if we're at the first line of the list item
[#false null] (match (and (eq? idx 1) (quad-ref elem :list-index))
[bullet [#false null]
(define bq (quad-copy q:string ;; copy q:string to get draw routine [bullet
;; borrow attrs from elem (define bq (quad-copy q:string ;; copy q:string to get draw routine
[attrs (quad-attrs elem)] ;; borrow attrs from elem
;; use bullet as elems [attrs (quad-attrs elem)]
[elems (list (if (number? bullet) (format "~a." bullet) bullet))] ;; use bullet as elems
;; size doesn't matter because nothing refers to this quad [elems (list (if (number? bullet) (format "~a." bullet) bullet))]
;; just for debugging box ;; size doesn't matter because nothing refers to this quad
[size (pt 15 (pt-y (size line-q)))])) ;; just for debugging box
(from-parent (list bq) 'sw)]) [size (pt 15 (pt-y (size line-q)))]))
(from-parent (from-parent (list bq) 'sw)])
(match (quad-ref elem :inset-left 0) (from-parent
[0 elems] (match (quad-ref elem :inset-left 0)
[inset-val [0 elems]
(cons (make-quad [inset-val
#:draw-end q:string-draw-end (cons (make-quad
#:to 'sw #:draw-end q:string-draw-end
#:size (pt inset-val 5) #:to 'sw
#:type offsetter-quad) #:size (pt inset-val 5)
elems)]) 'sw))]))] #:type offsetter-quad)
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 opening-q (append (match opening-q
@ -486,32 +496,34 @@
(loop rest (cons bq acc))] (loop rest (cons bq acc))]
[(list* (and (not (? para-break-quad?)) nbqs) ... rest) [(list* (and (not (? para-break-quad?)) nbqs) ... rest)
(loop rest (cons nbqs acc))]))) (loop rest (cons nbqs acc))])))
(apply append (define res
(apply append
(for/list ([para-qs (in-list para-qss)]) (for/list ([para-qs (in-list para-qss)])
(match para-qs (match para-qs
[(? break-quad? bq) (list bq)] [(? break-quad? bq) (list bq)]
[(cons pq _) [(cons pq _)
(wrap para-qs (wrap para-qs
(* (- wrap-size (* (- wrap-size
(quad-ref pq :inset-left 0) (quad-ref pq :inset-left 0)
(quad-ref pq :inset-right 0)) (quad-ref pq :inset-right 0))
permitted-justify-overfill) permitted-justify-overfill)
debug debug
#:nicely (match (or (current-line-wrap) (quad-ref pq :line-wrap)) #:nicely (match (or (current-line-wrap) (quad-ref pq :line-wrap))
[(or "best" "kp") #true] [(or "best" "kp") #true]
[_ #false]) [_ #false])
#:hard-break line-break-quad? #:hard-break line-break-quad?
#:soft-break soft-break-for-line? #:soft-break soft-break-for-line?
#:finish-wrap (line-wrap-finish line-q))])))] #:finish-wrap (line-wrap-finish line-q))]))))
res]
[_ null])) [_ null]))
(module+ test (module+ test
(line-wrap (list (make-quad "foo" #:type string-quad) (line-wrap (list (make-quad "foo" #:type string-quad)
(make-quad #:type column-break-quad) (make-quad #:type column-break-quad)
(make-quad "foo2" #:type string-quad) ) 10 #t) (make-quad "foo2" #:type string-quad) ) 10 #t)
(line-wrap (list (make-quad "foo" #:type string-quad) (line-wrap (list (make-quad "foo" #:type string-quad)
(make-quad #:type column-break-quad)) 10 #t)) (make-quad #:type column-break-quad)) 10 #t))
(define (make-nobreak! q) (quad-set! q :no-colbr #true)) ; scooperates with col-wrap (define (make-nobreak! q) (quad-set! q :no-colbr #true)) ; scooperates with col-wrap
@ -561,9 +573,9 @@
;; explicit measurements from page-height and page-width supersede those from page-size. ;; explicit measurements from page-height and page-width supersede those from page-size.
(match-define (list page-width page-height) (match-define (list page-width page-height)
(for/list ([k (list :page-width :page-height)]) (for/list ([k (list :page-width :page-height)])
(and (quad? q) (match (quad-ref q k) (and (quad? q) (match (quad-ref q k)
[#false #false] [#false #false]
[val (inexact->exact (floor val))])))) [val (inexact->exact (floor val))]))))
(resolve-page-size (resolve-page-size
(or (debug-page-width) page-width) (or (debug-page-width) page-width)
(or (debug-page-height) page-height) (or (debug-page-height) page-height)
@ -633,7 +645,7 @@
;; adjust drawing coordinates for border inset ;; adjust drawing coordinates for border inset
(match-define (list bil bit bir bib) (match-define (list bil bit bir bib)
(for/list ([k (in-list (list :border-inset-left :border-inset-top :border-inset-right :border-inset-bottom))]) (for/list ([k (in-list (list :border-inset-left :border-inset-top :border-inset-right :border-inset-bottom))])
(quad-ref first-line k 0))) (quad-ref first-line k 0)))
(match-define (list left top) (pt+ (quad-origin q) (list bil bit))) (match-define (list left top) (pt+ (quad-origin q) (list bil bit)))
(match-define (list width height) (pt- (size q) (list (+ bil bir) (+ bit bib)))) (match-define (list width height) (pt- (size q) (list (+ bil bir) (+ bit bib))))
;; fill rect ;; fill rect
@ -671,14 +683,14 @@
[(#true) [(#true)
(when (eq? (log-clipping?) 'warn) (when (eq? (log-clipping?) 'warn)
(for ([line (in-list (quad-elems q))]) (for ([line (in-list (quad-elems q))])
(define line-width (pt-x (size line))) (define line-width (pt-x (size line)))
(define line-elem-width (sum-x (quad-elems line))) (define line-elem-width (sum-x (quad-elems line)))
(when (< line-width line-elem-width) (when (< line-width line-elem-width)
(define error-str (apply string-append (for/list ([q (in-list (quad-elems line))]) (define error-str (apply string-append (for/list ([q (in-list (quad-elems line))])
(match (quad-elems q) (match (quad-elems q)
[(list (? string? str)) str] [(list (? string? str)) str]
[_ ""])))) [_ ""]))))
(log-quadwriter-warning (format "clipping overfull line: ~v" error-str))))) (log-quadwriter-warning (format "clipping overfull line: ~v" error-str)))))
(save doc) (save doc)
(rect doc left top width height) (rect doc left top width height)
(clip doc)])) (clip doc)]))
@ -715,10 +727,10 @@
(define ((column-wrap-finish col-quad) lns q0 ending-q idx [reversed-fn-lines null]) (define ((column-wrap-finish col-quad) lns q0 ending-q idx [reversed-fn-lines null])
(define fn-lines (define fn-lines
(from-parent (for/list ([fn-line (in-list reversed-fn-lines)]) (from-parent (for/list ([fn-line (in-list reversed-fn-lines)])
;; position bottom to top, in reverse ;; position bottom to top, in reverse
(quad-update! fn-line (quad-update! fn-line
[from 'nw] [from 'nw]
[to 'sw])) 'sw)) [to 'sw])) 'sw))
(append (append
(match lns (match lns
@ -777,10 +789,10 @@ https://github.com/mbutterick/typesetter/blob/882ec681ad1fa6eaee6287e53bc4320d96
(raise 'boom))))) (raise 'boom)))))
(define reversed-fn-lines (define reversed-fn-lines
(from-parent (for/list ([fn-line (in-list (reverse fn-lines))]) (from-parent (for/list ([fn-line (in-list (reverse fn-lines))])
;; position bottom to top, in reverse ;; position bottom to top, in reverse
(quad-update! fn-line (quad-update! fn-line
[from 'nw] [from 'nw]
[to 'sw])) 'sw)) [to 'sw])) 'sw))
(quad-update! (car cols) (quad-update! (car cols)
[elems (append (quad-elems (car cols)) reversed-fn-lines)]) [elems (append (quad-elems (car cols)) reversed-fn-lines)])
(define col-spacer (quad-copy q:column-spacer [size (pt column-gap (and 'arbitrary-irrelevant-value 100))])) (define col-spacer (quad-copy q:column-spacer [size (pt column-gap (and 'arbitrary-irrelevant-value 100))]))
@ -789,18 +801,21 @@ https://github.com/mbutterick/typesetter/blob/882ec681ad1fa6eaee6287e53bc4320d96
(verbose-quad-printing? #t) (verbose-quad-printing? #t)
(define ((page-wrap-finish make-page-quad path) cols q0 q page-idx) (define ((page-wrap-finish make-page-quad path) cols q0 q page-idx)
(define page-quad (make-page-quad (+ (section-pages-used) page-idx))) (define page-quad (make-page-quad (+ (section-pages-used) page-idx)))
;; get attrs from cols if we can, otherwise try q or q0
(define q-for-attrs (cond
[(pair? cols) (car cols)]
[q]
[q0]))
(define elems (define elems
(append (append
(match (and (pair? cols) (quad-ref (car cols) :footer-display #true)) (match (quad-ref q-for-attrs :footer-display #true)
[(or #false "none") null] [(or #false "none") null]
[_ (list (make-footer-quad (car cols) page-idx path))]) [_ (list (make-footer-quad q-for-attrs page-idx path))])
(from-parent cols 'nw))) (from-parent cols 'nw)))
(list (quad-copy page-quad (list (quad-copy page-quad
[elems elems] [elems elems]
[attrs (copy-block-attrs (cond [attrs (copy-block-attrs (cond
;; get attrs from cols if we can, [q-for-attrs => quad-attrs]
;; otherwise try q or q0
[(or (and (pair? cols) (car cols)) q q0) => quad-attrs]
[else (hash)]) [else (hash)])
(hash-copy (quad-attrs page-quad)))]))) (hash-copy (quad-attrs page-quad)))])))
@ -817,9 +832,9 @@ https://github.com/mbutterick/typesetter/blob/882ec681ad1fa6eaee6287e53bc4320d96
(define (insert-blocks lines) (define (insert-blocks lines)
(define groups-of-lines (contiguous-group-by (λ (x) (quad-ref x :display)) lines)) (define groups-of-lines (contiguous-group-by (λ (x) (quad-ref x :display)) lines))
(append* (for/list ([line-group (in-list groups-of-lines)]) (append* (for/list ([line-group (in-list groups-of-lines)])
(if (quad-ref (car line-group) :display) (if (quad-ref (car line-group) :display)
(list (lines->block line-group)) (list (lines->block line-group))
line-group)))) line-group))))
(define-quad first-line-indent-quad quad) (define-quad first-line-indent-quad quad)
@ -837,11 +852,11 @@ https://github.com/mbutterick/typesetter/blob/882ec681ad1fa6eaee6287e53bc4320d96
(apply append (apply append
(for/list ([q (in-list qs)] (for/list ([q (in-list qs)]
[next-q (in-list (cdr qs))]) [next-q (in-list (cdr qs))])
(match (and (para-break-quad? q) (quad-ref next-q :first-line-indent 0)) (match (and (para-break-quad? q) (quad-ref next-q :first-line-indent 0))
[(or #false 0) (list next-q)] [(or #false 0) (list next-q)]
[indent-val (list (make-quad #:from 'bo [indent-val (list (make-quad #:from 'bo
#:to 'bi #:to 'bi
#:draw-end q:string-draw-end #:draw-end q:string-draw-end
#:type first-line-indent-quad #:type first-line-indent-quad
#:attrs (quad-attrs next-q) #:attrs (quad-attrs next-q)
#:size (pt indent-val 10)) next-q)])))) #:size (pt indent-val 10)) next-q)]))))

Write Preview
Loading…
Cancel
Save