diff --git a/quad/quadwriter/layout.rkt b/quad/quadwriter/layout.rkt index 057ca48e..bf777829 100644 --- a/quad/quadwriter/layout.rkt +++ b/quad/quadwriter/layout.rkt @@ -113,7 +113,7 @@ (define-quad column-break-quad line-break-quad ()) (define q:column-break (make-column-break-quad #:printable #f #: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 #:id 'page-break)) @@ -148,9 +148,9 @@ (define new-run (quad-copy q:string [attrs (quad-attrs strq)] [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 strq))))])) (loop (cons new-run runs) rest)] [(cons first rest) (loop (cons first runs) rest)]))) @@ -183,7 +183,7 @@ (define (sum-of-widths qss) (for*/sum ([qs (in-list qss)] [q (in-list qs)]) - (pt-x (size q)))) + (pt-x (size q)))) (define (space-quad? q) (equal? (quad-elems q) (list " "))) @@ -275,7 +275,7 @@ ;; remove unused soft hyphens so they don't affect final shaping (define pcs-printing (for/list ([pc (in-list pcs-in)] #:unless (equal? (quad-elems pc) '("\u00AD"))) - pc)) + pc)) (define new-lines (cond [(empty? pcs-printing) null] @@ -360,17 +360,17 @@ (apply append ;; next line removes all para-break? quads as a consequence (for/list ([qs (in-list (filter-split qs para-break-quad?))]) - (wrap qs - (λ (q idx) (* (- wrap-size - (quad-ref (car qs) :inset-left 0) - (quad-ref (car qs) :inset-right 0)) - permitted-justify-overfill)) - #:nicely (match (or (current-line-wrap) (quad-ref (car qs) :line-wrap)) - [(or "best" "kp") #true] - [_ #false]) - #:hard-break line-break-quad? - #:soft-break soft-break-for-line? - #:finish-wrap (finish-line-wrap line-q))))])) + (wrap qs + (λ (q idx) (* (- wrap-size + (quad-ref (car qs) :inset-left 0) + (quad-ref (car qs) :inset-right 0)) + permitted-justify-overfill)) + #:nicely (match (or (current-line-wrap) (quad-ref (car qs) :line-wrap)) + [(or "best" "kp") #true] + [_ #false]) + #:hard-break line-break-quad? + #:soft-break soft-break-for-line? + #:finish-wrap (finish-line-wrap line-q))))])) (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))] #:when (and (line-spacer-quad? this-ln) (quad-ref prev-ln :keep-with-next))) - (make-nobreak! this-ln) - (make-nobreak! prev-ln))])) + (make-nobreak! this-ln) + (make-nobreak! prev-ln))])) (define (apply-keeps lines) (define groups-of-lines (contiguous-group-by (λ (x) (quad-ref x :display)) lines)) @@ -464,7 +464,7 @@ ;; adjust drawing coordinates for border inset (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))]) - (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 width height) (pt- (size q) (list (+ bil bir) (+ bit bib)))) ;; fill rect @@ -502,15 +502,15 @@ [(#true) (when (eq? (log-clipping?) 'warn) (for ([line (in-list (quad-elems q))]) - (define line-width (pt-x (size line))) - (define line-elem-width (for/sum ([q (in-list (quad-elems line))]) - (pt-x (size q)))) - (when (< line-width line-elem-width) - (define error-str (apply string-append (for/list ([q (in-list (quad-elems line))]) - (match (quad-elems q) - [(list (? string? str)) str] - [_ ""])))) - (log-quadwriter-warning (format "clipping overfull line: ~v" error-str))))) + (define line-width (pt-x (size line))) + (define line-elem-width (for/sum ([q (in-list (quad-elems line))]) + (pt-x (size q)))) + (when (< line-width line-elem-width) + (define error-str (apply string-append (for/list ([q (in-list (quad-elems line))]) + (match (quad-elems q) + [(list (? string? str)) str] + [_ ""])))) + (log-quadwriter-warning (format "clipping overfull line: ~v" error-str))))) (save doc) (rect doc left top width height) (clip doc)])) @@ -530,7 +530,7 @@ #:attrs (quad-attrs ln0) #:size (delay (pt (pt-x (size ln0)) ; (+ (for/sum ([line (in-list lines)]) - (pt-y (size line))) + (pt-y (size line))) (quad-ref ln0 :inset-top 0) (quad-ref ln0 :inset-bottom 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)]) (define ((col-finish-wrap col-quad) lns . _) - (list (quad-copy col-quad - ;; move block attrs up, so they are visible in page wrap - [attrs (copy-block-attrs (quad-attrs (car lns)) - (hash-copy (quad-attrs col-quad)))] - [elems (from-parent (insert-blocks lns) 'nw)]))) + (match lns + [(cons first-line _) + (list (quad-copy col-quad + ;; move block attrs up, so they are visible in page wrap + [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]) (unless (positive? vertical-height) @@ -569,7 +572,7 @@ #:distance (λ (q dist-so-far wrap-qs) ;; do trial block insertions (for/sum ([x (in-list (insert-blocks wrap-qs))]) - (pt-y (size x)))) + (pt-y (size x)))) #:finish-wrap (col-finish-wrap column-quad)) col-spacer)) @@ -589,15 +592,15 @@ #:no-break (λ (q) (quad-ref q :no-pbr)) #:distance (λ (q dist-so-far 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))))) (define (insert-blocks lines) (define groups-of-lines (contiguous-group-by (λ (x) (quad-ref x :display)) lines)) (append* (for/list ([line-group (in-list groups-of-lines)]) - (if (quad-ref (car line-group) :display) - (list (lines->block line-group)) - line-group)))) + (if (quad-ref (car line-group) :display) + (list (lines->block line-group)) + line-group)))) (define-quad first-line-indent-quad quad ()) diff --git a/quad/quadwriter/tags.rkt b/quad/quadwriter/tags.rkt index 885acd91..dab27417 100644 --- a/quad/quadwriter/tags.rkt +++ b/quad/quadwriter/tags.rkt @@ -95,7 +95,7 @@ :keep-with-next "true") 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 (h3 attrs exprs) (heading-base 14 attrs exprs))