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

multiple sections and `page-side-start` attribute (closes #26)

Browse Source
main
Matthew Butterick 5 years ago
parent 8651cd1441
commit 4604b1148b
6 changed files with 73 additions and 39 deletions
Show Stats Download Patch File Download Diff File

BIN
quad/qtest/test-sections-tester.pdf
View File

Binary file not shown.

2
quad/qtest/test-sections.rkt
Unescape Escape View File

@ -4,4 +4,4 @@
'(q ((break "section")))
'(q ((page-width "5in")(page-height "3in")) "Second")
'(q ((page-width "5in")(page-height "5in")(page-number-start "5")(page-side-start "right")) "Second")

13
quad/quad/scribblings/quad.scrbl
Unescape Escape View File

@ -444,6 +444,13 @@ The @tech{Q-expression} @racketresult['#,para-break]. Used to denote the start o
}
@defthing[section-break qexpr?]{
The @tech{Q-expression} @racketresult['#,section-break]. Used to denote the start of a new section.
A section is a contiguous series of pages. Each section has its own @secref{Page-level_attributes}. A document without any explicit section breaks still has one section (that includes all the pages).
}
@subsection{Attributes}
These are the attributes that can be used inside a @tech{Q-expression} passed to @racketmodname[quadwriter]. Inside a Q-expression, every attribute is a @tech[#:doc '(lib "scribblings/guide/guide.scrbl")]{symbol}, and every attribute value is a @tech[#:doc '(lib "scribblings/guide/guide.scrbl")]{string}.
@ -481,7 +488,11 @@ Inset values from the page edges. Value is given as a @tech{dimension string}. D
}
@defthing[#:kind "attribute" page-number-start symbol?]{
First page number used in document.
First page number used. Default is @racket[1].
}
@defthing[#:kind "attribute" page-side-start symbol?]{
Side that first page appears on. Can be @racket['left] or @racket['right]. A blank page will be inserted if necessary. Default is @racket['right].
}
@deftogether[(@defthing[#:kind "attribute" column-count symbol?]

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

@ -147,7 +147,9 @@ Naming guidelines
page-height
page-size ; e.g., "letter"
page-orientation ; only applies to page-size dimensions
page-number-start ; 1
page-side-start ; 'right
page-margin-top
page-margin-bottom

4
quad/quadwriter/param.rkt
Unescape Escape View File

@ -10,6 +10,8 @@
(define current-doc (make-parameter #false))
(define current-pdf (make-parameter #false))
(define current-line-wrap (make-parameter #f)) ; because kp is slow and maybe we want to disable for "draft" mode
(define current-page-count (make-parameter 0))
(define quadwriter-test-mode (make-parameter #f)) ; used during rackunit to suppress nondeterministic elements, like timestamp in header
(define draw-debug? (make-parameter #true))
@ -32,6 +34,8 @@
(define current-doc (make-parameter #false))
(define current-pdf (make-parameter #false))
(define current-line-wrap (make-parameter #f))
(define current-page-count (make-parameter 0))
(define quadwriter-test-mode (make-parameter #f))
(define draw-debug? (make-parameter #false))

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

@ -34,10 +34,10 @@
[(_ ALL-BREAKS-ID . TYPES)
(with-syntax ([((TYPE-BREAK TYPE-STR Q:TYPE-BREAK) ...)
(for/list ([type (in-list (syntax->list #'TYPES))])
(list
(format-id #'TYPES "~a-break" type)
(symbol->string (syntax->datum type))
(format-id #'TYPES "q:~a-break" type)))])
(list
(format-id #'TYPES "~a-break" type)
(symbol->string (syntax->datum type))
(format-id #'TYPES "q:~a-break" type)))])
#'(begin
(define TYPE-BREAK '(q ((break TYPE-STR)))) ...
(define ALL-BREAKS-ID (list (cons TYPE-BREAK Q:TYPE-BREAK) ...))))]))
@ -56,22 +56,22 @@
;; do this before ->string-quad so that it can handle the sizing promises
(apply append
(for/list ([q (in-list qs)])
(match (quad-ref q :hyphenate)
[#true #:when (and (pair? (quad-elems q))
(andmap string? (quad-elems q)))
(for*/list ([str (in-list (quad-elems q))]
[hyphen-char (in-value #\u00AD)]
[hstr (in-value (hyphenate str hyphen-char
#:min-left-length 3
#:min-right-length 3))]
[substr (in-list (regexp-match* (regexp (string hyphen-char)) hstr #:gap-select? #t))])
(struct-copy quad q [elems (list substr)]))]
[_ (list q)]))))
(match (quad-ref q :hyphenate)
[#true #:when (and (pair? (quad-elems q))
(andmap string? (quad-elems q)))
(for*/list ([str (in-list (quad-elems q))]
[hyphen-char (in-value #\u00AD)]
[hstr (in-value (hyphenate str hyphen-char
#:min-left-length 3
#:min-right-length 3))]
[substr (in-list (regexp-match* (regexp (string hyphen-char)) hstr #:gap-select? #t))])
(struct-copy quad q [elems (list substr)]))]
[_ (list q)]))))
(define (string->feature-list str)
(for/list ([kv (in-slice 2 (string-split str))])
(cons (string->bytes/utf-8 (first kv)) (string->number (second kv)))))
(cons (string->bytes/utf-8 (first kv)) (string->number (second kv)))))
(define (parse-font-features! attrs)
(cond
@ -93,14 +93,14 @@
(define (parse-dimension-strings! attrs)
(for ([k (in-hash-keys attrs)]
#:when (takes-dimension-string? k))
(hash-update! attrs k parse-dimension))
(hash-update! attrs k parse-dimension))
attrs)
(define (complete-every-path! attrs)
;; relies on `current-directory` being parameterized to source file's dir
(for ([k (in-hash-keys attrs)]
#:when (takes-path? k))
(hash-update! attrs k (compose1 path->string path->complete-path)))
(hash-update! attrs k (compose1 path->string path->complete-path)))
attrs)
(define (handle-cascading-attrs attrs)
@ -169,7 +169,8 @@
(define (setup-column-gap qs)
(or (debug-column-gap) (quad-ref (car qs) :column-gap default-column-gap)))
(define/contract (render-pdf qx-arg pdf-path-arg [base-dir-arg #f]
(define/contract (render-pdf qx-arg pdf-path-arg
[base-dir-arg #false]
#:replace [replace-existing-file? #t]
#:compress [compress? #t])
((qexpr? (or/c #false path? path-string?))
@ -194,31 +195,47 @@
;; set `current-directory` so that ops like `path->complete-path`
;; will be handled relative to the original directory
[current-directory base-dir]
[current-page-count 0]
[verbose-quad-printing? #false])
(define qs (time-log setup-qs (setup-qs qx-arg pdf-path)))
(define sections
(for/list ([qs (in-list (filter-split qs section-break-quad?))])
(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))
(define printable-height (- page-height top-margin bottom-margin))
(define column-count (setup-column-count qs))
(define column-gap (setup-column-gap 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))
(define printable-height (- page-height top-margin bottom-margin))
(define column-count (setup-column-count qs))
(define column-gap (setup-column-gap qs))
(define line-wrap-size (/ (- printable-width (* (sub1 column-count) column-gap)) column-count))
(define line-qs (time-log line-wrap (apply-keeps (line-wrap qs line-wrap-size))))
(define line-wrap-size (/ (- printable-width (* (sub1 column-count) column-gap)) column-count))
(define line-qs (time-log line-wrap (apply-keeps (line-wrap qs line-wrap-size))))
(define col-quad-prototype (struct-copy quad q:column
[size (pt line-wrap-size printable-height)]))
(define column-qs (time-log column-wrap (column-wrap line-qs printable-height column-gap col-quad-prototype)))
(define col-quad-prototype (struct-copy quad q:column
[size (pt line-wrap-size printable-height)]))
(define column-qs (time-log column-wrap (column-wrap line-qs printable-height column-gap col-quad-prototype)))
(define page-quad-prototype (struct-copy quad q:page
[shift (pt left-margin top-margin)]
[size (pt line-wrap-size printable-height)]))
(define page-qs (time-log page-wrap (page-wrap column-qs printable-width page-quad-prototype)))
(struct-copy quad q:section [elems page-qs])))
(define page-quad-prototype (struct-copy quad q:page
[shift (pt left-margin top-margin)]
[size (pt line-wrap-size printable-height)]))
(define next-page-side (if (even? (add1 (current-page-count))) 'left 'right))
(define insert-blank-page?
(and (pair? qs)
(let ([section-starting-side (string->symbol (quad-ref (car qs) :page-side-start "right"))])
;; if we need a 'left page and will get 'right (or vice versa) then insert page
(not (eq? section-starting-side next-page-side)))))
(define page-qs
(match (time-log page-wrap (page-wrap column-qs printable-width page-quad-prototype))
[ps #:when insert-blank-page?
(define blank-page (struct-copy quad (car ps) [elems null]))
(cons blank-page ps)]
[ps ps]))
(begin0
(struct-copy quad q:section [elems page-qs])
(current-page-count (+ (current-page-count) (length page-qs))))))
(define doc (time-log position (position (struct-copy quad q:doc [elems sections]))))
(time-log draw (draw doc (current-pdf))))

Write Preview
Loading…
Cancel
Save