From 4604b1148b5db49aa24883d70b6d679d427faac0 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Fri, 9 Aug 2019 19:59:22 -0700
Subject: [PATCH] multiple sections and `page-side-start` attribute (closes
 #26)

---
 quad/qtest/test-sections-tester.pdf | Bin 6276 -> 6622 bytes
 quad/qtest/test-sections.rkt        |   2 +-
 quad/quad/scribblings/quad.scrbl    |  13 +++-
 quad/quadwriter/attrs.rkt           |   2 +
 quad/quadwriter/param.rkt           |   4 ++
 quad/quadwriter/render.rkt          |  91 +++++++++++++++++-----------
 6 files changed, 73 insertions(+), 39 deletions(-)

diff --git a/quad/qtest/test-sections-tester.pdf b/quad/qtest/test-sections-tester.pdf
index 02b03ea75641dd51ce99c083e688e23c7332396c..9e8e3188755db58a0bc777db7c6791bd9e20b6b7 100644
GIT binary patch
delta 722
zcmZoMyk|VYmeF{kogR~+;lx}C6=O4lST6mb)Z+ZoqU6+K1w$hR1BD<iJ3B6})V!4Z
zq%1B&qlwE)#SIOC;vlY#4VS)8YF>IthJvA?#pH8LN<79P1`JNI&I*Y+X$vMNFdEw*
zV|&J>=+JzpM}((W#OczGMY%jYJZBni$aLs7+z{#zZnQY*cTgcr@ksY+(-!Rs+zi}H
z6mEj-D=sNYP0XEW637g6*TjzS$%2e>Oh%R<TcnX~nK0*cDu-C(1P48aWMMY`&BqzH
zF*2G=u46V}GchnVF*TmNg;{~obn{i_w|p{YNG^BF&nxju%uQ9$4|Wdnb#<M5PsobV
zbh4yyC!_h~#lnhgaAC>GkA+tWgY=??hQ;OuBKeFG<{$}R$T=kzr-BScGEj1|gP0+s
z#pEI}Ye5A=W2i#s{8FGQ<H_5_+!!q<{}YoAF*7g$1}X?B<SB5083tyCAPuNu2A1Zg
z7-ANtKo_8?GdDGwoGY%HZed}9A!lX^j94`FrdZUOm|I||GqS+6%h1eX@?LS35JN+A
z3{MyunPM1XYG7f2Zm_Ab0fs|OO-;=wn@VV?17(0AuOFOQm8xK92}+Q~C5c5P6-B9O
QTxN!5#$2kZuKsRZ0Ea`mQ~&?~

delta 527
zcmca-++sMvmeFAHM<%_=d`yzeMuujSwV1*uKC+$M!z9dXXlOopA(J+9O2)FuDU8M@
zZO_EG6djuHH25gDPB2-QA<fLpY^-3$p2V%NjpdPxg5RcKgN{&+kB^FYA96imV&J)}
zaDVeXrfrOjhLfkV7_b4&GcYxqe40gJ;!2*)-&r2<$rvjbDC8$)aoN~#>AU6UmG~v*
zrYh(=hx>&&J5GKmA~~5)M3K>GvVlk^qsipIV&Vc$iN&cPg-D7Hvw}<sntYE%a`Pe4
z6h;XX5I2@fAB$Sa$>HLLjHZ)2#jUx3DxC96fkqikzAEm<Xf|0!LOR6M+{{S900b2B
z6u7_)15*nlb96BSGfOiJF;jC33^5aP<H_9;s-k8FrWkTYlQ&8LgW1e%vbdy5h=GMA
zhSdg^=9cK%Oe_ox(Zx&+j4+HhH8QuD+%Ku24pglW#HAmcS(U0_XvSq{$5mXCSX5F`
Tl$yq6YGH29rK;-c@5TiH@$HHq

diff --git a/quad/qtest/test-sections.rkt b/quad/qtest/test-sections.rkt
index a9c39f45..212f46aa 100644
--- a/quad/qtest/test-sections.rkt
+++ b/quad/qtest/test-sections.rkt
@@ -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")
diff --git a/quad/quad/scribblings/quad.scrbl b/quad/quad/scribblings/quad.scrbl
index 4da0bd6c..05f0377e 100644
--- a/quad/quad/scribblings/quad.scrbl
+++ b/quad/quad/scribblings/quad.scrbl
@@ -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?]
diff --git a/quad/quadwriter/attrs.rkt b/quad/quadwriter/attrs.rkt
index c961872f..0329b91e 100644
--- a/quad/quadwriter/attrs.rkt
+++ b/quad/quadwriter/attrs.rkt
@@ -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
diff --git a/quad/quadwriter/param.rkt b/quad/quadwriter/param.rkt
index 24fcb005..c885ba3c 100644
--- a/quad/quadwriter/param.rkt
+++ b/quad/quadwriter/param.rkt
@@ -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))
diff --git a/quad/quadwriter/render.rkt b/quad/quadwriter/render.rkt
index 56c3482e..a4eff9dc 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)
@@ -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))))