diff --git a/quad/quadwriter/layout.rkt b/quad/quadwriter/layout.rkt index 674ec4ae..8d487068 100644 --- a/quad/quadwriter/layout.rkt +++ b/quad/quadwriter/layout.rkt @@ -203,9 +203,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)]))) @@ -238,7 +238,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 " "))) @@ -330,7 +330,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] @@ -420,17 +420,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 @@ -443,8 +443,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)) @@ -472,8 +472,26 @@ (make-nobreak! ln)])) (cons ln reversed-lines))) + +(define default-page-size "letter") +(define default-page-orientation "tall") +(define (parse-page-size q) + ;; page size can be specified by name, or measurements. + ;; explicit measurements from page-height and page-width supersede those from page-size. + (match-define (list page-width page-height) + (for/list ([k (list :page-width :page-height)]) + (and (quad? q) (match (quad-ref q k) + [#false #false] + [val (inexact->exact (floor val))])))) + (resolve-page-size + (or (debug-page-width) page-width) + (or (debug-page-height) page-height) + (quad-ref q :page-size default-page-size) + (quad-ref q :page-orientation default-page-orientation))) + (define (page-draw-start q doc) - (add-page doc) + (match-define (list page-width page-height) (parse-page-size q)) + (add-page doc page-width page-height) (scale doc (zoom-factor) (zoom-factor)) (draw-debug q doc "aliceblue" "aliceblue" 3)) @@ -525,7 +543,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 @@ -564,15 +582,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)])) @@ -592,7 +610,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)) @@ -634,7 +652,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)) @@ -643,7 +661,10 @@ (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))])) - (list (quad-copy page-quad [elems elems]))) + (list (quad-copy page-quad + [elems elems] + [attrs (copy-block-attrs (quad-attrs (car cols)) + (hash-copy (quad-attrs page-quad)))]))) (define (page-wrap qs width [page-quad q:page]) (unless (positive? width) @@ -654,18 +675,18 @@ #: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 (section-wrap qs) - qs) + (list qs)) (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/render.rkt b/quad/quadwriter/render.rkt index 7714811e..5c847f9f 100644 --- a/quad/quadwriter/render.rkt +++ b/quad/quadwriter/render.rkt @@ -21,8 +21,7 @@ "log.rkt") (provide (all-defined-out)) -(define default-page-size "letter") -(define default-page-orientation "tall") + (define (setup-pdf-path pdf-path-arg) (define fallback-path (build-path (find-system-path 'temp-dir) "quadwriter-temp.pdf")) @@ -161,20 +160,6 @@ (define (setup-column-gap qs) (or (debug-column-gap) (quad-ref (car qs) :column-gap default-column-gap))) -(define (set-page-size! the-pdf qs) - ;; page size can be specified by name, or measurements. - ;; explicit measurements from page-height and page-width supersede those from page-size. - (match-define (list page-width page-height) - (for/list ([k (list :page-width :page-height)]) - (and (pair? qs) (match (quad-ref (car qs) k) - [#false #false] - [val (inexact->exact (floor val))])))) - (resolve-page-size - (or (debug-page-width) page-width) - (or (debug-page-height) page-height) - (quad-ref (car qs) :page-size default-page-size) - (quad-ref (car qs) :page-orientation default-page-orientation))) - (define/contract (render-pdf qx-arg pdf-path-arg #:replace [replace-existing-file? #t] #:compress [compress? #t]) @@ -195,7 +180,7 @@ (define sections (time-log section-wrap (section-wrap qs))) (for ([qs (in-list sections)]) - (match-define (list page-width page-height) (set-page-size! the-pdf qs)) + (match-define (list page-width page-height) (parse-page-size (and (pair? qs) (car qs)))) (match-define (list left-margin top-margin right-margin bottom-margin) (setup-margins qs page-width page-height)) (define printable-width (- page-width left-margin right-margin))