mbutterick
/
typesetting
2
1
Fork 0
Code Issues 13 Pull Requests Projects Releases Wiki Activity

methodize

Browse Source
main
Matthew Butterick 6 years ago
parent 33f0c6443b
commit 8a38e41a91
1 changed files with 88 additions and 127 deletions
Show Stats Download Patch File Download Diff File

215
pitfall/pitfall/document.rkt
Unescape Escape View File

@ -58,129 +58,81 @@
(· this initColor) (· this initColor)
(· this initVector) (· this initVector)
(· this initFonts) (· this initFonts)
(inherit-field _fontFamilies)
(· this initText) (· this initText)
(· this initImages) (· this initImages)
(define/public (ref [payload (mhash)]) (define/public (ref [payload (mhash)])
(make-object PDFReference this (ref-gen) payload)) (make-object PDFReference this (ref-gen) payload))
(as-methods (define/public (write x)
addPage (define bstr (if (not (bytes? x))
flushPages (string->bytes/latin-1 (string-append x "\n"))
write x))
addContent (set! doc-byte-strings (cons bstr doc-byte-strings))
_refEnd (current-doc-offset (+ (current-doc-offset) (bytes-length bstr))))
pipe
end) (define/public (addPage [options-arg options])
;; end the current page if needed
(for ([(key val) (in-hash (hash-ref options 'info (hash)))]) ; if no 'info key, nothing will be copied from (hash) (unless (hash-ref options 'bufferPages #f)
(hash-set! info key val)) (flushPages))
;; Write the header ;; create a page object
(write this (format "%PDF-~a" (current-pdf-version))) ; PDF version (set! page (make-object PDFPage this options-arg))
(write this (string-append "%" (list->string (map integer->char (make-list 4 #xFF))))) ; 4 binary chars, as recommended by the spec (push-field! _pageBuffer this page)
;; Add the first page
(when (current-auto-first-page) (addPage this)))
(define/contract (addPage this [options-arg (· this options)])
(() (hash?) . ->*m . object?)
;; end the current page if needed
(unless (hash-ref (· this options) 'bufferPages #f)
(send this flushPages))
;; create a page object
(set-field! page this (make-object PDFPage this options-arg))
(push-field! _pageBuffer this (· this page))
;; in Kids, store page dictionaries in correct order ;; in Kids, store page dictionaries in correct order
;; this determines order in document ;; this determines order in document
(define pages (· this _root payload Pages payload)) (define pages (· _root payload Pages payload))
(hash-update! pages 'Kids (λ (val) (append val (list (· this page dictionary))))) (hash-update! pages 'Kids (λ (val) (append val (list (· page dictionary)))))
(hash-set! pages 'Count (length (hash-ref pages 'Kids))) (hash-set! pages 'Count (length (hash-ref pages 'Kids)))
;; reset x and y coordinates ;; reset x and y coordinates
(set-field! x this (· this page margins left)) (set! x (· page margins left))
(set-field! y this (· this page margins top)) (set! y (· page margins top))
;; flip PDF coordinate system so that the origin is in ;; flip PDF coordinate system so that the origin is in
;; the top left rather than the bottom left ;; the top left rather than the bottom left
(set-field! _ctm this default-ctm-value) (set-field! _ctm this default-ctm-value)
(send this transform 1 0 0 -1 0 (· this page height)) (send this transform 1 0 0 -1 0 (· this page height))
this) this)
(define/public (flushPages)
(define/contract (flushPages this) (for-each (λ (p) (· p end)) _pageBuffer)
(->m void?) (set! _pageBuffer empty))
(define pb (· this _pageBuffer))
(for-each (λ (p) (· p end)) pb) (define/public (addContent data)
(set-field! _pageBuffer this empty)) (send page write data)
this)
(define/contract (write this x)
((or/c string? bytes?) . ->m . any/c) (define/public (_refEnd ref)
(define bstr (if (not (bytes? x)) (hash-set! _offsets (· ref id) (· ref offset)))
(string->bytes/latin-1 (string-append x "\n"))
x)) (define/public (pipe port)
(push-field! doc-byte-strings this bstr) (set! output-port port))
(current-doc-offset (+ (current-doc-offset) (bytes-length bstr))))
(define/contract (addContent this data)
(any/c . ->m . object?)
(send (· this page) write data)
this)
(define/contract (offsets-missing? this)
(->m boolean?)
(positive? (length (filter (λ (v) (eq? 'missing-ref-offset v)) (hash-values (· this _offsets))))))
(define/contract (_refEnd this ref)
((is-a?/c PDFReference) . ->m . void?)
#;(report* (· ref id) (· this _offsets))
(hash-set! (· this _offsets) (· ref id) (· ref offset)))
(define/contract (pipe this port)
(port? . ->m . void?)
(set-field! output-port this port))
(define/contract (end this) ; called from source file to finish doc
(->m void?)
#;(report* 'start-end)
#;(report* (· this _offsets))
(flushPages this)
(define _info (send this ref))
(for ([(key val) (in-hash (· this info))])
;; upgrade string literal to String struct
(hash-set! (· _info payload) key (if (string? val) (String val) val)))
#;(report* (· this _offsets)) (define/public (end) ; called from source file to finish doc
(· _info end) (flushPages)
(define _info (ref))
(for ([(key val) (in-hash info)])
;; upgrade string literal to String struct
(hash-set! (· _info payload) key (if (string? val) (String val) val)))
(for ([font (in-hash-values (· this _fontFamilies))]) (· _info end)
(· font finalize))
#;(report* (· this _offsets)) (for ([font (in-hash-values _fontFamilies)])
(· font finalize))
(· this _root end) (· _root end)
#;(report* (· this _offsets)) (· _root payload Pages end)
(· this _root payload Pages end)
#;(report* (· this _offsets))
;; generate xref ;; generate xref
(define xref-offset (current-doc-offset)) (define xref-offset (current-doc-offset))
(with-method ([this-write (this write)]) (define sorted-offset-records (sort (hash->list _offsets) < #:key car)) ; sort by refid
(define sorted-offset-records (sort (hash->list (· this _offsets)) < #:key car)) ; sort by refid
(define this-offsets (map cdr sorted-offset-records)) (define this-offsets (map cdr sorted-offset-records))
(define this-idxs (map car sorted-offset-records)) (define this-idxs (map car sorted-offset-records))
(this-write "xref") (write "xref")
(this-write (format "0 ~a" (add1 (length this-offsets)))) (write (format "0 ~a" (add1 (length this-offsets))))
(this-write "0000000000 65535 f ") (write "0000000000 65535 f ")
(let ([missing-offsets (for/list ([offset (in-list this-offsets)] (let ([missing-offsets (for/list ([offset (in-list this-offsets)]
[idx (in-list this-idxs)] [idx (in-list this-idxs)]
#:unless (number? offset)) #:unless (number? offset))
@ -189,27 +141,36 @@
(raise-argument-error 'document:end "numerical offsets" missing-offsets))) (raise-argument-error 'document:end "numerical offsets" missing-offsets)))
(for ([offset (in-list this-offsets)] (for ([offset (in-list this-offsets)]
[idx (in-list this-idxs)]) [idx (in-list this-idxs)])
(this-write @string-append{@(~r offset #:min-width 10 #:pad-string "0") 00000 n })) (write @string-append{@(~r offset #:min-width 10 #:pad-string "0") 00000 n }))
(this-write "trailer") ;; trailer
(this-write (convert (write "trailer")
(mhash 'Size (add1 (length this-offsets)) (write (convert
'Root (· this _root) (mhash 'Size (add1 (length this-offsets))
'Info _info))) 'Root _root
(this-write "startxref") 'Info _info)))
(this-write (number xref-offset)) (write "startxref")
(this-write "%%EOF")) (write (number xref-offset))
(write "%%EOF")
;; end the stream ;; 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 ;; to copy to its output port
;; here we'll do it manually ;; here we'll do it manually
(define this-output-port (· this output-port)) (define this-output-port (· this output-port))
(copy-port (open-input-bytes (copy-port (open-input-bytes
(apply bytes-append (reverse (· this doc-byte-strings)))) this-output-port) (apply bytes-append (reverse (· this doc-byte-strings)))) this-output-port)
(close-output-port this-output-port)) (close-output-port this-output-port))
; if no 'info key, nothing will be copied from (hash)
(for ([(key val) (in-hash (hash-ref options 'info (hash)))])
(hash-set! info key val))
;; Write the header
(write (format "%PDF-~a" (current-pdf-version))) ; PDF version
(write (string-append "%" (list->string (map integer->char (make-list 4 #xFF))))) ; 4 binary chars, as recommended by the spec
;; Add the first page
(when (current-auto-first-page) (addPage)))
(module+ test (module+ test
(define d (new PDFDocument))) (define d (new PDFDocument)))
Write Preview
Loading…
Cancel
Save