structify page

pitfall/pitfall/annotations.rkt

@@ -2,6 +2,7 @@
 (require
   "core.rkt"
   "reference.rkt"
+  "page.rkt"
   racket/class
   racket/match
   sugar/unstable/dict)
@@ -12,6 +13,7 @@
   (class %
     (super-new)
     (inherit-field @ctm)
+    (inherit page)
 
     (define/public (annotate x y w h options)
       (hash-set*! options
@@ -28,7 +30,7 @@
         (hash-set! options (string->symbol (string-titlecase (symbol->string k))) v))
 
       (define annots-ref (make-ref options))
-      (send (send this page) annotations annots-ref)
+      (page-annotations (page) annots-ref)
       (ref-end annots-ref)
       this)
 

pitfall/pitfall/color.rkt

@@ -2,6 +2,7 @@
 (require
   "core.rkt"
   "reference.rkt"
+  "page.rkt"
   racket/class
   racket/match
   racket/string)
@@ -109,7 +110,7 @@
                        (ref-end ref-dict)
                        (set! @opacity-count (add1 @opacity-count))
                        (list ref-dict (string->symbol (format "Gs~a" @opacity-count))))))
-        (hash-set! (send (send this page) ext_gstates) name dictionary)        
+        (hash-set! (page-ext_gstates (send this page)) name dictionary)        
         (send this add-content (format "/~a gs" name))))))
 
 (define named-colors

pitfall/pitfall/document.rkt

@@ -28,7 +28,7 @@
                              (field [@pages null])
                              (define/public (page) (first @pages))                  
                              (define/public (add-content data)
-                               (send (first @pages) write data)
+                               (page-write (first @pages) data)
                                this))))))))
     (set-current-ref-id! 1)
     (register-ref-listener (λ (ref) (send this store-ref ref)))
@@ -66,15 +66,15 @@
     (define/public (add-page [options-arg @options])
       ;; create a page object
       (define page-parent (dict-ref @root 'Pages))
-      (set! @pages (cons (make-object PDFPage page-parent options-arg) @pages))
+      (set! @pages (cons (make-page page-parent options-arg) @pages))
       
       ;; reset x and y coordinates
-      (set! @x (margin-left (get-field margins (page))))
-      (set! @y (margin-right (get-field margins (page))))
+      (set! @x (margin-left ($page-margins (page))))
+      (set! @y (margin-right ($page-margins (page))))
       ;; flip PDF coordinate system so that the origin is in
       ;; the top left rather than the bottom left
       (set! @ctm default-ctm-value)
-      (transform 1 0 0 -1 0 (get-field height (page)))
+      (transform 1 0 0 -1 0 ($page-height (page)))
       this)
 
     (define/public (start-doc)
@@ -82,8 +82,7 @@
       (write-bytes-out "%ÿÿÿÿ"))
 
     (define/public (end-doc)
-      (for ([page (in-list @pages)])
-        (send page end))
+      (for-each page-end @pages)
 
       (define doc-info (make-ref))
       (for ([(key val) (in-hash @info)])
@@ -95,7 +94,7 @@
 
       (define pages-ref (dict-ref @root 'Pages))
       (dict-set! pages-ref 'Count (length @pages))
-      (dict-set! pages-ref 'Kids (map (λ (page) (get-field dictionary page)) (reverse @pages)))
+      (dict-set! pages-ref 'Kids (map $page-dictionary (reverse @pages)))
       (ref-end pages-ref)
       
       (ref-end @root)

pitfall/pitfall/images.rkt

@@ -3,7 +3,8 @@
   racket/class
   racket/match
   sugar/unstable/dict
-  "image.rkt")
+  "image.rkt"
+  "page.rkt")
 (provide image-mixin)
 
 (define (image-mixin [% object%])
@@ -12,6 +13,7 @@
     (field [@image-registry (mhash)]
            [@image-count 0])
     (inherit-field [@x x] [@y y])
+    (inherit page)
 
     (define/public (image src [x-in #f] [y-in #f] [options (mhasheq)])
       (define x (or x-in (hash-ref options 'x #f) @x))
@@ -23,7 +25,7 @@
                       [else (send this open-image src)]))
       (unless (get-field obj image) (send image embed))
   
-      (hash-ref! (send (send this page) xobjects) (get-field label image) (get-field obj image))
+      (hash-ref! (page-xobjects (page)) (get-field label image) (get-field obj image))
 
       (define image-width (get-field width image))
       (define image-height (get-field height image))

pitfall/pitfall/page-test.rkt

@@ -1,20 +1,21 @@
 #lang racket/base
 (require racket/class
          rackunit
+         racket/dict
          "document.rkt"
          "page.rkt"
          "reference.rkt"
          "core.rkt"
          sugar/unstable/js)
-(define p (make-object PDFPage))
-(check-equal? (· p size) "letter")
-(check-equal? (· p layout) "portrait")
-(check-equal? (· p margins) (margin 72 72 72 72))
-(check-equal? (· p height) 792.0)
-(check-equal? (· p width) 612.0)
-(check-equal? (· p resources ProcSet) '(PDF Text ImageB ImageC ImageI))
+(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))
 
-(check-equal? (· p dictionary Type) 'Page)
-(check-equal? (· p dictionary MediaBox)  '(0 0 612.0 792.0))
-(check-true ($ref? (· p dictionary Contents)))
-(check-true ($ref? (· p dictionary Resources)))
+(check-equal? (dict-ref ($page-dictionary p) 'Type) 'Page)
+(check-equal? (dict-ref ($page-dictionary p) 'MediaBox)  '(0 0 612.0 792.0))
+(check-true ($ref? (dict-ref ($page-dictionary p) 'Contents)))
+(check-true ($ref? (dict-ref ($page-dictionary p) 'Resources)))

pitfall/pitfall/page.rkt

@@ -1,68 +1,67 @@
 #lang debug racket/base
 (require
-  racket/class
   racket/dict
   "reference.rkt"
   sugar/unstable/dict
   "core.rkt")
 
-(provide PDFPage)
+(provide (all-defined-out))
 
-(define PDFPage
-  (class object%
-    (super-new)
-    (init-field [@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 (make-ref)]
-           [(@resources resources) (make-ref (mhash 'ProcSet '(PDF Text ImageB ImageC ImageI)))]
-           [(@margins margins)
-            (let ([margin-value (hash-ref @options 'margin #f)])
+(struct $page (page-parent options size layout dimensions width height content resources margins dictionary)
+  #:transparent #:mutable)
+
+(define (make-page [page-parent #false] [options (mhash)])
+  [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)))]
+           [define width (list-ref dimensions (if (equal? layout "portrait") 0 1))]
+           [define height (list-ref dimensions (if (equal? layout "portrait") 1 0))]
+           [define content (make-ref)]
+           [define resources (make-ref (mhash 'ProcSet '(PDF Text ImageB ImageC ImageI)))]
+           [define margins
+            (let ([margin-value (hash-ref options 'margin #f)])
               (if (number? margin-value)
                   (margin margin-value margin-value margin-value margin-value)
-                  (hash-ref @options 'margins (current-default-margins))))]
+                  (hash-ref options 'margins (current-default-margins))))]
            ;; The page dictionary
-           [(@dictionary dictionary)
+           [define dictionary
             (make-ref
                   (mhash 'Type 'Page
-                         'Parent @page-parent
-                         'MediaBox (list 0 0 @width @height)
-                         'Contents @content
-                         'Resources @resources))])
+                         '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 dictionary))
 
-    ;; Lazily create these dictionaries
-    (define/public (fonts)
-      (dict-ref! @resources 'Font (make-hasheq)))
+    (define (page-fonts p)
+      (dict-ref! ($page-resources p) 'Font (make-hasheq)))
 
-    (define/public (xobjects)
-      (dict-ref! @resources 'XObject (make-hasheq)))
+    (define (page-xobjects p)
+      (dict-ref! ($page-resources p) 'XObject (make-hasheq)))
 
-    (define/public (ext_gstates)
-      (dict-ref! @resources 'ExtGState (make-hasheq)))
+    (define (page-ext_gstates p)
+      (dict-ref! ($page-resources p) 'ExtGState (make-hasheq)))
 
-    (define/public (patterns)
-      (dict-ref! @resources 'Pattern (make-hasheq)))
+    (define (page-patterns p)
+      (dict-ref! ($page-resources p) 'Pattern (make-hasheq)))
 
-    (define/public (annotations [annot #f])
+    (define (page-annotations p [annot #f])
       (if annot
-          (dict-update! @dictionary 'Annots (λ (val) (cons annot val)) null)
-          (dict-ref! @dictionary 'Annots null)))
+          (dict-update! ($page-dictionary p) 'Annots (λ (val) (cons annot val)) null)
+          (dict-ref! ($page-dictionary p) 'Annots null)))
 
-    (define/public (maxY)
-      (- @height (margin-bottom @margins)))
+    (define (page-maxY p)
+      (- ($page-height p) (margin-bottom ($page-margins p))))
 
-    (define/public (write chunk)
-      (ref-write @content chunk)) 
+    (define (page-write p chunk)
+      (ref-write ($page-content p) chunk)) 
 
-    (define/public (end)
-      (ref-end @dictionary)
-      (ref-end @resources)
-      (ref-end @content))))
+    (define (page-end p)
+      (ref-end ($page-dictionary p))
+      (ref-end ($page-resources p))
+      (ref-end ($page-content p)))
 
 
 (define page-sizes

pitfall/pitfall/text.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 (require
   "core.rkt"
+  "page.rkt"
   racket/class
   racket/match
   racket/string
@@ -91,7 +92,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
 
       ;; flip coordinate system
       (save)
-      (define page-height (get-field height (first @pages)))
+      (define page-height ($page-height (first @pages)))
       (transform 1 0 0 -1 0 page-height)
       (define y (- page-height
                    y-in
@@ -100,7 +101,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
 
       ;; add current font to page if necessary
       (define current-font-id (get-field id @current-font))
-      (hash-ref! (send (first @pages) fonts) current-font-id  (λ () (send @current-font make-font-ref)))
+      (hash-ref! (page-fonts (first @pages)) current-font-id  (λ () (send @current-font make-font-ref)))
   
       (add-content "BT") ; begin the text object
       (add-content (format "1 0 0 1 ~a ~a Tm" (numberizer x) (numberizer y))) ; text position