diff --git a/quad/qtest/tesst-columns.rkt b/quad/qtest/tesst-columns.rkt new file mode 100644 index 00000000..96c052a1 --- /dev/null +++ b/quad/qtest/tesst-columns.rkt @@ -0,0 +1,39 @@ +#lang quadwriter + +'(q ((page-height "6in")(column-count "2")) + +"Page 1 Column 1 Line 1" + +(q ((break "line"))) + +"Page 1 Column 1 Line 2" + +(q ((break "column"))) + +"Page 1 Column 2 Line 1" + +(q ((break "line"))) + +"Page 1 Column 2 Line 2" + +(q ((break "page"))) + + +"Page 2 Column 1 Line 1" + +(q ((break "line"))) + +(q ((break "column"))) + +(q ((break "page"))) + + +"Page 3 Column 1 Line 1" + +(q ((break "page"))) + +(q ((break "page"))) + +"Page 5 Column 1 Line 1" + +) \ No newline at end of file diff --git a/quad/quadwriter/layout.rkt b/quad/quadwriter/layout.rkt index cc11c94d..0b979eeb 100644 --- a/quad/quadwriter/layout.rkt +++ b/quad/quadwriter/layout.rkt @@ -366,7 +366,7 @@ (define (make-hr-quad line-q) (quad-copy line-q [draw-start hr-draw])) -(define ((finish-line-wrap line-q) pcs-in opening-q ending-q idx) +(define ((line-wrap-finish line-q) pcs-in opening-q ending-q idx) ;; 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 (define pcs-printing (for/list ([pc (in-list pcs-in)] @@ -436,7 +436,7 @@ [_ null]) new-lines (match ending-q - [(? page-break-quad? page-break) (list page-break)] ; hard 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 [_ null]))) ; hard line break @@ -469,7 +469,7 @@ [_ #false]) #:hard-break line-break-quad? #:soft-break soft-break-for-line? - #:finish-wrap (finish-line-wrap line-q))))])) + #:finish-wrap (line-wrap-finish line-q))))])) (define (make-nobreak! q) (quad-set! q :no-colbr #true)) ; cooperates with col-wrap @@ -670,21 +670,26 @@ (quad-update! q [from-parent (or where (quad-from q))]) (cons q rest)]) -(define ((col-finish-wrap 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 (from-parent (for/list ([fn-line (in-list reversed-fn-lines)]) ;; position bottom to top, in reverse (quad-update! fn-line [from 'nw] [to 'sw])) 'sw)) - (match lns - [(cons line _) - (list (quad-copy col-quad - ;; move block attrs up, so they are visible in page wrap - [attrs (copy-block-attrs (quad-attrs line) - (hash-copy (quad-attrs col-quad)))] - [elems (append (from-parent (insert-blocks lns) 'nw) fn-lines)]))] - [_ null])) + + (append + (match lns + [(cons line _) + (list (quad-copy col-quad + ;; move block attrs up, so they are visible in page wrap + [attrs (copy-block-attrs (quad-attrs line) + (hash-copy (quad-attrs col-quad)))] + [elems (append (from-parent (insert-blocks lns) 'nw) fn-lines)]))] + [_ null]) + (match ending-q + [(? page-break-quad? page-break) (list page-break)] ; hard page (or section) break + [_ null]))) #| constraint wrapping example @@ -708,7 +713,7 @@ https://github.com/mbutterick/typesetter/blob/882ec681ad1fa6eaee6287e53bc4320d96 #:distance (λ (q dist-so-far wrap-qs) ;; do trial block insertions (sum-y (insert-blocks (reverse wrap-qs)))) - #:finish-wrap (col-finish-wrap column-quad) + #:finish-wrap (column-wrap-finish column-quad) #:footnote-qs fn-lines #:footnote-leftover-proc (λ (ymax leftover-qs fn-qs) (let loop ([ymax ymax][leftover-qs leftover-qs][fn-qs fn-qs]) @@ -739,18 +744,25 @@ https://github.com/mbutterick/typesetter/blob/882ec681ad1fa6eaee6287e53bc4320d96 (define col-spacer (quad-copy q:column-spacer [size (pt column-gap (and 'arbitrary-irrelevant-value 100))])) (add-between cols col-spacer)) -(define ((page-finish-wrap 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))) + #R page-idx + #R q0 + #R q (define elems - (match (quad-ref (car cols) :footer-display #true) - [(or #false "none") (from-parent cols 'nw)] - [_ (cons (make-footer-quad (car cols) page-idx path) (from-parent cols 'nw))])) + (append + (match (and (pair? cols) (quad-ref (car cols) :footer-display #true)) + [(or #false "none") null] + [_ (list (make-footer-quad (car cols) page-idx path))]) + (from-parent cols 'nw))) (list (quad-copy page-quad [elems elems] - [attrs (copy-block-attrs (quad-attrs (car cols)) + [attrs (copy-block-attrs (if (pair? cols) + (quad-attrs (car cols)) + (hash)) (hash-copy (quad-attrs page-quad)))]))) -(define (page-wrap qs width [make-page-quad (λ _ q:page)]) +(define (page-wrap qs width [make-page-quad (λ (x) q:page)]) (unless (positive? width) (raise-argument-error 'page-wrap "positive number" width)) (wrap qs width @@ -758,7 +770,7 @@ https://github.com/mbutterick/typesetter/blob/882ec681ad1fa6eaee6287e53bc4320d96 #:hard-break page-break-quad? #:no-break (λ (q) (quad-ref q :no-pbr)) #:distance (λ (q dist-so-far wrap-qs) (sum-x wrap-qs)) - #:finish-wrap (page-finish-wrap make-page-quad (pdf-output-path (current-pdf))))) + #:finish-wrap (page-wrap-finish make-page-quad (pdf-output-path (current-pdf))))) (define (insert-blocks lines) (define groups-of-lines (contiguous-group-by (λ (x) (quad-ref x :display)) lines))