From 673fb8997dde66201728e132bdaaf01814d31e64 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 19 May 2017 08:49:53 -0700 Subject: [PATCH] refac --- pitfall/pitfall/document.rkt | 112 ++++++++++++++++------------------ pitfall/pitfall/reference.rkt | 32 +++++----- 2 files changed, 67 insertions(+), 77 deletions(-) diff --git a/pitfall/pitfall/document.rkt b/pitfall/pitfall/document.rkt index a59f543a..9af13d4c 100644 --- a/pitfall/pitfall/document.rkt +++ b/pitfall/pitfall/document.rkt @@ -9,12 +9,12 @@ (super-new) (compress-streams? (hash-ref options 'compress #t)) - (field [byte-strings empty] ; list of byte chunks to push onto; simulates interface of stream.readable - [version 1.3] ; PDF version + + (field [byte-strings empty] + [pdf-version 1.3] [_pageBuffer null] [_pageBufferStart 0] [_offsets (mhash)] ; The PDF object store - [_ended #f] [_offset 0] [_root (ref this (mhash 'Type "Catalog" @@ -31,8 +31,8 @@ 'CreationDate (seconds->date (if (test-mode) 0 (current-seconds)) #f))] ; Initialize the metadata - [op #f] ; for `pipe` - [_info #f]) ; for `end` + [output-port #f]) ; for `pipe` + ;; Initialize mixins (· this initColor) @@ -45,7 +45,7 @@ addPage flushPages ref - _write + write addContent _refEnd pipe @@ -55,13 +55,11 @@ (hash-set! info key val)) ;; Write the header - (_write this (format "%PDF-~a" version)) ; PDF version - (let ([c (integer->char #xFF)]) - (_write this (string-append "%" (string c c c c)))) ; 4 binary chars, as recommended by the spec + (write this (format "%PDF-~a" pdf-version)) ; PDF version + (write this (string-append "%" (list->string (map integer->char (make-list 4 #xFF))))) ; 4 binary chars, as recommended by the spec ;; Add the first page - (unless (not (hash-ref options 'autoFirstPage #t)) - (addPage this))) + (when (hash-ref options 'autoFirstPage #t) (addPage this))) (define/contract (addPage this [options-arg (· this options)]) @@ -91,14 +89,13 @@ (define/contract (flushPages this) - (->m list?) + (->m void?) ;; this local variable exists so we're future-proof against ;; reentrant calls to flushPages. - (define buffered-pages (· this _pageBuffer)) - (set-field! _pageBuffer this empty) - (increment-field! _pageBufferStart this (length buffered-pages)) - (for/list ([p (in-list buffered-pages)]) - (· p end))) + (define pb (· this _pageBuffer)) + (for-each (λ (p) (· p end)) pb) + (increment-field! _pageBufferStart this (length pb)) + (set-field! _pageBuffer this empty)) ;; every js function argument is 'undefined' by default @@ -111,14 +108,13 @@ (make-object PDFReference this next-refid payload)) -(define/contract (_write this data) - ((or/c string? isBuffer?) . ->m . void?) - (define bstr (if (not (isBuffer? data)) - (newBuffer (string-append data "\n")) - data)) +(define/contract (write this x) + ((or/c string? isBuffer?) . ->m . any/c) + (define bstr (if (not (isBuffer? x)) + (newBuffer (string-append x "\n")) + x)) (push-field! byte-strings this bstr) - (increment-field! _offset this (buffer-length bstr)) - (void)) + (increment-field! _offset this (buffer-length bstr))) (define/contract (addContent this data) @@ -135,25 +131,22 @@ (define/contract (_refEnd this ref) ((is-a?/c PDFReference) . ->m . void?) - (hash-set! (· this _offsets) (· ref id) (· ref offset)) - (if (and (not (offsets-missing? this)) (· this _ended)) - (· this _finalize) - (set-field! _ended this #f))) + (hash-set! (· this _offsets) (· ref id) (· ref offset))) (define/contract (pipe this port) (port? . ->m . void?) - (set-field! op this port)) + (set-field! output-port this port)) -(define/contract (end this) +(define/contract (end this) ; called from source file to finish doc (->m boolean?) (flushPages this) - (set-field! _info this (ref this)) + (define _info (ref this)) (for ([(key val) (in-hash (· this info))]) ;; upgrade string literal to String struct - (hash-set! (· this _info payload) key (if (string? val) (String val) val))) - (· this _info end) + (hash-set! (· _info payload) key (if (string? val) (String val) val))) + (· _info end) (for ([font (in-hash-values (· this _fontFamilies))]) (· font finalize)) @@ -161,35 +154,32 @@ (· this _root end) (· this _root payload Pages end) - (cond - [(offsets-missing? this) (set-field! _ended this #t)] - [else - ;; generate xref - (define xref-offset (· this _offset)) - (with-method ([this-write (this _write)]) - (define this-offsets (map cdr (sort (hash->list (· this _offsets)) < #:key car))) ; sort by refid - (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")) + ;; generate xref + (define xref-offset (· this _offset)) + (with-method ([this-write (this write)]) + (define this-offsets (map cdr (sort (hash->list (· this _offsets)) < #:key car))) ; sort by refid + (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 _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)]) + ;; 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-output-port (· this output-port)) + (copy-port (open-input-bytes + (apply bytes-append (reverse (· this byte-strings)))) this-output-port) + (close-output-port this-output-port) #t) diff --git a/pitfall/pitfall/reference.rkt b/pitfall/pitfall/reference.rkt index 3f8ca8cc..4258b77e 100644 --- a/pitfall/pitfall/reference.rkt +++ b/pitfall/pitfall/reference.rkt @@ -4,7 +4,7 @@ (define-subclass object% (PDFReference document id [payload (mhash)]) (super-new) - (field [chunks empty] + (field [byte-strings empty] [offset #f]) (as-methods @@ -15,38 +15,38 @@ (define/contract (write this x) ((or/c string? isBuffer?) . ->m . void?) - (push-field! chunks this (if (isBuffer? x) - x - (bytes-append (newBuffer x) #"\n")))) + (push-field! byte-strings this (if (isBuffer? x) + x + (bytes-append (newBuffer x) #"\n")))) -(define got-chunks? pair?) +(define got-byte-strings? pair?) (define/contract (end this) (->m void?) - (define chunks-to-write - (let ([current-chunks (reverse (· this chunks))]) + (define bstrs-to-write + (let ([current-bstrs (reverse (· this byte-strings))]) (if (and (compress-streams?) (not (hash-ref (· this payload) 'Filter #f)) - (got-chunks? current-chunks)) - (let ([deflated-chunk (deflate (apply bytes-append current-chunks))]) + (got-byte-strings? current-bstrs)) + (let ([deflated-chunk (deflate (apply bytes-append current-bstrs))]) (hash-set! (· this payload) 'Filter "FlateDecode") (list deflated-chunk)) - current-chunks))) + current-bstrs))) - (when (got-chunks? chunks-to-write) - (hash-set! (· this payload) 'Length (apply + (map buffer-length chunks-to-write)))) + (when (got-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 (· this-doc _offset)) - (with-method ([doc_write (this-doc _write)]) + (with-method ([doc_write (this-doc write)]) (doc_write (format "~a 0 obj" (· this id))) (doc_write (convert (· this payload))) - (when (got-chunks? chunks-to-write) + (when (got-byte-strings? bstrs-to-write) (doc_write "stream") - (for ([chunk (in-list chunks-to-write)]) - (doc_write chunk)) + (for ([bstr (in-list bstrs-to-write)]) + (doc_write bstr)) (doc_write "\nendstream")) (doc_write "endobj"))