improve handling of blank pages and continuous page numbering

quad/qtest/all.rkt

@@ -10,8 +10,10 @@
     [(_ PATH . REST)
      (with-syntax ([PDF-NAME (test-pdf-name (syntax-e #'PATH))])
        #'(begin
+           (define-runtime-path rp PATH)
+           (time
             (parameterize ([quadwriter-test-mode #t])
-             (render-pdf (dynamic-require PATH 'doc) PDF-NAME PATH))
+              (render-pdf (dynamic-require PATH 'doc) PDF-NAME rp)))
            (make-test-pdf . REST)))]))
 
 (define-syntax (test-each stx)

quad/quadwriter/layout.rkt

@@ -505,14 +505,14 @@
   (font doc default-font-face)
   (fill-color doc default-font-color)
   (text doc (format "~a · ~a at ~a" (quad-ref q :page-number 0)
-                    (quad-ref q :doc-title "untitled")
-                    (date->string (current-date) #t))
+                    (if (quadwriter-test-mode) "test" (quad-ref q :doc-title "untitled"))
+                    (date->string (if (quadwriter-test-mode) (seconds->date 0) (current-date)) #t))
         x y))
 
 (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 1) (sub1 page-idx))
+     #:attrs (hasheq :page-number (+ (quad-ref col-q :page-number-start (add1 (current-page-count))) (sub1 page-idx))
                      :doc-title (string-titlecase (path->string name)))
      #:from-parent 'sw
      #:to 'nw
@@ -521,8 +521,7 @@
      #:draw-start (λ (q doc)
                     (when draw-debug-line?
                       (draw-debug q doc "goldenrod" "goldenrod"))
-                    (unless (quadwriter-test-mode)
-                      (draw-page-footer q doc)))))
+                    (draw-page-footer q doc))))
 
 (define q:column (q
                   #:id 'col

quad/quadwriter/render.rkt

@@ -199,7 +199,9 @@
                  [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?))])
+      (for/fold ([sections-acc null]
+                 #:result (reverse sections-acc))
+                ([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))
@@ -219,23 +221,44 @@
                                                  [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 section-starting-side (string->symbol (quad-ref (car qs) :page-side-start "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
+               (let ([next-page-side (if (even? (add1 (current-page-count))) '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))))
         
-        (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]))
+        (define section-pages (time-log page-wrap (page-wrap column-qs printable-width page-quad-prototype)))
         
         (begin0
-          (struct-copy quad q:section [elems page-qs])
-          (current-page-count (+ (current-page-count) (length page-qs))))))
+          (cond
+            [insert-blank-page?
+             (match section-starting-side
+               ['left
+                ;; blank page goes at beginning of current section
+                (define page-from-current-section (car section-pages))
+                (define blank-page (struct-copy quad page-from-current-section [elems null]))
+                (define new-section (struct-copy quad q:section [elems (cons blank-page section-pages)]))
+                (cons new-section sections-acc)]
+               [_ ;; must be 'right
+                ;; blank page goes at end of previous section (if it exists)
+                (define new-section (struct-copy quad q:section [elems section-pages]))
+                (match sections-acc
+                  [(cons previous-section other-sections)
+                   (define previous-section-pages (quad-elems previous-section))
+                   (define page-from-previous-section (car previous-section-pages))
+                   (define blank-page (struct-copy quad page-from-previous-section [elems null]))
+                   (define revised-previous-section
+                     (struct-copy quad previous-section
+                                  [elems (append previous-section-pages (list blank-page))]))
+                   (list* new-section revised-previous-section other-sections)]
+                  [_ (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))))))
 
     (define doc (time-log position (position (struct-copy quad q:doc [elems sections]))))
     (time-log draw (draw doc (current-pdf))))