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

fix page break before (closes #31)

Browse Source
main
Matthew Butterick 5 years ago
parent 73457a85cd
commit b970aa6cd5
2 changed files with 43 additions and 40 deletions
Show Stats Download Patch File Download Diff File

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

@ -113,7 +113,7 @@
(define-quad column-break-quad line-break-quad ()) (define-quad column-break-quad line-break-quad ())
(define q:column-break (make-column-break-quad #:printable #f (define q:column-break (make-column-break-quad #:printable #f
#:id 'column-break)) #:id 'column-break))
(define-quad page-break-quad line-break-quad ()) (define-quad page-break-quad column-break-quad ())
(define q:page-break (make-page-break-quad #:printable #f (define q:page-break (make-page-break-quad #:printable #f
#:id 'page-break)) #:id 'page-break))
@ -148,9 +148,9 @@
(define new-run (quad-copy q:string (define new-run (quad-copy q:string
[attrs (quad-attrs strq)] [attrs (quad-attrs strq)]
[elems (merge-adjacent-strings (apply append (for/list ([pc (in-list run-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)]) [size (delay (pt (for/sum ([pc (in-list run-pcs)])
(pt-x (size pc))) (pt-x (size pc)))
(pt-y (size strq))))])) (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)])))
@ -183,7 +183,7 @@
(define (sum-of-widths qss) (define (sum-of-widths qss)
(for*/sum ([qs (in-list qss)] (for*/sum ([qs (in-list qss)]
[q (in-list qs)]) [q (in-list qs)])
(pt-x (size q)))) (pt-x (size q))))
(define (space-quad? q) (equal? (quad-elems q) (list " "))) (define (space-quad? q) (equal? (quad-elems q) (list " ")))
@ -275,7 +275,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]
@ -360,17 +360,17 @@
(apply append (apply append
;; next line removes all para-break? quads as a consequence ;; next line removes all para-break? quads as a consequence
(for/list ([qs (in-list (filter-split qs para-break-quad?))]) (for/list ([qs (in-list (filter-split qs para-break-quad?))])
(wrap qs (wrap qs
(λ (q idx) (* (- wrap-size (λ (q idx) (* (- wrap-size
(quad-ref (car qs) :inset-left 0) (quad-ref (car qs) :inset-left 0)
(quad-ref (car qs) :inset-right 0)) (quad-ref (car qs) :inset-right 0))
permitted-justify-overfill)) permitted-justify-overfill))
#:nicely (match (or (current-line-wrap) (quad-ref (car qs) :line-wrap)) #:nicely (match (or (current-line-wrap) (quad-ref (car qs) :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 (finish-line-wrap line-q))))])) #:finish-wrap (finish-line-wrap line-q))))]))
(define (make-nobreak! q) (quad-set! q :no-colbr #true)) ; cooperates with col-wrap (define (make-nobreak! q) (quad-set! q :no-colbr #true)) ; cooperates with col-wrap
@ -383,8 +383,8 @@
[prev-ln (in-list (cdr reversed-lines))] [prev-ln (in-list (cdr reversed-lines))]
#:when (and (line-spacer-quad? this-ln) #:when (and (line-spacer-quad? this-ln)
(quad-ref prev-ln :keep-with-next))) (quad-ref prev-ln :keep-with-next)))
(make-nobreak! this-ln) (make-nobreak! this-ln)
(make-nobreak! prev-ln))])) (make-nobreak! prev-ln))]))
(define (apply-keeps lines) (define (apply-keeps 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))
@ -464,7 +464,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
@ -502,15 +502,15 @@
[(#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 (for/sum ([q (in-list (quad-elems line))]) (define line-elem-width (for/sum ([q (in-list (quad-elems line))])
(pt-x (size q)))) (pt-x (size q))))
(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)]))
@ -530,7 +530,7 @@
#:attrs (quad-attrs ln0) #:attrs (quad-attrs ln0)
#:size (delay (pt (pt-x (size ln0)) ; #:size (delay (pt (pt-x (size ln0)) ;
(+ (for/sum ([line (in-list lines)]) (+ (for/sum ([line (in-list lines)])
(pt-y (size line))) (pt-y (size line)))
(quad-ref ln0 :inset-top 0) (quad-ref ln0 :inset-top 0)
(quad-ref ln0 :inset-bottom 0)))) (quad-ref ln0 :inset-bottom 0))))
#:shift-elems (pt 0 (+ (quad-ref ln0 :inset-top 0))) #:shift-elems (pt 0 (+ (quad-ref ln0 :inset-top 0)))
@ -545,11 +545,14 @@
(cons (quad-copy q [from-parent (or where (quad-from q))]) rest)]) (cons (quad-copy q [from-parent (or where (quad-from q))]) rest)])
(define ((col-finish-wrap col-quad) lns . _) (define ((col-finish-wrap col-quad) lns . _)
(list (quad-copy col-quad (match lns
;; move block attrs up, so they are visible in page wrap [(cons first-line _)
[attrs (copy-block-attrs (quad-attrs (car lns)) (list (quad-copy col-quad
(hash-copy (quad-attrs col-quad)))] ;; move block attrs up, so they are visible in page wrap
[elems (from-parent (insert-blocks lns) 'nw)]))) [attrs (copy-block-attrs (quad-attrs first-line)
(hash-copy (quad-attrs col-quad)))]
[elems (from-parent (insert-blocks lns) 'nw)]))]
[_ null]))
(define (column-wrap qs vertical-height column-gap [column-quad q:column]) (define (column-wrap qs vertical-height column-gap [column-quad q:column])
(unless (positive? vertical-height) (unless (positive? vertical-height)
@ -569,7 +572,7 @@
#:distance (λ (q dist-so-far wrap-qs) #:distance (λ (q dist-so-far wrap-qs)
;; do trial block insertions ;; do trial block insertions
(for/sum ([x (in-list (insert-blocks wrap-qs))]) (for/sum ([x (in-list (insert-blocks wrap-qs))])
(pt-y (size x)))) (pt-y (size x))))
#:finish-wrap (col-finish-wrap column-quad)) #:finish-wrap (col-finish-wrap column-quad))
col-spacer)) col-spacer))
@ -589,15 +592,15 @@
#:no-break (λ (q) (quad-ref q :no-pbr)) #:no-break (λ (q) (quad-ref q :no-pbr))
#:distance (λ (q dist-so-far wrap-qs) #:distance (λ (q dist-so-far wrap-qs)
(for/sum ([x (in-list wrap-qs)]) (for/sum ([x (in-list wrap-qs)])
(pt-x (size x)))) (pt-x (size x))))
#:finish-wrap (page-finish-wrap page-quad (pdf-output-path (current-pdf))))) #:finish-wrap (page-finish-wrap page-quad (pdf-output-path (current-pdf)))))
(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 ())

2
quad/quadwriter/tags.rkt
Unescape Escape View File

@ -95,7 +95,7 @@
:keep-with-next "true") attrs) exprs)) :keep-with-next "true") attrs) exprs))
(define-tag-function (h1 attrs exprs) (define-tag-function (h1 attrs exprs)
(heading-base 20 attrs exprs)) (qexpr null (list page-break (heading-base 20 attrs exprs))))
(define-tag-function (h2 attrs exprs) (heading-base 16 attrs exprs)) (define-tag-function (h2 attrs exprs) (heading-base 16 attrs exprs))
(define-tag-function (h3 attrs exprs) (heading-base 14 attrs exprs)) (define-tag-function (h3 attrs exprs) (heading-base 14 attrs exprs))

Write Preview
Loading…
Cancel
Save