diff --git a/pitfall/pitfall/reference.rkt b/pitfall/pitfall/reference.rkt index 552b54b3..394f6c45 100644 --- a/pitfall/pitfall/reference.rkt +++ b/pitfall/pitfall/reference.rkt @@ -2,17 +2,6 @@ (require "object.rkt" "zlib.rkt") (provide PDFReference) -(define-subclass object% (Chunks) - (super-new) - (define chunks null) - (define/public (append-chunk chunk) - (set! chunks (append chunks (list chunk)))) - ) - -(define-subclass Chunks (CompressedChunks) - (super-new)) - - (define-subclass object% (PDFReference document id [data (mhash)]) (super-new) (field [gen 0] @@ -37,40 +26,38 @@ (define chunk (if (isBuffer? chunk-in) chunk-in (newBuffer (string-append chunk-in "\n")))) - (hash-ref! (· this data) 'Length 0) (push-end-field! chunks this chunk) - (hash-update! (· this data) 'Length (curry + (buffer-length chunk))) + (hash-update! (· this data) 'Length (curry + (buffer-length chunk)) 0) (callback)) -(define/contract (end this [chunk #f]) - (() ((or/c any/c #f)) . ->*m . void?) +(define/contract (end this) + (->m void?) - (when (and (· this compress) (positive? (length (· this chunks)))) - (define deflated-chunk (deflate (apply bytes-append (· this chunks)))) - (set-field! chunks this (list deflated-chunk)) - (hash-set*! (· this data) - 'Filter "FlateDecode" - 'Length (buffer-length deflated-chunk))) - - (define this-doc (· this document)) + (define chunks-to-write + (let ([current-chunks (· this chunks)]) + (if (and (· this compress) (pair? current-chunks)) + (let ([deflated-chunk (deflate (apply bytes-append current-chunks))]) + (hash-set*! (· this data) + 'Filter "FlateDecode" + 'Length (buffer-length deflated-chunk)) + (list deflated-chunk)) + current-chunks))) + (define this-doc (· this document)) (set-field! offset this (· this-doc _offset)) - - (send* this-doc - [_write (format "~a ~a obj" (· this id) (· this gen))] - [_write (convert (· this data))]) - - (let ([this-chunks (· this chunks)]) - (when (positive? (length this-chunks)) - (send this-doc _write "stream") - (for ([chunk (in-list this-chunks)]) - (send this-doc _write chunk)) - (send this-doc _write "\nendstream"))) - - (send* this-doc - [_write "endobj"] - [_refEnd this])) + + (with-method ([doc_write (this-doc _write)]) + (doc_write (format "~a ~a obj" (· this id) (· this gen))) + (doc_write (convert (· this data))) + (when (pair? chunks-to-write) + (doc_write "stream") + (for ([chunk (in-list chunks-to-write)]) + (doc_write chunk)) + (doc_write "\nendstream")) + (doc_write "endobj")) + + (send this-doc _refEnd this)) (define/contract (toString this)