tidy width & height handling

pitfall/pitfall/core.rkt

@@ -4,7 +4,8 @@
 
 ;; structs
 
-(struct pdf (options
+(struct pdf (width
+             height
              pages
              refs
              root
@@ -42,16 +43,13 @@
 ;; for reference
 (struct $ref (id payload offset port) #:transparent #:mutable
   #:methods gen:dict
-  [(define (dict-ref $ key [thunk (λ () (error 'dict-ref-key-not-found))])
-     (hash-ref ($ref-payload $) key))
-   (define (dict-ref! $ key thunk)
-     (hash-ref! ($ref-payload $) key thunk))
-   (define (dict-set! $ key val) (hash-set! ($ref-payload $) key val))
-   (define (dict-update! $ key updater [failure-result (λ () (error 'update-no-key))])
-     (hash-update! ($ref-payload $) key updater failure-result))])
-
-;; for page
-(struct margin (top left bottom right) #:transparent #:mutable)
+  [(define (dict-ref ref key [thunk (λ () (error 'dict-ref-key-not-found))])
+     (hash-ref ($ref-payload ref) key))
+   (define (dict-ref! ref key thunk)
+     (hash-ref! ($ref-payload ref) key thunk))
+   (define (dict-set! ref key val) (hash-set! ($ref-payload ref) key val))
+   (define (dict-update! ref key updater [failure-result (λ () (error 'update-no-key))])
+     (hash-update! ($ref-payload ref) key updater failure-result))])
 
 ;; params
 
@@ -63,8 +61,6 @@
 (define current-auto-first-page (make-parameter #t))
 (define current-auto-helvetica (make-parameter #t))
 
-(define current-default-margins (make-parameter (margin 72 72 72 72)))
-
 (define current-font (make-parameter #f))
 (define current-font-size (make-parameter 12))
 

pitfall/pitfall/page-test.rkt

@@ -8,9 +8,6 @@
          "core.rkt"
          sugar/unstable/js)
 (define p (make-page))
-(check-equal? ($page-size p) "letter")
-(check-equal? ($page-layout p) "portrait")
-(check-equal? ($page-margins p) (margin 72 72 72 72))
 (check-equal? ($page-height p) 792.0)
 (check-equal? ($page-width p) 612.0)
 (check-equal? (dict-ref ($page-resources p) 'ProcSet) '(PDF Text ImageB ImageC ImageI))

pitfall/pitfall/page.rkt

@@ -16,29 +16,21 @@
 (define (add-content doc data)
   (page-write (current-page doc) data))
 
-(struct $page (page-parent options size layout dimensions width height content resources margins ref)
+(struct $page (page-parent width height content resources ref)
   #:transparent #:mutable)
 
-(define (make-page [page-parent #false] [options (mhasheq)])
-  (define size (hash-ref options 'size "letter"))
-  (define layout (hash-ref options 'layout "portrait"))
-  (define dimensions (if (list? size)
-                         size
-                         (hash-ref page-sizes (string-upcase size))))
-  (match-define (list width height) ((if (equal? layout "portrait") values reverse) dimensions))
+(define (make-page #:parent [page-parent #false]
+                   #:width [width 612.0]
+                   #:height [height 792.0])
   (define content (make-ref))
   (define resources (make-ref (mhash 'ProcSet '(PDF Text ImageB ImageC ImageI))))
-  (define margins
-    (match (hash-ref options 'margin #f)
-      [(? number? margin-value) (margin margin-value margin-value margin-value margin-value)]
-      [_ (hash-ref options 'margins (current-default-margins))]))
   (define page-ref
     (make-ref (mhasheq 'Type 'Page
                        'Parent page-parent
                        'MediaBox (list 0 0 width height)
                        'Contents content
                        'Resources resources)))
-  ($page page-parent options size layout dimensions width height content resources margins page-ref))
+  ($page page-parent width height content resources page-ref))
 
 (define (page-fonts p)
   (dict-ref! ($page-resources p) 'Font (make-hasheq)))
@@ -57,9 +49,6 @@
       (dict-update! ($page-ref p) 'Annots (λ (val) (cons annot val)) null)
       (dict-ref! ($page-ref p) 'Annots null)))
 
-(define (page-maxY p)
-  (- ($page-height p) (margin-bottom ($page-margins p))))
-
 (define (page-write p chunk)
   (ref-write ($page-content p) chunk)) 
 

pitfall/pitfall/pdf.rkt

@@ -17,10 +17,22 @@
 (define (store-ref doc ref)
   (set-pdf-refs! doc (cons ref (pdf-refs doc))))
 
-(define (make-pdf [options (make-hasheq)]
-                  #:output-path [output-path #f]
+(define (make-pdf #:output-path [output-path #f]
                   #:compress [compress? (current-compress-streams)]
-                  #:auto-first-page [auto-first-page? (current-auto-first-page)])
+                  #:auto-first-page [auto-first-page? (current-auto-first-page)]
+                  #:size [size "letter"]
+                  #:orientation [orientation "portrait"]
+                  #:width [width-arg 612.0]
+                  #:height [height-arg 792.0])
+  (match-define (list parsed-width parsed-height)
+    (sort
+     (if (list? size)
+         size
+         (hash-ref page-sizes (string-upcase size)))
+     ;; for portrait, shorter edge is width
+     (if (member orientation '("portrait" "tall")) < >)))
+  (define width (or width-arg parsed-width))
+  (define height (or height-arg parsed-height))
 
   ;; initial values
   (define pages null)
@@ -28,8 +40,6 @@
   (define info (mhasheq 'Producer "PITFALL"
                         'Creator "PITFALL"
                         'CreationDate (current-seconds)))
-  (for ([(key val) (in-hash (hash-ref options 'info (hasheq)))]) 
-       (hash-set! info key val))
   (define opacity-registry (make-hash))
   (define current-fill-color '("black" 1))
   (define ctm default-ctm-value)
@@ -43,7 +53,8 @@
   (define x 0)
   (define y 0)
   (define image-registry (make-hash))
-  (define new-doc (pdf options
+  (define new-doc (pdf width
+                       height
                        pages
                        refs
                        'dummy-root-value-that-will-be-replaced-below
@@ -75,14 +86,15 @@
   (when (current-auto-helvetica) (font new-doc "Helvetica"))
   new-doc)
 
-(define (add-page doc [options-arg (pdf-options doc)])
+(define (add-page doc [width (pdf-width doc)] [height (pdf-height doc)])
   ;; create a page object
   (define page-parent (dict-ref (pdf-root doc) 'Pages))
-  (set-pdf-pages! doc (cons (make-page page-parent options-arg) (pdf-pages doc)))
+  (set-pdf-pages! doc (cons (make-page #:parent page-parent #:width width #:height height) (pdf-pages doc)))
       
-  ;; reset x and y coordinates
-  (set-pdf-x! doc (margin-left ($page-margins (current-page doc))))
-  (set-pdf-y! doc (margin-right ($page-margins (current-page doc))))
+  (when (test-mode)
+    ;; default values for tests
+    (set-pdf-x! doc 72)
+    (set-pdf-y! doc 72))
   ;; flip PDF coordinate system so that the origin is in
   ;; the top left rather than the bottom left
   (set-pdf-ctm! doc default-ctm-value)