diff --git a/quad/qtest/test-sections-tester.pdf b/quad/qtest/test-sections-tester.pdf index bfddb1a7..e88506f5 100644 Binary files a/quad/qtest/test-sections-tester.pdf and b/quad/qtest/test-sections-tester.pdf differ diff --git a/quad/qtest/test-sections.rkt b/quad/qtest/test-sections.rkt index 0a582d54..358076f2 100644 --- a/quad/qtest/test-sections.rkt +++ b/quad/qtest/test-sections.rkt @@ -1,15 +1,23 @@ #lang quadwriter +'(q ((page-margin-gutter "1.5in")(page-margin-left "0.5in")(page-margin-right "0.5in")) + "Section 1 Page 1 on right" -'(q ((break "section"))) +(q ((break "section"))) -'(q ((page-width "5in")(page-height "5in")(page-side-start "right")) "Section 2 Page 1 on right" +(q ((page-width "5in")(page-height "5in")(page-side-start "right")) "Section 2 Page 1 on right" (q ((break "page"))) "Section 2 Page 2 on left") -'(q ((break "section"))) +(q ((break "section"))) + +(q ((page-width "5in")(page-height "5in")(page-side-start "left")) "Section 3 Page 1 on left" + +(q ((break "page"))) + +"Section 3 Page 2 on right") -'(q ((page-width "5in")(page-height "5in")(page-side-start "left")) "Section 3 Page 1 on left") +) \ No newline at end of file diff --git a/quad/quad/scribblings/quad.scrbl b/quad/quad/scribblings/quad.scrbl index f86c5d28..10e0b66e 100644 --- a/quad/quad/scribblings/quad.scrbl +++ b/quad/quad/scribblings/quad.scrbl @@ -484,15 +484,19 @@ The unusual way of setting the overall page dimensions of the rendered PDF. Both @defthing[#:kind "attribute" page-margin-bottom symbol?] @defthing[#:kind "attribute" page-margin-left symbol?] @defthing[#:kind "attribute" page-margin-right symbol?])]{ -Inset values from the page edges. Value is given as a @tech{dimension string}. Default values depend on size of the page: they are chosen to be not completely bananas. +Inset values from the page edges. Value is a @tech{dimension string}. Default values depend on size of the page: they are chosen to be not completely bananas. +} + +@defthing[#:kind "attribute" page-margin-gutter symbol?]{ +Extra space added to the inner margin of page. Value is a @tech{dimension string}. On right-hand pages, the gutter will be added to the left margin. On left-hand pages, it will be added to the right margin. Default is @racket[0]. } @defthing[#:kind "attribute" page-number-start symbol?]{ -First page number used. Default is @racket[1]. +First page number used. Value is an integer. 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]. +Side that first page appears on. Value is @racket['left] or @racket['right]. A blank page will be inserted if necessary. Default is @racket['right]. } @deftogether[(@defthing[#:kind "attribute" column-count symbol?] @@ -508,21 +512,21 @@ A block is a paragraph or other rectangular item (say, a blockquote or code bloc @defthing[#:kind "attribute" inset-bottom symbol?] @defthing[#:kind "attribute" inset-left symbol?] @defthing[#:kind "attribute" inset-right symbol?])]{ -Inset values increase the layout boundary of the quad. Value is given as a @tech{dimension string}. @racket["0"] by default. +Inset values increase the layout boundary of the quad. Value is a @tech{dimension string}. @racket["0"] by default. } @deftogether[(@defthing[#:kind "attribute" border-inset-top symbol?] @defthing[#:kind "attribute" border-inset-bottom symbol?] @defthing[#:kind "attribute" border-inset-left symbol?] @defthing[#:kind "attribute" border-inset-right symbol?])]{ -Border-inset values do not change the layout boundary of the quad. Rather, they change the position of the border (if any) relative to the layout boundary. Value is given as a @tech{dimension string}. @racket["0"] by default (meaning, the border sits on the layout boundary). +Border-inset values do not change the layout boundary of the quad. Rather, they change the position of the border (if any) relative to the layout boundary. Value is a @tech{dimension string}. @racket["0"] by default (meaning, the border sits on the layout boundary). } @deftogether[(@defthing[#:kind "attribute" border-width-top symbol?] @defthing[#:kind "attribute" border-width-bottom symbol?] @defthing[#:kind "attribute" border-width-left symbol?] @defthing[#:kind "attribute" border-width-right symbol?])]{ -Width of the border on each edge of the quad. Value is given as a @tech{dimension string}. @racket["0"] by default (meaning no border). +Width of the border on each edge of the quad. Value is a @tech{dimension string}. @racket["0"] by default (meaning no border). } @deftogether[(@defthing[#:kind "attribute" border-color-top symbol?] @@ -538,7 +542,7 @@ Color of the background of the quad. Value is a @tech{hex color} string or @tech @deftogether[(@defthing[#:kind "attribute" space-before symbol?] @defthing[#:kind "attribute" space-after symbol?])]{ -Vertical space added around a block. Value is given as a @tech{dimension string}. +Vertical space added around a block. Value is a @tech{dimension string}. } @deftogether[(@defthing[#:kind "attribute" keep-first-lines symbol?] @@ -559,7 +563,7 @@ How the lines are aligned horizontally in the quad. Possibilities are @racket["l } @defthing[#:kind "attribute" first-line-indent symbol?]{ -The indent of the first line in the quad. Value is given as a @tech{dimension string}. +The indent of the first line in the quad. Value is a @tech{dimension string}. } @@ -616,11 +620,11 @@ Two ways of setting OpenType layout features. @racket[font-features] takes a @de @defthing[#:kind "attribute" font-tracking symbol?]{ -Space between characters. Value is given as a @tech{dimension string}. +Space between characters. Value is a @tech{dimension string}. } @defthing[#:kind "attribute" font-baseline-shift symbol?]{ -Vertical offset of font baseline (positive values move the baseline up, negative down). Value is given as a @tech{dimension string}. +Vertical offset of font baseline (positive values move the baseline up, negative down). Value is a @tech{dimension string}. } @defthing[#:kind "attribute" line-height symbol?]{ diff --git a/quad/quadwriter/attrs.rkt b/quad/quadwriter/attrs.rkt index 0329b91e..3cc368f9 100644 --- a/quad/quadwriter/attrs.rkt +++ b/quad/quadwriter/attrs.rkt @@ -155,6 +155,7 @@ Naming guidelines page-margin-bottom page-margin-left page-margin-right + page-margin-gutter footer-display)) @@ -165,6 +166,7 @@ Naming guidelines :page-margin-bottom :page-margin-left :page-margin-right + :page-margin-gutter :column-gap :inset-top :inset-bottom diff --git a/quad/quadwriter/layout.rkt b/quad/quadwriter/layout.rkt index c9f2505c..2a56761a 100644 --- a/quad/quadwriter/layout.rkt +++ b/quad/quadwriter/layout.rkt @@ -512,7 +512,8 @@ (define (make-footer-quad col-q page-idx path) (define-values (dir name _) (split-path (path-replace-extension path #""))) (q #:size (pt 50 default-line-height) - #:attrs (hasheq :page-number (+ (quad-ref col-q :page-number-start (add1 (current-page-count))) (sub1 page-idx)) + #:attrs (hasheq :page-number (+ (quad-ref col-q :page-number-start (add1 (section-pages-used))) + (sub1 page-idx)) :doc-title (string-titlecase (path->string name))) #:from-parent 'sw #:to 'nw @@ -661,7 +662,8 @@ #:finish-wrap (col-finish-wrap column-quad)) col-spacer)) -(define ((page-finish-wrap page-quad path) cols q0 q page-idx) +(define ((page-finish-wrap make-page-quad path) cols q0 q page-idx) + (define page-quad (make-page-quad (+ (section-pages-used) page-idx))) (define elems (match (quad-ref (car cols) :footer-display #true) [(or #false "none") (from-parent cols 'nw)] @@ -671,7 +673,7 @@ [attrs (copy-block-attrs (quad-attrs (car cols)) (hash-copy (quad-attrs page-quad)))]))) -(define (page-wrap qs width [page-quad q:page]) +(define (page-wrap qs width [make-page-quad (λ _ q:page)]) (unless (positive? width) (raise-argument-error 'page-wrap "positive number" width)) (wrap qs width @@ -681,7 +683,7 @@ #:distance (λ (q dist-so-far wrap-qs) (for/sum ([x (in-list wrap-qs)]) (pt-x (size x)))) - #:finish-wrap (page-finish-wrap page-quad (pdf-output-path (current-pdf))))) + #:finish-wrap (page-finish-wrap 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)) diff --git a/quad/quadwriter/param.rkt b/quad/quadwriter/param.rkt index c885ba3c..01927a56 100644 --- a/quad/quadwriter/param.rkt +++ b/quad/quadwriter/param.rkt @@ -10,7 +10,7 @@ (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 section-pages-used (make-parameter 0)) (define quadwriter-test-mode (make-parameter #f)) ; used during rackunit to suppress nondeterministic elements, like timestamp in header @@ -34,7 +34,7 @@ (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 section-pages-used (make-parameter 0)) (define quadwriter-test-mode (make-parameter #f)) diff --git a/quad/quadwriter/render.rkt b/quad/quadwriter/render.rkt index 6e17074b..1133865c 100644 --- a/quad/quadwriter/render.rkt +++ b/quad/quadwriter/render.rkt @@ -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) @@ -135,27 +135,39 @@ indented-qs) (define (setup-margins qs page-width page-height) + ;; if only left or right margin is provided, copy other value in preference to default margin + (define q (car qs)) (define default-side-margin (min (* 72 1.5) (floor (* .20 page-width)))) (define default-top-margin (min 72 (floor (* .10 page-height)))) - - ;; if only left or right margin is provided, copy other value in preference to default margin - (define left - (or (debug-x-margin) - (quad-ref (car qs) :page-margin-left - (λ () (quad-ref (car qs) :page-margin-right default-side-margin))))) - (define right - (or (debug-x-margin) - (quad-ref (car qs) :page-margin-right - (λ () (quad-ref (car qs) :page-margin-left default-side-margin))))) - (define top - (or (debug-y-margin) - (quad-ref (car qs) :page-margin-top - (λ () (quad-ref (car qs) :page-margin-bottom default-top-margin))))) - (define vert-optical-adjustment 10) - (define bottom - (or (debug-y-margin) - (quad-ref (car qs) :page-margin-bottom - (λ () (+ vert-optical-adjustment (quad-ref (car qs) :page-margin-top (* default-top-margin 1.4))))))) + + (define left (cond + [(debug-x-margin)] + [(quad-ref q :page-margin-left)] + [(quad-ref q :page-margin-right)] + [else default-side-margin])) + + (define right (cond + [(debug-x-margin)] + [(quad-ref q :page-margin-right)] + [(quad-ref q :page-margin-left)] + [else default-side-margin])) + + (define top (cond + [(debug-y-margin)] + [(quad-ref q :page-margin-top)] + [(quad-ref q :page-margin-bottom)] + [else default-top-margin])) + + (define bottom (cond + [(debug-y-margin)] + [(quad-ref q :page-margin-bottom)] + [else + (define vert-optical-adjustment 10) + (+ vert-optical-adjustment + (cond + [(quad-ref q :page-margin-top)] + [else (* default-top-margin 1.4)]))])) + (list left top right bottom)) (define default-column-count 1) @@ -195,7 +207,7 @@ ;; 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] + [section-pages-used 0] [verbose-quad-printing? #false]) (define qs (time-log setup-qs (setup-qs qx-arg pdf-path))) (define sections @@ -205,7 +217,8 @@ (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 maybe-gutter-margin (and (pair? qs) (quad-ref (car qs) :page-margin-gutter))) + (define printable-width (- page-width left-margin right-margin (or maybe-gutter-margin 0))) (define printable-height (- page-height top-margin bottom-margin)) (define column-count (setup-column-count qs)) (define column-gap (setup-column-gap qs)) @@ -216,20 +229,26 @@ (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-quad-prototype + (λ (page-count) + (define left-shift (+ left-margin + (cond + [(and (odd? page-count) maybe-gutter-margin)] + [else 0]))) + (struct-copy quad q:page + [shift (pt left-shift top-margin)] + [size (pt line-wrap-size printable-height)]))) (define section-starting-side (string->symbol (quad-ref (car qs) :page-side-start "right"))) (define insert-blank-page? (and (pair? qs) ;; if we need a 'left page and will get 'right (or vice versa) then insert page - (let ([next-page-side (if (even? (add1 (current-page-count))) 'left 'right)]) + (let ([next-page-side (if (even? (add1 (section-pages-used))) 'left 'right)]) (not (eq? section-starting-side next-page-side))))) ;; update page count before starting page wrap (when insert-blank-page? - (current-page-count (add1 (current-page-count)))) + (section-pages-used (add1 (section-pages-used)))) (define section-pages (time-log page-wrap (page-wrap column-qs printable-width page-quad-prototype))) @@ -258,7 +277,7 @@ [_ (list new-section)])])] [else (define new-section (struct-copy quad q:section [elems section-pages]) ) (cons new-section sections-acc)]) - (current-page-count (+ (current-page-count) (length section-pages)))))) + (section-pages-used (+ (section-pages-used) (length section-pages)))))) (define doc (time-log position (position (struct-copy quad q:doc [elems sections])))) (time-log draw (draw doc (current-pdf))))