refac

pitfall/pitfall/document.rkt

@@ -51,11 +51,10 @@
    addContent
    _refEnd
    pipe
-   end
-   _finalize)
+   end)
 
   (for ([(key val) (in-hash (hash-ref options 'info (hash)))]) ; if no 'info key, nothing will be copied from (hash)
-    (hash-set! info key val))
+       (hash-set! info key val))
 
   ;; Write the header
   (_write this (format "%PDF-~a" version)) ;  PDF version
@@ -77,8 +76,8 @@
   (set-field! page this (make-object PDFPage this options-arg))
   (push-end-field! _pageBuffer this (· this page))
   ;; add the page to the object store
-  (define pages (· this _root data Pages data))
-  (hash-update! pages 'Kids (curry cons (· this page dictionary)) null)
+  (define pages (· this _root payload Pages payload))
+  (hash-update! pages 'Kids (curry cons (· this page dictionary)))
   (hash-update! pages 'Count add1)
 
   ;; reset x and y coordinates
@@ -100,22 +99,23 @@
   (define pages (· this _pageBuffer))
   (set-field! _pageBuffer this empty)
   (increment-field! _pageBufferStart this (length pages))
-  (·map end pages))
+  (for/list ([p (in-list pages)])
+            (· p end)))
 
 
 ;; every js function argument is 'undefined' by default
 ;; so even a function defined without default values
 ;; can be called without arguments
-(define/contract (ref this [data (mhash)])
+(define/contract (ref this [payload (mhash)])
   (() (hash?) . ->*m . (is-a?/c PDFReference))
-  (define newref (make-object PDFReference this (add1 (length (· this _offsets))) data))
+  (define newref (make-object PDFReference this (add1 (length (· this _offsets))) payload))
   (push-end-field! _offsets this #f) ; placeholder for this object's offset once it is finalized
   (increment-field! _waiting this)
   newref)
 
 
 (define/contract (push this chunk)
-  (any/c . ->m . void?)
+  (isBuffer? . ->m . void?)
   (push-field! byte-strings this chunk))
 
 
@@ -138,9 +138,9 @@
 (define/contract (_refEnd this ref)
   ((is-a?/c PDFReference) . ->m . void?)
   (set-field! _offsets this (for/list ([(offset idx) (in-indexed (· this _offsets))])
-                              (if (= (· ref id) (add1 idx))
-                                  (· ref offset)
-                                  offset)))
+                                      (if (= (· ref id) (add1 idx))
+                                          (· ref offset)
+                                          offset)))
   (increment-field! _waiting this -1)
   (if (and (zero? (· this _waiting)) (· this _ended))
       (· this _finalize)
@@ -157,52 +157,48 @@
   (flushPages this)
   (set-field! _info this (ref this))
   (for ([(key val) (in-hash (· this info))])
-    ;; upgrade string literal to String struct
-    (hash-set! (· this _info data) key (if (string? val) (String val) val)))
+       ;; upgrade string literal to String struct
+       (hash-set! (· this _info payload) key (if (string? val) (String val) val)))
   (· this _info end)
 
   (for ([font (in-hash-values (· this _fontFamilies))])
-    (· font finalize))
+       (· font finalize))
 
   (· this _root end)
-  (· this _root data Pages end)
-
-  (if (zero? (· this _waiting))
-      (· this _finalize)
-      (set-field! _ended this #t))
-
+  (· this _root payload Pages end)
+
+  (cond
+    [(positive? (· this _waiting)) (set-field! _ended this #t)]
+    [else
+     ;; generate xref
+     (define xref-offset (· this _offset))
+     (with-method ([this-write (this _write)])
+       (define this-offsets (· this _offsets)) 
+       (this-write "xref")
+       (this-write (format "0 ~a" (add1 (length this-offsets))))
+       (this-write "0000000000 65535 f ")
+       (for ([offset (in-list this-offsets)])
+            (this-write @string-append{@(~r offset #:min-width 10 #:pad-string "0") 00000 n }))
+       (this-write "trailer") ;; trailer
+       (this-write (convert
+                    (mhash 'Size (add1 (length this-offsets))
+                           'Root (· this _root)
+                           'Info (· this _info))))
+       (this-write "startxref")
+       (this-write (number xref-offset))
+       (this-write "%%EOF"))
+     
+     ;; end the stream
+     ;; in node you (@push null) which signals to the stream
+     ;; to copy to its output port
+     ;; here we'll do it manually
+     (define this-op (· this op))
+     (copy-port (open-input-bytes
+                 (apply bytes-append (reverse (· this byte-strings)))) this-op)
+     (close-output-port this-op)])
   #t)
 
 
-(define/contract (_finalize this [fn #f])
-  (() ((or/c procedure? #f)) . ->*m . void?)
-  ;; generate xref
-  (define xref-offset (· this _offset))
-  (with-method ([this-write (this _write)])
-    (define this-offsets (· this _offsets)) 
-    (this-write "xref")
-    (this-write (format "0 ~a" (add1 (length this-offsets))))
-    (this-write "0000000000 65535 f ")
-    (for ([offset (in-list this-offsets)])
-      (this-write (string-append
-                   (~r offset #:min-width 10 #:pad-string "0")
-                   " 00000 n ")))
-    (this-write "trailer") ;; trailer
-    (this-write (convert
-                 (mhash 'Size (add1 (length this-offsets))
-                        'Root (· this _root)
-                        'Info (· this _info))))
-    (this-write "startxref")
-    (this-write (number xref-offset))
-    (this-write "%%EOF"))
-
-  ;; end the stream
-  ;; in node you (@push null) which signals to the stream
-  ;; to copy to its output port
-  ;; here we'll do it manually
-  (define this-op (· this op))
-  (copy-port (open-input-bytes (apply bytes-append (reverse (· this byte-strings)))) this-op)
-  (close-output-port this-op))
 
 
 (module+ test

pitfall/pitfall/font.rkt

@@ -53,7 +53,7 @@
 
 (define/contract (embed this)
   (->m void?)
-  (set-field! data (· this dictionary)
+  (set-field! payload (· this dictionary)
               (mhash 'Type "Font"
                      'BaseFont (· this name)
                      'Subtype "Type1"

pitfall/pitfall/page-test.rkt

@@ -6,10 +6,10 @@
 (check-equal? (· p margins) '#hasheq((right . 72) (bottom . 72) (left . 72) (top . 72)))
 (check-equal? (· p height) 792.0)
 (check-equal? (· p width) 612.0)
-(check-equal? (· p resources data ProcSet) '("PDF" "Text" "ImageB" "ImageC" "ImageI"))
+(check-equal? (· p resources payload ProcSet) '("PDF" "Text" "ImageB" "ImageC" "ImageI"))
 
-(check-equal? (· p dictionary data Type) "Page")
-(check-equal? (· p dictionary data MediaBox)  '(0 0 612.0 792.0))
-(check-true (is-a? (· p dictionary data Contents) PDFReference))
-(check-true (is-a? (· p dictionary data Resources) PDFReference))
-(check-true (is-a? (· p dictionary data Parent) PDFReference))
+(check-equal? (· p dictionary payload Type) "Page")
+(check-equal? (· p dictionary payload MediaBox)  '(0 0 612.0 792.0))
+(check-true (is-a? (· p dictionary payload Contents) PDFReference))
+(check-true (is-a? (· p dictionary payload Resources) PDFReference))
+(check-true (is-a? (· p dictionary payload Parent) PDFReference))

pitfall/pitfall/page.rkt

@@ -29,7 +29,7 @@
            [dictionary
             (send document ref
                   (mhash 'Type "Page"
-                         'Parent (· document _root data Pages)
+                         'Parent (· document _root payload Pages)
                          'MediaBox (list 0 0 width height)
                          'Contents content
                          'Resources resources))])
@@ -47,23 +47,23 @@
 ;; Lazily create these dictionaries
 (define/contract (fonts this)
   (->m hash?)
-  (hash-ref! (· this resources data) 'Font (make-hash)))
+  (hash-ref! (· this resources payload) 'Font (make-hash)))
 
 (define/contract (xobjects this)
   (->m hash?)
-  (hash-ref! (· this resources data) 'XObject (make-hash)))
+  (hash-ref! (· this resources payload) 'XObject (make-hash)))
 
 (define/contract (ext_gstates this)
   (->m hash?)
-  (hash-ref! (· this resources data) 'ExtGState (make-hash)))
+  (hash-ref! (· this resources payload) 'ExtGState (make-hash)))
 
 (define/contract (patterns this)
   (->m hash?)
-  (hash-ref! (· this resources data) 'Pattern (make-hash)))
+  (hash-ref! (· this resources payload) 'Pattern (make-hash)))
 
 (define/contract (annotations this)
   (->m hash?)
-  (hash-ref! (· this resources data) 'Annots null))
+  (hash-ref! (· this resources payload) 'Annots null))
 
 
 (define/contract (maxY this)

pitfall/pitfall/reference.rkt

@@ -2,7 +2,7 @@
 (require "object.rkt" "zlib.rkt")
 (provide PDFReference)
 
-(define-subclass object% (PDFReference document id [data (mhash)])
+(define-subclass object% (PDFReference document id [payload (mhash)])
   (super-new)
   (field [chunks empty]
          [offset #f])
@@ -15,9 +15,9 @@
 
 (define/contract (write this x)
   ((or/c string? isBuffer?) . ->m . void?)
-  (push-end-field! chunks this (if (isBuffer? x)
-                                   x
-                                   (bytes-append (newBuffer x) #"\n"))))
+  (push-field! chunks this (if (isBuffer? x)
+                               x
+                               (bytes-append (newBuffer x) #"\n"))))
 
 (define got-chunks? pair?)
 
@@ -25,24 +25,24 @@
   (->m void?)
 
   (define chunks-to-write
-    (let ([current-chunks (· this chunks)])
+    (let ([current-chunks (reverse (· this chunks))])
       (if (and (compress-streams?)
-               (not (hash-ref (· this data) 'Filter #f))
+               (not (hash-ref (· this payload) 'Filter #f))
                (got-chunks? current-chunks))
           (let ([deflated-chunk (deflate (apply bytes-append current-chunks))])
-            (hash-set! (· this data) 'Filter "FlateDecode")
+            (hash-set! (· this payload) 'Filter "FlateDecode")
             (list deflated-chunk))
           current-chunks)))
   
   (when (got-chunks? chunks-to-write)
-    (hash-set! (· this data) 'Length (apply + (map buffer-length chunks-to-write))))
+    (hash-set! (· this payload) 'Length (apply + (map buffer-length chunks-to-write))))
 
   (define this-doc (· this document)) 
   (set-field! offset this (· this-doc _offset))
   
   (with-method ([doc_write (this-doc _write)])
     (doc_write (format "~a 0 obj" (· this id)))
-    (doc_write (convert (· this data)))
+    (doc_write (convert (· this payload)))
     (when (got-chunks? chunks-to-write)
       (doc_write "stream")
       (for ([chunk (in-list chunks-to-write)])