You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
119 lines
3.9 KiB
Racket
119 lines
3.9 KiB
Racket
#lang debug racket/base
|
|
(require
|
|
"core.rkt"
|
|
racket/class
|
|
racket/format
|
|
racket/generator
|
|
racket/match
|
|
racket/dict
|
|
racket/list
|
|
sugar/unstable/dict
|
|
"reference.rkt"
|
|
"object.rkt"
|
|
"page.rkt"
|
|
"vector.rkt"
|
|
"color.rkt"
|
|
"fonts.rkt"
|
|
"text.rkt"
|
|
"images.rkt"
|
|
"annotations.rkt")
|
|
(provide PDFDocument)
|
|
|
|
(define PDFDocument
|
|
(class (annotation-mixin (image-mixin (text-mixin (fonts-mixin (vector-mixin (color-mixin object%))))))
|
|
(super-new)
|
|
(init-field [(@options options) (mhasheq)])
|
|
(field [@pages null]
|
|
[@refs null]
|
|
[@ref-gen (generator () (let loop ([refid 1])
|
|
(yield refid)
|
|
(loop (add1 refid))))]
|
|
[@root (ref (mhasheq 'Type "Catalog"
|
|
'Pages (ref (mhasheq 'Type "Pages"))))]
|
|
[(@x x) 0]
|
|
[(@y y) 0]
|
|
;; initialize the metadata
|
|
[@info (mhasheq 'Producer "PITFALL"
|
|
'Creator "PITFALL"
|
|
'CreationDate (seconds->date (if (test-mode) 0 (current-seconds)) #f))])
|
|
|
|
;; initialize mixins
|
|
(inherit-field @ctm) ; from vector mixin
|
|
(inherit-field @font-families) (inherit font) ; from font mixin
|
|
(send this init-text)
|
|
(send this init-images)
|
|
|
|
;; initialize params
|
|
(current-compress-streams? (hash-ref @options 'compress #t))
|
|
(current-auto-first-page (hash-ref @options 'autoFirstPage #t))
|
|
(when (current-auto-first-page) (add-page))
|
|
(when (current-auto-helvetica) (font "Helvetica"))
|
|
|
|
;; 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 new-ref (make-object PDFReference (@ref-gen) payload))
|
|
(set! @refs (cons new-ref @refs))
|
|
new-ref)
|
|
|
|
(define/public (add-page [options-arg @options])
|
|
;; create a page object
|
|
(define page-parent (dict-ref @root 'Pages))
|
|
(set! @pages (cons (make-object PDFPage this page-parent options-arg) @pages))
|
|
|
|
;; reset x and y coordinates
|
|
(set! @x (margin-left (get-field margins (page))))
|
|
(set! @y (margin-right (get-field margins (page))))
|
|
;; flip PDF coordinate system so that the origin is in
|
|
;; the top left rather than the bottom left
|
|
(set! @ctm default-ctm-value)
|
|
(send this transform 1 0 0 -1 0 (get-field height (page)))
|
|
this)
|
|
|
|
(define/public (addContent data)
|
|
(send (page) write data)
|
|
this)
|
|
|
|
(define/public (end)
|
|
(write-bytes-out (format "%PDF-~a" (current-pdf-version)))
|
|
(write-bytes-out "%ÿÿÿÿ")
|
|
|
|
(for ([page (in-list @pages)])
|
|
(send page end))
|
|
|
|
(define doc-info (ref))
|
|
(for ([(key val) (in-hash @info)])
|
|
(dict-set! doc-info key (if (string? val) (String val) val)))
|
|
(send doc-info end)
|
|
|
|
(for ([font (in-hash-values @font-families)])
|
|
(send font finalize))
|
|
|
|
(send* (dict-ref @root 'Pages)
|
|
[set-key! 'Count (length @pages)]
|
|
[set-key! 'Kids (map (λ (page) (get-field dictionary page)) (reverse @pages))]
|
|
[end])
|
|
|
|
(send @root end)
|
|
|
|
(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))) |