From a8a0e3b6d3f3f0f3e089b0dd76cfd0d39aa54cb6 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 20 Dec 2018 17:47:29 -0800 Subject: [PATCH] refac reference class --- pitfall/pitfall/document.rkt | 4 +- pitfall/pitfall/embedded.rkt | 3 - pitfall/pitfall/helper.rkt | 3 - pitfall/pitfall/object.rkt | 4 +- pitfall/pitfall/reference.rkt | 121 ++++++++++++++-------------------- 5 files changed, 55 insertions(+), 80 deletions(-) diff --git a/pitfall/pitfall/document.rkt b/pitfall/pitfall/document.rkt index c7e9db64..b86bf448 100644 --- a/pitfall/pitfall/document.rkt +++ b/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) diff --git a/pitfall/pitfall/embedded.rkt b/pitfall/pitfall/embedded.rkt index 92893c4c..84ad281a 100644 --- a/pitfall/pitfall/embedded.rkt +++ b/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) diff --git a/pitfall/pitfall/helper.rkt b/pitfall/pitfall/helper.rkt index 257708b7..14064c40 100644 --- a/pitfall/pitfall/helper.rkt +++ b/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) diff --git a/pitfall/pitfall/object.rkt b/pitfall/pitfall/object.rkt index 34634776..d9dfdfbb 100644 --- a/pitfall/pitfall/object.rkt +++ b/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")) diff --git a/pitfall/pitfall/reference.rkt b/pitfall/pitfall/reference.rkt index 4b1e70b9..ad3802dc 100644 --- a/pitfall/pitfall/reference.rkt +++ b/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))))