diff --git a/pitfall/pitfall/kit/document.rkt b/pitfall/pitfall/kit/document.rkt index 691190e9..a5cf424d 100644 --- a/pitfall/pitfall/kit/document.rkt +++ b/pitfall/pitfall/kit/document.rkt @@ -3,74 +3,77 @@ (require sugar/debug) (provide PDFDocument) -(require "reference.rkt" "struct.rkt" "object.rkt" "page.rkt") +(require "reference.rkt" "struct.rkt" "object.rkt" "page.rkt" "helper.rkt") (define PDFDocument (class object% ; actually is an instance of readable.Stream, which is an input port - (init-field [options (hasheq)]) - (let ([output-file (hash-ref options 'out "outrkt.pdf")]) + (init-field [(@options options) (mhasheq)]) + (let ([output-file (hash-ref @options 'out "outrkt.pdf")]) (super-new)) ; list of byte chunks to push onto ; simulates interface of stream.readable - (field [byte-strings empty]) + (field [(@byte-strings byte-strings) empty]) ;; PDF version - (field [version 1.3]) + (field [(@version version) 1.3]) ;; Whether streams should be compressed - (field [compress (hash-ref options 'compress #t)]) + (field [(@compress compress) (hash-ref @options 'compress #t)]) - (field [_pageBuffer null]) - (field [_pageBufferStart 0]) + (field [(@_pageBuffer _pageBuffer) null]) + (field [(@_pageBufferStart _pageBufferStart) 0]) ;; The PDF object store - (field [_offsets null]) - (field [_waiting 0]) - (field [_ended #f]) - (field [_offset 0]) - - (field [_root (ref - (hasheq 'Type "Catalog" - 'Pages (ref - (hasheq 'Type "Pages" - 'Count 0 - 'Kids empty))))]) + (field [(@_offsets _offsets) null]) + (field [(@_waiting _waiting) 0]) + (field [(@_ended _ended) #f]) + (field [(@_offset _offset) 0]) + + (field [(@_root _root) (@ref + (mhasheq 'Type "Catalog" + 'Pages (@ref + (mhasheq 'Type "Pages" + 'Count 0 + 'Kids empty))))]) ;; The current page - (field [page #f]) + (field [(@page page) #f]) + + ;; other fields, hoisted from below (why is this necessary?) + (field [(@x x) 0]) + (field [(@y y) 0]) + (field [(@_ctm _ctm) null]) ;; todo ;; Initialize mixins - #;(initColor) - #;(initVector) - #;(initFonts) - #;(initText) - #;(initImages) + #;(@initColor) + #;(@initVector) + #;(@initFonts) + #;(@initText) + #;(@initImages) ;; Initialize the metadata - (field [info (hasheq - 'Producer "PitfallKit" - 'Creator "PitfallKit" - 'CreationDate (seconds->date (current-seconds)))]) - - (when (hash-ref options 'info #f) - (for ([(key val) (in-hash (hash-ref options 'info))]) - (hash-set! info key val))) + (field [(@info info) (mhasheq + 'Producer "PitfallKit" + 'Creator "PitfallKit" + 'CreationDate (seconds->date (current-seconds)))]) - (report info) + (when (hash-ref @options 'info #f) + (for ([(key val) (in-hash (hash-ref @options 'info))]) + (hash-set! @info key val))) ;; Write the header ;; PDF version - (_write (format "%PDF-~a" version)) + (@_write (format "%PDF-~a" @version)) ;; 4 binary chars, as recommended by the spec (let ([c (integer->char #xFF)]) - (_write (string-append "%" (string c c c c)))) + (@_write (string-append "%" (string c c c c)))) ;; Add the first page - (unless (not (hash-ref options 'autoFirstPage #t)) - (addPage)) + (unless (not (hash-ref @options 'autoFirstPage #t)) + (@addPage)) ;; todo ;;mixin = (methods) => @@ -86,123 +89,120 @@ ;mixin require './mixins/images' ;mixin require './mixins/annotations' - (field [x 0]) - (field [y 0]) - (field [_ctm null]) - (define/public (addPage [my-options options]) + + (public [@addPage addPage]) + (define (@addPage [options @options]) ;; end the current page if needed - (unless (hash-ref options 'bufferPages #f) - (flushPages)) + (unless (hash-ref @options 'bufferPages #f) + (@flushPages)) ;; create a page object - (define page (make-object PDFPage this my-options)) - (push! _pageBuffer page) - #| + (define @page (make-object PDFPage this options)) + (push! @_pageBuffer @page) ;; add the page to the object store - (define pages (make-hasheq)) ; todo @_root.data.Pages.data - (hash-update! pages 'Kids (λ (val) (cons 42 val)) null) ; todo @page.dictionary - (hash-update! pages 'Count add1 0) + (define pages (· @_root data Pages data)) + (hash-update! pages 'Kids (λ (val) (cons (· @page dictionary) val)) null) + (hash-update! pages 'Count add1) ;; reset x and y coordinates - (set! x 42) ;; todo @page.margins.left - (set! y 42) ;; todo @page.margins.top - + (set! @x (· @page margins left)) + (set! @y (· @page margins top)) ;; flip PDF coordinate system so that the origin is in ;; the top left rather than the bottom left - (set! _ctm '(1 0 0 1 0 0)) - ;; (transform 1 0 0 -1 0 @page.height) ;; todo - - ;; @emit('pageAdded') ;; todo + (set! @_ctm '(1 0 0 1 0 0)) + #;(@transform 1 0 0 -1 0 (· @page height)) + #;(@emit "pageAdded") this -|# ) - - (define/public (flushPages) + + (public [@flushPages flushPages]) + (define (@flushPages) ;; this local variable exists so we're future-proof against ;; reentrant calls to flushPages. - (define pages _pageBuffer) - (set! _pageBuffer empty) - (set! _pageBufferStart (+ _pageBufferStart (length pages))) - (for ([page (in-list pages)]) - (send page end))) + (define pages @_pageBuffer) + (set! @_pageBuffer empty) + (+= @_pageBufferStart (length pages)) + (·map end pages)) ;; every js function argument is 'undefined' by default ;; so even a function defined without default values ;; can be called without arguments - (define/public (ref [data (make-hasheq)]) - (define ref (make-object PDFReference this (add1 (length _offsets)) data)) - (push! _offsets #f) ; placeholder for this object's offset once it is finalized - (set! _waiting (add1 _waiting)) + (public [@ref ref]) + (define (@ref [data (make-hasheq)]) + (define ref (make-object PDFReference this (add1 (length @_offsets)) data)) + (push! @_offsets #f) ; placeholder for this object's offset once it is finalized + (++ @_waiting) ref) - (define/public (push chunk) - (push! byte-strings chunk)) - - (define/public (_write data) - (let ([data (if (not (bytes? data)) - ; `string->bytes/latin-1` is equivalent to plain binary encoding - (string->bytes/latin-1 (string-append data "\n")) + (public [@push push]) + (define (@push chunk) + (push! @byte-strings chunk)) + + (public [@_write _write]) + (define (@_write data) + (let ([data (if (not (isBuffer? data)) + (newBuffer (string-append data "\n")) data)]) - (push data) - (report byte-strings) - (set! _offset (+ _offset (bytes-length data))))) + (@push data) + (report @byte-strings) + (+= @_offset (buffer-length data)))) (field [op #f]) (define/public (pipe port) (set! op port)) - (define _info #f) + (field [(@_info _info) #f]) (define/public (end) - (flushPages) - (set! _info (ref)) - (for ([(key val) (in-hash info)]) - ;; upgrade string literal to String struct - (hash-set! (get-field data _info) key - (if (string? val) (String val) val))) - (send _info end) + (@flushPages) + (set! @_info (@ref)) + (for ([(key val) (in-hash @info)]) + ;; upgrade string literal to String struct + (hash-set! (· @_info data) key (if (string? val) (String val) val))) + (· @_info end) ;; todo: fonts ;; for name, font of @_fontFamilies ;; font.finalize() - (send _root end) - (send (hash-ref (get-field data _root) 'Pages) end) + (· @_root end) + (· @_root data Pages end) - (if (or (zero? _waiting) 'debug) - (_finalize) - (set! _ended #t)) + (if (or (zero? @_waiting) 'debug) + (@_finalize) + (set! @_ended #t)) 'done) - (define/public (_finalize [fn #f]) + (public (@_finalize _finalize)) + (define (@_finalize [fn #f]) ;; generate xref - (define xRefOffset _offset) - (_write "xref") - (_write (format "0 ~a" (add1 (length _offsets)))) - (_write "0000000000 65535 f ") - (for ([offset (in-list _offsets)]) - (_write (string-append - (~r (or offset (random 17)) #;debug #:min-width 10 #:pad-string "0") - " 00000 n "))) + (define xRefOffset @_offset) + (@_write "xref") + (@_write (format "0 ~a" (add1 (length @_offsets)))) + (@_write "0000000000 65535 f ") + (for ([offset (in-list @_offsets)]) + (@_write (string-append + (~r (or offset (random 17)) #;debug #:min-width 10 #:pad-string "0") + " 00000 n "))) ;; trailer - (_write "trailer") + (@_write "trailer") ;; todo: make `PDFObject:convert` a static method - (_write (send (make-object PDFObject) convert - (hasheq 'Size (add1 (length _offsets)) - 'Root _root - 'Info _info))) + (@_write (send (make-object PDFObject) convert + (mhasheq 'Size (add1 (length @_offsets)) + 'Root @_root + 'Info @_info))) - (_write "startxref") - (_write (number->string xRefOffset)) - (_write "%%EOF") + (@_write "startxref") + (@_write (number->string xRefOffset)) + (@_write "%%EOF") ;; end the stream - ;; in node you (push null) which signals to the stream + ;; in node you (@push null) which signals to the stream ;; to copy to its output port ;; here we'll do it manually (copy-port (open-input-bytes - (apply bytes-append (reverse byte-strings))) + (apply bytes-append (reverse @byte-strings))) op) (close-output-port op)))) diff --git a/pitfall/pitfall/kit/helper.rkt b/pitfall/pitfall/kit/helper.rkt new file mode 100644 index 00000000..4587603f --- /dev/null +++ b/pitfall/pitfall/kit/helper.rkt @@ -0,0 +1,57 @@ +#lang racket/base +(require (for-syntax racket/base) racket/class sugar/list racket/list) +(provide (all-defined-out)) + +(define-syntax (· stx) + (syntax-case stx () + [(_ x ref) + #'(cond + [(object? x) (with-handlers ([exn:fail:object? (λ (exn) (send x ref))]) + (get-field ref x))] + [(hash? x) (hash-ref x 'ref)] + [else (raise-argument-error '· "object or hash" x)])] + [(_ x ref0 . refs) #'(· (· x ref0) . refs)])) + +(define-syntax (·map stx) + (syntax-case stx () + [(_ ref xs) #'(for/list ([x (in-list xs)]) (· x ref))])) + +(define-syntax-rule (+= id thing) (set! id (+ id thing))) +(define-syntax-rule (++ id) (+= id 1)) +(define-syntax-rule (-- id) (+= id -1)) +(define-syntax-rule (-= id thing) (+= id (- thing))) + +(module+ test + (require rackunit) + (define C + (class object% + (super-new) + (field [foo 'field]) + (define/public (bar) 'method) + (define/public (zam) (hasheq 'zoom 'hash)))) + (define h (hasheq 'bam (new C) 'foo 'hashlet)) + (define o (new C)) + (check-equal? (· o foo) 'field) + (check-equal? (· o bar) 'method) + (check-equal? (· o zam zoom) 'hash) + (check-equal? (· h bam foo) 'field) + (check-equal? (· h bam bar) 'method) + (check-equal? (· h bam zam zoom) 'hash) + (check-equal? (·map foo (list o h)) '(field hashlet))) + + +(define (listify kvs) + (for/list ([slice (in-list (slice-at kvs 2))]) + (cons (first slice) (second slice)))) +(define-syntax-rule (define-hashifier id hasher) (define (id . kvs) (hasher (listify kvs)))) +(define-hashifier mhash make-hash) +(define-hashifier mhasheq make-hasheq) +(define-hashifier mhasheqv make-hasheqv) + +(module+ test + (check-equal? (mhash 'k "v") (make-hash (list (cons 'k "v"))))) + + +(define isBuffer? bytes?) +(define (newBuffer x) (string->bytes/latin-1 (format "~a" x))) +(define buffer-length bytes-length) \ No newline at end of file diff --git a/pitfall/pitfall/kit/page-test.rkt b/pitfall/pitfall/kit/page-test.rkt index e055abd1..cd03ec4a 100644 --- a/pitfall/pitfall/kit/page-test.rkt +++ b/pitfall/pitfall/kit/page-test.rkt @@ -1,13 +1,15 @@ -#lang br - -(require rackunit "document.rkt" "page.rkt") +#lang racket/base +(require racket/class rackunit "document.rkt" "page.rkt" "reference.rkt" "helper.rkt") (define p (make-object PDFPage (make-object PDFDocument))) -(get-field size p) -(get-field layout p) -(get-field margins p) -(get-field height p) -(get-field width p) -(get-field resources p) -(get-field data (get-field resources p)) -(send p fonts) -(get-field data (get-field dictionary p)) \ No newline at end of file +(check-equal? (· p size) "letter") +(check-equal? (· p layout) "portrait") +(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 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 diff --git a/pitfall/pitfall/kit/page.rkt b/pitfall/pitfall/kit/page.rkt index 05e8c253..e5cf87f5 100644 --- a/pitfall/pitfall/kit/page.rkt +++ b/pitfall/pitfall/kit/page.rkt @@ -1,65 +1,65 @@ #lang racket/base -(require racket/class) +(require racket/class "helper.rkt") (provide PDFPage) (define PDFPage (class object% (super-new) - (init-field document - [options (make-hasheq)]) - (field [size (hash-ref options 'size "letter")]) - (field [layout (hash-ref options 'layout "portrait")]) + (init-field [(@document document)] [(@options options) (mhash)]) + (field [(@size size) (hash-ref @options 'size "letter")]) + (field [(@layout layout) (hash-ref @options 'layout "portrait")]) ;; process margins - (field [margins - (let ([margin-value (hash-ref options 'margin #f)]) + (field [(@margins margins) + (let ([margin-value (hash-ref @options 'margin #f)]) (if (number? margin-value) - (hasheq 'top margin-value - 'left margin-value - 'bottom margin-value - 'right margin-value) + (mhash 'top margin-value + 'left margin-value + 'bottom margin-value + 'right margin-value) ;; default to 1 inch margins - (hash-ref options 'margins DEFAULT_MARGINS)))]) + (hash-ref @options 'margins DEFAULT_MARGINS)))]) ;; calculate page dimensions - (define dimensions (if (list? size) - size - (hash-ref SIZES (string-upcase size)))) - (field [width (list-ref dimensions (if (equal? layout "portrait") 0 1))]) - (field [height (list-ref dimensions (if (equal? layout "portrait") 1 0))]) + (define dimensions (if (list? @size) + @size + (hash-ref SIZES (string-upcase @size)))) + (field [(@width width) (list-ref dimensions (if (equal? @layout "portrait") 0 1))]) + (field [(@height height) (list-ref dimensions (if (equal? @layout "portrait") 1 0))]) - (field [content (send document ref)]) + (field [(@content content) (· @document ref)]) ;; Initialize the Font, XObject, and ExtGState dictionaries - (field [resources (send document ref (make-hash (list (cons 'ProcSet '("PDF" "Text" "ImageB" "ImageC" "ImageI")))))]) + (field [(@resources resources) (send @document ref (mhash 'ProcSet '("PDF" "Text" "ImageB" "ImageC" "ImageI")))]) ;; Lazily create these dictionaries (define/public (fonts) - (hash-ref! (get-field data resources) 'Font (make-hash))) + (hash-ref! (· @resources data) 'Font (make-hash))) (define/public (xobjects) - (hash-ref! (get-field data resources) 'XObject (make-hash))) + (hash-ref! (· @resources data) 'XObject (make-hash))) (define/public (ext_gstates) - (hash-ref! (get-field data resources) 'ExtGState (make-hash))) + (hash-ref! (· @resources data) 'ExtGState (make-hash))) (define/public (patterns) - (hash-ref! (get-field data resources) 'Pattern (make-hash))) + (hash-ref! (· @resources data) 'Pattern (make-hash))) (define/public (annotations) - (hash-ref! (get-field data resources) 'Annots null)) + (hash-ref! (· @resources data) 'Annots null)) ;; The page dictionary - (field [dictionary - (send document ref - (make-hash (list - (cons 'Type "Page") - (cons 'Parent (hash-ref (get-field data (get-field _root document)) 'Pages)) - (cons 'MediaBox (list 0 0 width height)) - (cons 'Contents content) - (cons 'Resources resources))))]) + (field [(@dictionary dictionary) + (send @document ref + (mhash 'Type "Page" + 'Parent (· @document _root data Pages) + 'MediaBox (list 0 0 @width @height) + 'Contents @content + 'Resources @resources))]) + (define/public (end) + 'nothing) ;; temp )) diff --git a/pitfall/pitfall/kit/reference.rkt b/pitfall/pitfall/kit/reference.rkt index 258459de..3e99487e 100644 --- a/pitfall/pitfall/kit/reference.rkt +++ b/pitfall/pitfall/kit/reference.rkt @@ -1,46 +1,50 @@ #lang br - +(require "helper.rkt") (provide PDFReference) (define PDFReference (class object% - (init-field document id [data (make-hasheq)]) + (init-field [(@document document)] [(@id id)] [(@data data) (mhasheq)]) (super-new) - (field [gen 0]) - (field [deflate #f]) - (field [compress (and (with-handlers ([exn:fail:contract? (λ (exn) #f)]) - (get-field compress document)) (not (hash-ref data 'Filter #f)))]) - (field [uncompressedLength 0]) - (field [chunks empty]) - - (define/public (initDeflate) + (field [(@gen gen) 0]) + (field [(@deflate deflate) #f]) + (field [(@compress compress) (and (with-handlers ([exn:fail:contract? (λ (exn) #f)]) + (get-field compress @document)) (not (hash-ref @data 'Filter #f)))]) + (field [(@uncompressedLength uncompressedLength) 0]) + (field [(@chunks chunks) empty]) + + (public [@initDeflate initDeflate]) + (define (@initDeflate) ;; todo (void)) - (define/public (_write chunk encoding callback) - ;; assume chunk is a string - (set! uncompressedLength (+ uncompressedLength (string-length chunk))) - (hash-ref! data 'Length 0) + (define/public (_write chunk-in encoding callback) + (define chunk (if (isBuffer? chunk-in) + chunk-in + (newBuffer (string-append chunk "\n")))) + (+= @uncompressedLength (buffer-length chunk)) + (hash-ref! @data 'Length 0) (cond - [compress (when (not deflate) (initDeflate)) - (deflate chunk)] - [else (push! chunks chunk) - (hash-update! data 'Length (λ (len) (+ len (string-length chunk))))]) + [@compress (when (not @deflate) (@initDeflate)) + (send @deflate write chunk)] + [else (push! @chunks chunk) + (hash-update! @data 'Length (λ (len) (+ len (buffer-length chunk))))]) (callback)) (define/public (end [chunk #f]) ; (super) ; todo - (if deflate + (if @deflate (void) ; todo (deflate-end) - (finalize))) + (@finalize))) (field [offset #f]) - (define/public (finalize) - (set! offset (get-field _offset document)) - (send document _write (format "~a ~a obj" id gen)) + (public [@finalize finalize]) + (define (@finalize) + (set! offset (· @document _offset)) + (send @document _write (format "~a ~a obj" @id @gen)) ) (define/public (toString) - (format "~a ~a R" id gen)) + (format "~a ~a R" @id @gen)) ))