refac

pitfall/pitfall/page.rkt

@@ -8,90 +8,66 @@
 
 (provide PDFPage)
 
+(struct margin (top left bottom right) #:transparent #:mutable)
+
 (define PDFPage
   (class object%
     (super-new)
-    (init-field document [page-parent #false] [options (mhash)])
-    (field [size (hash-ref options 'size "letter")]
-           [layout (hash-ref options 'layout "portrait")]
-           ;; calculate page dimensions
-           [dimensions (if (list? size)
-                           size
-                           (hash-ref page-sizes (string-upcase size)))]
-           [width (list-ref dimensions (if (equal? layout "portrait") 0 1))]
-           [height (list-ref dimensions (if (equal? layout "portrait") 1 0))]
-           [content (send document ref)]
-           ;; Initialize the Font, XObject, and ExtGState dictionaries
-           [resources (send document ref (mhash 'ProcSet '("PDF" "Text" "ImageB" "ImageC" "ImageI")))]
-           [margins
-            (let ([margin-value (hash-ref options 'margin #f)])
+    (init-field @doc [@page-parent #false] [@options (mhash)])
+    (field [(@size size) (hash-ref @options 'size "letter")]
+           [(@layout layout) (hash-ref @options 'layout "portrait")]
+           [@dimensions (if (list? @size)
+                           @size
+                           (hash-ref page-sizes (string-upcase @size)))]
+           [(@width width) (list-ref @dimensions (if (equal? @layout "portrait") 0 1))]
+           [(@height height) (list-ref @dimensions (if (equal? @layout "portrait") 1 0))]
+           [@content (send @doc ref)]
+           [(@resources resources) (send @doc ref (mhash 'ProcSet '("PDF" "Text" "ImageB" "ImageC" "ImageI")))]
+           [(@margins margins)
+            (let ([margin-value (hash-ref @options 'margin #f)])
               (if (number? margin-value)
-                  (mhasheq 'top margin-value
-                           'left margin-value
-                           'bottom margin-value
-                           'right margin-value)
+                  (margin margin-value margin-value margin-value margin-value)
                   ;; default to 1 inch margins
-                  (hash-ref options 'margins default-margins)))]
+                  (hash-ref @options 'margins default-margins)))]
            ;; The page dictionary
-           [dictionary
-            (send document ref
+           [(@dictionary dictionary)
+            (send @doc ref
                   (mhash 'Type "Page"
-                         'Parent page-parent
-                         'MediaBox (list 0 0 width height)
-                         'Contents content
-                         'Resources resources))])
-
-    (as-methods
-     fonts
-     xobjects
-     ext_gstates
-     patterns
-     annotations
-     maxY
-     write
-     end)))
-
-;; Lazily create these dictionaries
-(define/contract (fonts this)
-  (->m hash?)
-  (hash-ref! (· this resources payload) 'Font (make-hash)))
+                         'Parent @page-parent
+                         'MediaBox (list 0 0 @width @height)
+                         'Contents @content
+                         'Resources @resources))])
 
-(define/contract (xobjects this)
-  (->m hash?)
-  (hash-ref! (· this resources payload) 'XObject (make-hash)))
+    ;; Lazily create these dictionaries
+    (define/public (fonts)
+      (send @resources get-key! 'Font (make-hasheq)))
 
-(define/contract (ext_gstates this)
-  (->m hash?)
-  (hash-ref! (· this resources payload) 'ExtGState (make-hash)))
+    (define/public (xobjects)
+      (send @resources get-key! 'XObject (make-hasheq)))
 
-(define/contract (patterns this)
-  (->m hash?)
-  (hash-ref! (· this resources payload) 'Pattern (make-hash)))
+    (define/public (ext_gstates)
+      (send @resources get-key! 'ExtGState (make-hasheq)))
 
-(define/contract (annotations this [annot #f])
-  (() (any/c) . ->*m . void?)
-  (if (not annot)
-      (hash-ref! (· this dictionary payload) 'Annots null)
-      (hash-update! (· this dictionary payload) 'Annots (λ (val) (cons annot val)) null)))
+    (define/public (patterns)
+      (send @resources get-key! 'Pattern (make-hasheq)))
 
+    (define/public (annotations [annot #f])
+      (if annot
+          (send @dictionary update-key! 'Annots (λ (val) (cons annot val)) null)
+          (send @dictionary get-key! 'Annots null)))
 
-(define/contract (maxY this)
-  (->m number?)
-  (- (· this height) (· this margins bottom)))
+    (define/public (maxY)
+      (- @height (margin-bottom @margins)))
 
-(define (write this chunk)
-  (send (· this content) write chunk)) ; resume here
+    (define/public (write chunk)
+      (send @content write chunk)) 
 
-(define/contract (end this)
-  (->m void?)
-  (send (· this dictionary) end)
-  (send (· this resources) end)
-  (send (· this content) end))
+    (define/public (end)
+      (send @dictionary end)
+      (send @resources end)
+      (send @content end))))
 
-(define default-margins (hasheq 'top 72
-                                'left 72
-                                'bottom 72
-                                'right 72))
+(define default-margins (margin 72 72 72 72))
 
 (define page-sizes
   (hash "4A0" '(4767.87 6740.79)

pitfall/pitfall/reference.rkt

@@ -22,11 +22,14 @@
     (define/public (get-key key)
       (hash-ref @payload key))
 
+    (define/public (get-key! key val)
+      (hash-ref! @payload key val))
+
     (define/public (set-key! key val)
       (hash-set! @payload key val))
 
-    (define/public (update-key! key updater)
-      (hash-update! @payload key updater))
+    (define/public (update-key! key updater [failure-result (λ () (error 'update-no-key))])
+      (hash-update! @payload key updater failure-result))
 
     (define/public (end)
       (set! @offset (file-position (current-output-port)))