per-page sizing

quad/quadwriter/layout.rkt

@@ -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
+              (wrap qs
-                            (λ (q idx) (* (- wrap-size
+                    (λ (q idx) (* (- wrap-size
-                                             (quad-ref (car qs) :inset-left 0)
+                                     (quad-ref (car qs) :inset-left 0)
-                                             (quad-ref (car qs) :inset-right 0))
+                                     (quad-ref (car qs) :inset-right 0))
-                                          permitted-justify-overfill))
+                                  permitted-justify-overfill))
-                            #:nicely (match (or (current-line-wrap) (quad-ref (car qs) :line-wrap))
+                    #:nicely (match (or (current-line-wrap) (quad-ref (car qs) :line-wrap))
-                                       [(or "best" "kp") #true]
+                               [(or "best" "kp") #true]
-                                       [_ #false])
+                               [_ #false])
-                            #:hard-break line-break-quad?
+                    #:hard-break line-break-quad?
-                            #:soft-break soft-break-for-line?
+                    #:soft-break soft-break-for-line?
-                            #:finish-wrap (finish-line-wrap line-q))))]))
+                    #: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! this-ln)
-            (make-nobreak! prev-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-width (pt-x (size line)))
-            (define line-elem-width (for/sum ([q (in-list (quad-elems line))])
+         (define line-elem-width (for/sum ([q (in-list (quad-elems line))])
-                                             (pt-x (size q))))
+                                   (pt-x (size q))))
-            (when (< line-width line-elem-width)
+         (when (< line-width line-elem-width)
-              (define error-str (apply string-append (for/list ([q (in-list (quad-elems line))])
+           (define error-str (apply string-append (for/list ([q (in-list (quad-elems line))])
-                                                               (match (quad-elems q)
+                                                    (match (quad-elems q)
-                                                                 [(list (? string? str)) str]
+                                                      [(list (? string? str)) str]
-                                                                 [_ ""]))))
+                                                      [_ ""]))))
-              (log-quadwriter-warning (format "clipping overfull line: ~v" error-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)
+             (if (quad-ref (car line-group) :display)
-                         (list (lines->block line-group))
+                 (list (lines->block line-group))
-                         line-group))))
+                 line-group))))
 
 (define-quad first-line-indent-quad quad ())
 

quad/quadwriter/render.rkt

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