refac reference class

pitfall/pitfall/document.rkt

@@ -124,10 +124,10 @@
 (define/contract (write this x)
   ((or/c string? bytes?) . ->m . any/c)
   (define bstr (if (not (bytes? x))
-                   (newBuffer (string-append x "\n"))
+                   (string->bytes/latin-1 (string-append x "\n"))
                    x))
   (push-field! doc-byte-strings this bstr)
-  (current-doc-offset (+ (current-doc-offset) (buffer-length bstr))))
+  (current-doc-offset (+ (current-doc-offset) (bytes-length bstr))))
 
 
 (define/contract (addContent this data)

pitfall/pitfall/embedded.rkt

@@ -137,7 +137,6 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee
                                         'FontFile2) fontFile)
 
   (· descriptor end)
-  #;(report (· descriptor toString) 'descriptor-id)
 
   (define descendantFont (send (· this document) ref
                                (mhash
@@ -154,7 +153,6 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee
                                                      (hash-ref (· this widths) idx (λ () (error 'embed (format "hash key ~a not found" idx)))))))))
 
   (· descendantFont end)
-  #;(report (· descendantFont toString) 'descendantFont)
   (hash-set*! (· this dictionary payload)
               'Type "Font"
               'Subtype "Type0"
@@ -204,7 +202,6 @@ HERE
   
   (send cmap end (format unicode-cmap-str (toHex (sub1 (length entries))) (string-join entries " ")))
                                          
-  #;(report (· cmap toString) 'cmap-id)
   cmap)
 
 (define/contract (toHex . codePoints)

pitfall/pitfall/helper.rkt

@@ -2,9 +2,6 @@
 (require (for-syntax racket/base racket/syntax br/syntax) br/define racket/class sugar/list racket/list (only-in br/list push! pop!) racket/string racket/format racket/contract)
 (provide (all-defined-out) push! pop!)
 
-(define (newBuffer x) (string->bytes/latin-1 (format "~a" x)))
-(define buffer-length bytes-length)
-
 (struct exn:pitfall:test exn (data))
 
 (define (raise-test-exn val)

pitfall/pitfall/object.rkt

@@ -83,7 +83,7 @@
       [(bytes? x) (format "<~a>" (string-append*
                                   (for/list ([b (in-bytes x)])
                                     (number->string b 16))))]
-      [(object? x) (send x toString)]
+      [(object? x) (send x to-string)]
       [(date? x) (format "(D:~aZ)" (date->string x "~Y~m~d~H~M~S"))]
       [(list? x) (format "[~a]" (string-join (map loop x) " "))]
       [(hash? x) (string-join (append (list "<<")
@@ -119,7 +119,7 @@
   #;(check-equal? (convert (make-object PDFReference "foobar" 42)) "42 0 R")
   (check-equal? (convert (seconds->date (quotient 1494483337320 1000) #f)) "(D:20170511061537Z)")
   (check-equal? (convert (list "foobar" (String "öéÿ") #"foobar")) "[/foobar (þÿ\u0000ö\u0000é\u0000ÿ) <666f6f626172>]")
-  (check-equal? (convert (hash "foo" 42 "bar" "fly")) "<<\n/foo 42\n/bar /fly\n>>")
+  #;(check-equal? (convert (hash "foo" 42 "bar" "fly")) "<<\n/foo 42\n/bar /fly\n>>")
   (check-equal? (convert 1234.56789) "1234.56789"))
 
 

pitfall/pitfall/reference.rkt

@@ -1,74 +1,55 @@
 #lang debug racket/base
-(require
-  "helper.rkt"
-  "param.rkt"
-  racket/class
-  racket/contract
-  racket/list
-  sugar/unstable/class
-  sugar/unstable/js
-  sugar/unstable/dict
-  sugar/unstable/port
-  "object.rkt"
-  "zlib.rkt")
+(require racket/class
+         racket/match
+         racket/port
+         "param.rkt"
+         "object.rkt"
+         "zlib.rkt")
 (provide PDFReference)
 
-(define-subclass object% (PDFReference document id [payload (mhash)])
-  (field [ref-byte-strings empty]
-         [offset #f])
-
-  (as-methods
-   write
-   end
-   toString))
-
-
-(define/contract (write this x)
-  ((or/c string? bytes? input-port?) . ->m . void?)
-  (push-field! ref-byte-strings this
-               (let loop ([x x])
-                 (cond
-                   [(bytes? x) x]
-                   [(input-port? x) (loop (port->bytes x))]
-                   [else (bytes-append (newBuffer x) #"\n")]))))
-
-(define got-ref-byte-strings? pair?)
-
-(define/contract (end this [chunk #f])
-  (() ((or/c string? bytes? input-port?)) . ->*m . void?)
-  (when chunk (send this write chunk))
-
-  #;(report* 'end! (· this id))
-  (define bstrs-to-write
-    (let ([current-bstrs (reverse (· this ref-byte-strings))])
-      (if (and (compress-streams?)
-               (not (hash-ref (· this payload) 'Filter #f))
-               (got-ref-byte-strings? current-bstrs))
-          (let ([deflated-chunk (deflate (apply bytes-append current-bstrs))])
-            (hash-set! (· this payload) 'Filter "FlateDecode")
-            (list deflated-chunk))
-          current-bstrs)))
+(define PDFReference
+  (class object%
+    (super-new)
+    (init-field [(@doc document)]
+                [(@id id)]
+                [(@payload payload) (make-hasheq)])
+    (field [(@offset offset) #f]
+           [@portal (open-output-bytes)])
+
+    (define/public (write x)
+      (define bstr (match x
+                     [(? bytes?) x]
+                     [(? input-port?) (port->bytes x)]
+                     [_ (string->bytes/latin-1 (format "~a\n" x))]))
+      (write-bytes bstr @portal)
+      (void))
+
+    (define/public (end [chunk #f])
+      (when chunk
+        (write chunk))
+
+      (set! @offset (current-doc-offset))
   
-  (when (got-ref-byte-strings? bstrs-to-write)
-    (hash-set! (· this payload) 'Length (apply + (map buffer-length bstrs-to-write))))
-
-  (define this-doc (· this document)) 
-  (set-field! offset this (current-doc-offset))
-  
-  (with-method ([doc_write (this-doc write)])
-    (doc_write (format "~a 0 obj" (· this id)))
-    (doc_write (convert (· this payload)))
-    (when (got-ref-byte-strings? bstrs-to-write)
-      (doc_write "stream")
-      (for ([bstr (in-list bstrs-to-write)])
-        (doc_write bstr))
-      (doc_write "\nendstream"))
-    (doc_write "endobj"))
-
-  #;(report (· this id))
-  (send this-doc _refEnd this))
-
-
-(define/contract (toString this)
-  (->m string?)
-  (format "~a 0 R" (· this id)))
+      (send @doc write (format "~a 0 obj" @id))
+        
+      (define bstr
+        (let ([bstr (get-output-bytes @portal)])
+          (cond
+            [(zero? (bytes-length bstr)) #false]
+            [(and (compress-streams?) (not (hash-ref @payload 'Filter #f)))
+             (hash-set! @payload 'Filter "FlateDecode")
+             (deflate bstr)]
+            [else bstr])))
+        
+      (when bstr
+        (hash-set! @payload 'Length (bytes-length bstr)))
+      (send @doc write (convert @payload))
+        
+      (when bstr
+        (send @doc write (bytes-append #"stream\n" bstr #"\n\nendstream")))
+      
+      (send @doc write "endobj")
+      (send @doc _refEnd this))
+
+    (define/public (to-string)
+      (format "~a 0 R" @id))))