From f6ba95b6abecc5383e0b2f45361b7b74856c53fb Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 18 May 2017 20:17:59 -0700 Subject: [PATCH] refac --- pitfall/pitfall/document.rkt | 96 +++++++++++++++++------------------ pitfall/pitfall/font.rkt | 2 +- pitfall/pitfall/page-test.rkt | 12 ++--- pitfall/pitfall/page.rkt | 12 ++--- pitfall/pitfall/reference.rkt | 18 +++---- 5 files changed, 68 insertions(+), 72 deletions(-) diff --git a/pitfall/pitfall/document.rkt b/pitfall/pitfall/document.rkt index 92d72f6d..f3315cf8 100644 --- a/pitfall/pitfall/document.rkt +++ b/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 diff --git a/pitfall/pitfall/font.rkt b/pitfall/pitfall/font.rkt index 46426cb0..0770442d 100644 --- a/pitfall/pitfall/font.rkt +++ b/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" diff --git a/pitfall/pitfall/page-test.rkt b/pitfall/pitfall/page-test.rkt index cd03ec4a..2b00a6b2 100644 --- a/pitfall/pitfall/page-test.rkt +++ b/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)) \ No newline at end of file +(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)) \ No newline at end of file diff --git a/pitfall/pitfall/page.rkt b/pitfall/pitfall/page.rkt index 7ba4f98c..163efe56 100644 --- a/pitfall/pitfall/page.rkt +++ b/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) diff --git a/pitfall/pitfall/reference.rkt b/pitfall/pitfall/reference.rkt index 0bbfff7c..3f8ca8cc 100644 --- a/pitfall/pitfall/reference.rkt +++ b/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)])