From 5f977d253d8623f66d37294a05b46afc24753cb7 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Wed, 1 May 2019 13:40:35 -0700
Subject: [PATCH] get page dimensions from attributes

---
 quad/quadwriter/core.rkt | 63 ++++++++++++++++++++++++++++------------
 1 file changed, 44 insertions(+), 19 deletions(-)

diff --git a/quad/quadwriter/core.rkt b/quad/quadwriter/core.rkt
index be3acccc..7d1b3594 100644
--- a/quad/quadwriter/core.rkt
+++ b/quad/quadwriter/core.rkt
@@ -533,28 +533,53 @@
                   (match el
                     [(== qexpr-para-break) pbr]
                     [_ el])) x))
-                 
-(define (render-pdf x pdf-path)
-  (define pdf (make-pdf #:compress #t
-                        #:auto-first-page #f
-                        #:output-path pdf-path
-                        #:width (if zoom-mode? 350 612)
-                        #:height (if zoom-mode? 400 792)))
+
+(require racket/contract sugar/coerce pitfall/page)
+(define default-page-size (case (current-locale)
+                            [(us) "letter"]
+                            [else "a4"]))
+(define default-page-orientation "tall")
+(define/contract (render-pdf qx-arg pdf-path-arg
+                             #:replace [replace? #t])
+  ((qexpr? (or/c path? path-string?)) (#:replace any/c) . ->* . void?)
+  (define pdf-path (path->complete-path (simplify-path (expand-user-path (->path pdf-path-arg)))))
+  (when (and (not replace?) (file-exists? pdf-path))
+    (raise-argument-error 'render-pdf "path that doesn't exist" pdf-path))
+  (define qx (let* ([qx qx-arg]
+                    [qx (replace-para-breaks qx)]
+                    [qx (qexpr->quad  `(q ((font-family ,default-font-family)
+                                           (font-size ,(number->string default-font-size))) ,qx))]
+                    [qx (atomize qx #:attrs-proc handle-cascading-attrs)])
+               qx))
+  ;; page size can be specified by name, or measurements.
+  ;; explicit measurements from page-height and page-width supersede those from page-size.
+  (define pdf
+    (let ()
+      (match-define (list page-width page-height)
+        (for/list ([k '(page-width page-height)])
+          (match (quad-ref (car qx) k)
+            [#false #false]
+            [val (parse-points val 'round)])))
+      ;; `make-pdf` will sort out conflicts among page dimensions
+      (make-pdf #:compress #t
+                #:auto-first-page #f
+                #:output-path pdf-path
+                #:width page-width
+                #:height page-height
+                #:size (quad-ref (car qx) 'page-size default-page-size)
+                #:orientation (quad-ref (car qx) 'page-orientation default-page-orientation))))
+  
   (define line-width (- (pdf-width pdf) (* 2 side-margin)))
   (define vertical-height (- (pdf-height pdf) top-margin bottom-margin))
   (parameterize ([current-pdf pdf]
                  [verbose-quad-printing? #false])
     (setup-font-path-table! pdf-path)
-    (let* ([x (replace-para-breaks x)]
-           [x (qexpr->quad  `(q ((font-family ,default-font-family)
-                                 (font-size ,(number->string default-font-size))) ,x))]
-           [x (atomize x #:attrs-proc handle-cascading-attrs)]
-           [x (time-name hyphenate (handle-hyphenate x))]
-           [x (map ->string-quad x)]
-           [x (insert-first-line-indents x)]  
-           [x (time-name line-wrap (line-wrap x line-width))]
-           [x (apply-keeps x)]
-           [x (time-name page-wrap (page-wrap x vertical-height pdf-path))]
-           [x (time-name position (position (struct-copy quad q:doc [elems x])))])
-      (time-name draw (draw x pdf))
+    (let* ([qx (time-name hyphenate (handle-hyphenate qx))]
+           [qx (map ->string-quad qx)]
+           [qx (insert-first-line-indents qx)]  
+           [qx (time-name line-wrap (line-wrap qx line-width))]
+           [qx (apply-keeps qx)]
+           [qx (time-name page-wrap (page-wrap qx vertical-height pdf-path))]
+           [qx (time-name position (position (struct-copy quad q:doc [elems qx])))])
+      (time-name draw (draw qx pdf))
       (displayln (format "wrote PDF to ~a" pdf-path)))))