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

per-page sizing

Browse Source
main
Matthew Butterick 5 years ago
parent 4b8e4c2992
commit 79b11ea75e
2 changed files with 59 additions and 53 deletions
Show Stats Download Patch File Download Diff File

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

@ -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 ())

19
quad/quadwriter/render.rkt
Unescape Escape View File

@ -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))

Write Preview
Loading…
Cancel
Save