From 5d8d5a5fd71461ae3cb0dccaf28b83fcafddf71a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 21 Dec 2018 17:32:39 -0800 Subject: [PATCH] portier --- pitfall/pitfall/core.rkt | 13 +++++- pitfall/pitfall/document.rkt | 68 +++++++++++++------------------- pitfall/pitfall/jpeg-structy.rkt | 2 +- pitfall/pitfall/reference.rkt | 22 +++++------ 4 files changed, 48 insertions(+), 57 deletions(-) diff --git a/pitfall/pitfall/core.rkt b/pitfall/pitfall/core.rkt index 47e0a9e9..2c891d87 100644 --- a/pitfall/pitfall/core.rkt +++ b/pitfall/pitfall/core.rkt @@ -1,4 +1,5 @@ #lang racket/base +(require racket/match racket/port) (provide (all-defined-out)) ;; structs @@ -15,7 +16,6 @@ (define current-pdf-version (make-parameter 1.3)) (define current-auto-first-page (make-parameter #t)) -(define current-doc-offset (make-parameter 'doc-offset-not-initialized)) ;; helpers @@ -25,4 +25,13 @@ (let ([x (if round? (/ (round (* x 1e6)) 1e6) x)]) (number->string (if (integer? x) (inexact->exact x) - x)))) \ No newline at end of file + x)))) + +(define (to-bytes x) + (match x + [(? bytes?) x] + [(? input-port?) (port->bytes x)] + [_ (string->bytes/latin-1 (string-append x "\n"))])) + +(define (write-bytes-out x) + (void (write-bytes (to-bytes x)))) \ No newline at end of file diff --git a/pitfall/pitfall/document.rkt b/pitfall/pitfall/document.rkt index 32329f76..f67dcfa5 100644 --- a/pitfall/pitfall/document.rkt +++ b/pitfall/pitfall/document.rkt @@ -28,7 +28,7 @@ (yield refid) (loop (add1 refid))))] [@root (ref (mhasheq 'Type "Catalog" - 'Pages (ref (mhasheq 'Type "Pages"))))] ; top object + 'Pages (ref (mhasheq 'Type "Pages"))))] [(@x x) 0] [(@y y) 0] [@info (mhasheq 'Producer "PITFALL" @@ -37,7 +37,9 @@ 0 (current-seconds)) #f))]) ; Initialize the metadata - ;; Initialize mixins + + + ;; initialize mixins (send this initColor) (send this initVector) (inherit-field _ctm) @@ -49,22 +51,19 @@ ;; initialize params (current-compress-streams? (hash-ref @options 'compress #t)) (current-auto-first-page (hash-ref @options 'autoFirstPage #t)) - (current-doc-offset 0) (when (current-auto-first-page) (add-page)) + ;; copy options + (for ([(key val) (in-hash (hash-ref @options 'info (hasheq)))]) + (hash-set! @info key val)) + (define/public (page) (first @pages)) (define/public (ref [payload (mhasheq)]) - (define refid (@ref-gen)) - (define new-ref (make-object PDFReference this refid payload)) + (define new-ref (make-object PDFReference this (@ref-gen) payload)) (set! @refs (cons new-ref @refs)) new-ref) - (define/public (write x) - (define bstr (if (bytes? x) x (string->bytes/latin-1 (string-append x "\n")))) - (write-bytes bstr) - (current-doc-offset (file-position (current-output-port)))) - (define/public (add-page [options-arg @options]) ;; create a page object (define page-parent (send @root get-key 'Pages)) @@ -84,10 +83,11 @@ this) (define/public (end) - (write (format "%PDF-~a\n%ÿÿÿÿ" (current-pdf-version))) + (write-bytes-out (format "%PDF-~a" (current-pdf-version))) + (write-bytes-out "%ÿÿÿÿ") - (for ([p (in-list @pages)]) - (send p end)) + (for ([page (in-list @pages)]) + (send page end)) (define doc-info (ref)) (for ([(key val) (in-hash @info)]) @@ -104,34 +104,20 @@ (send @root end) - (define xref-offset (current-doc-offset)) - (match-define (list this-idxs this-offsets) - (match (reverse @refs) - [(list refs ...) (list (map (λ (ref) (get-field id ref)) refs) - (map (λ (ref) (get-field offset ref)) refs))])) - (write "xref") - (write (format "0 ~a" (add1 (length this-offsets)))) - (write "0000000000 65535 f ") - (let ([missing-offsets (for/list ([offset (in-list this-offsets)] - [idx (in-list this-idxs)] - #:unless (number? offset)) - idx)]) - (unless (empty? missing-offsets) - (raise-argument-error 'document:end "numerical offsets" missing-offsets))) - (for ([offset (in-list this-offsets)] - [idx (in-list this-idxs)]) - (write (string-append (~r offset #:min-width 10 #:pad-string "0") " 00000 n "))) - - (write "trailer") - (write (convert (mhasheq 'Size (add1 (length this-offsets)) - 'Root @root - 'Info doc-info))) - (write "startxref") - (write (numberizer xref-offset)) - (write "%%EOF")) - - (for ([(key val) (in-hash (hash-ref @options 'info (hasheq)))]) - (hash-set! @info key val)))) + (define xref-offset (file-position (current-output-port))) + (write-bytes-out "xref") + (write-bytes-out (format "0 ~a" (add1 (length @refs)))) + (write-bytes-out "0000000000 65535 f ") + (for ([ref (in-list (reverse @refs))]) + (write-bytes-out + (string-append (~r (get-field offset ref) #:min-width 10 #:pad-string "0") " 00000 n "))) + (write-bytes-out "trailer") + (write-bytes-out (convert (mhasheq 'Size (add1 (length @refs)) + 'Root @root + 'Info doc-info))) + (write-bytes-out "startxref") + (write-bytes-out (numberizer xref-offset)) + (write-bytes-out "%%EOF")))) (module+ test (define d (new PDFDocument))) \ No newline at end of file diff --git a/pitfall/pitfall/jpeg-structy.rkt b/pitfall/pitfall/jpeg-structy.rkt index 1888c82b..7ff07a69 100644 --- a/pitfall/pitfall/jpeg-structy.rkt +++ b/pitfall/pitfall/jpeg-structy.rkt @@ -61,7 +61,7 @@ ;; min and max values from the default, we invert the colors. See ;; section 4.8.4 of the spec. (when (equal? (· this colorSpace) "DeviceCMYK") - (send obj set-key! 'Decode '(1.0 0.0 1.0 0.0 1.0 0.0 1.0 0.0))) + (send (· this obj) set-key! 'Decode '(1.0 0.0 1.0 0.0 1.0 0.0 1.0 0.0))) (port-position (· this data) 0) (send (· this obj) end (· this data)))) diff --git a/pitfall/pitfall/reference.rkt b/pitfall/pitfall/reference.rkt index b92de898..5ad4a770 100644 --- a/pitfall/pitfall/reference.rkt +++ b/pitfall/pitfall/reference.rkt @@ -14,14 +14,10 @@ [(@id id)] [(@payload payload) (make-hasheq)]) (field [(@offset offset) #f] - [@portal (open-output-bytes)]) + [@port (open-output-bytes)]) - (define/public (write x [op @portal]) - (define bstr (match x - [(? bytes?) x] - [(? input-port?) (port->bytes x)] - [_ (string->bytes/latin-1 (format "~a\n" x))])) - (write-bytes bstr op)) + (define/public (write x) + (write-bytes (to-bytes x) @port)) (define/public (get-key key) (hash-ref @payload key)) @@ -33,12 +29,12 @@ (hash-update! @payload key updater)) (define/public (end) - (set! @offset (current-doc-offset)) + (set! @offset (file-position (current-output-port))) - (send @doc write (format "~a 0 obj" @id)) + (write-bytes-out (format "~a 0 obj" @id)) (define bstr - (let ([bstr (get-output-bytes @portal)]) + (let ([bstr (get-output-bytes @port)]) (cond [(zero? (bytes-length bstr)) #false] [(and (current-compress-streams?) (not (hash-ref @payload 'Filter #f))) @@ -48,12 +44,12 @@ (when bstr (hash-set! @payload 'Length (bytes-length bstr))) - (send @doc write (convert @payload)) + (write-bytes-out (convert @payload)) (when bstr - (send @doc write (bytes-append #"stream\n" bstr #"\nendstream"))) + (write-bytes-out (bytes-append #"stream\n" bstr #"\nendstream"))) - (send @doc write "\nendobj")) + (write-bytes-out "\nendobj")) (define/public (to-string) (format "~a 0 R" @id))))