structify page

main
Matthew Butterick 6 years ago
parent 17b4c97897
commit 26a49ab3cf

@ -2,6 +2,7 @@
(require
"core.rkt"
"reference.rkt"
"page.rkt"
racket/class
racket/match
sugar/unstable/dict)
@ -12,6 +13,7 @@
(class %
(super-new)
(inherit-field @ctm)
(inherit page)
(define/public (annotate x y w h options)
(hash-set*! options
@ -28,7 +30,7 @@
(hash-set! options (string->symbol (string-titlecase (symbol->string k))) v))
(define annots-ref (make-ref options))
(send (send this page) annotations annots-ref)
(page-annotations (page) annots-ref)
(ref-end annots-ref)
this)

@ -2,6 +2,7 @@
(require
"core.rkt"
"reference.rkt"
"page.rkt"
racket/class
racket/match
racket/string)
@ -109,7 +110,7 @@
(ref-end ref-dict)
(set! @opacity-count (add1 @opacity-count))
(list ref-dict (string->symbol (format "Gs~a" @opacity-count))))))
(hash-set! (send (send this page) ext_gstates) name dictionary)
(hash-set! (page-ext_gstates (send this page)) name dictionary)
(send this add-content (format "/~a gs" name))))))
(define named-colors

@ -28,7 +28,7 @@
(field [@pages null])
(define/public (page) (first @pages))
(define/public (add-content data)
(send (first @pages) write data)
(page-write (first @pages) data)
this))))))))
(set-current-ref-id! 1)
(register-ref-listener (λ (ref) (send this store-ref ref)))
@ -66,15 +66,15 @@
(define/public (add-page [options-arg @options])
;; create a page object
(define page-parent (dict-ref @root 'Pages))
(set! @pages (cons (make-object PDFPage page-parent options-arg) @pages))
(set! @pages (cons (make-page 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))))
(set! @x (margin-left ($page-margins (page))))
(set! @y (margin-right ($page-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)
(transform 1 0 0 -1 0 (get-field height (page)))
(transform 1 0 0 -1 0 ($page-height (page)))
this)
(define/public (start-doc)
@ -82,8 +82,7 @@
(write-bytes-out "%ÿÿÿÿ"))
(define/public (end-doc)
(for ([page (in-list @pages)])
(send page end))
(for-each page-end @pages)
(define doc-info (make-ref))
(for ([(key val) (in-hash @info)])
@ -95,7 +94,7 @@
(define pages-ref (dict-ref @root 'Pages))
(dict-set! pages-ref 'Count (length @pages))
(dict-set! pages-ref 'Kids (map (λ (page) (get-field dictionary page)) (reverse @pages)))
(dict-set! pages-ref 'Kids (map $page-dictionary (reverse @pages)))
(ref-end pages-ref)
(ref-end @root)

@ -3,7 +3,8 @@
racket/class
racket/match
sugar/unstable/dict
"image.rkt")
"image.rkt"
"page.rkt")
(provide image-mixin)
(define (image-mixin [% object%])
@ -12,6 +13,7 @@
(field [@image-registry (mhash)]
[@image-count 0])
(inherit-field [@x x] [@y y])
(inherit page)
(define/public (image src [x-in #f] [y-in #f] [options (mhasheq)])
(define x (or x-in (hash-ref options 'x #f) @x))
@ -23,7 +25,7 @@
[else (send this open-image src)]))
(unless (get-field obj image) (send image embed))
(hash-ref! (send (send this page) xobjects) (get-field label image) (get-field obj image))
(hash-ref! (page-xobjects (page)) (get-field label image) (get-field obj image))
(define image-width (get-field width image))
(define image-height (get-field height image))

@ -1,20 +1,21 @@
#lang racket/base
(require racket/class
rackunit
racket/dict
"document.rkt"
"page.rkt"
"reference.rkt"
"core.rkt"
sugar/unstable/js)
(define p (make-object PDFPage))
(check-equal? (· p size) "letter")
(check-equal? (· p layout) "portrait")
(check-equal? (· p margins) (margin 72 72 72 72))
(check-equal? (· p height) 792.0)
(check-equal? (· p width) 612.0)
(check-equal? (· p resources ProcSet) '(PDF Text ImageB ImageC ImageI))
(define p (make-page))
(check-equal? ($page-size p) "letter")
(check-equal? ($page-layout p) "portrait")
(check-equal? ($page-margins p) (margin 72 72 72 72))
(check-equal? ($page-height p) 792.0)
(check-equal? ($page-width p) 612.0)
(check-equal? (dict-ref ($page-resources p) 'ProcSet) '(PDF Text ImageB ImageC ImageI))
(check-equal? (· p dictionary Type) 'Page)
(check-equal? (· p dictionary MediaBox) '(0 0 612.0 792.0))
(check-true ($ref? (· p dictionary Contents)))
(check-true ($ref? (· p dictionary Resources)))
(check-equal? (dict-ref ($page-dictionary p) 'Type) 'Page)
(check-equal? (dict-ref ($page-dictionary p) 'MediaBox) '(0 0 612.0 792.0))
(check-true ($ref? (dict-ref ($page-dictionary p) 'Contents)))
(check-true ($ref? (dict-ref ($page-dictionary p) 'Resources)))

@ -1,68 +1,67 @@
#lang debug racket/base
(require
racket/class
racket/dict
"reference.rkt"
sugar/unstable/dict
"core.rkt")
(provide PDFPage)
(provide (all-defined-out))
(define PDFPage
(class object%
(super-new)
(init-field [@page-parent #false] [@options (mhash)])
(field [(@size size) (hash-ref @options 'size "letter")]
[(@layout layout) (hash-ref @options 'layout "portrait")]
[@dimensions (if (list? @size)
@size
(hash-ref page-sizes (string-upcase @size)))]
[(@width width) (list-ref @dimensions (if (equal? @layout "portrait") 0 1))]
[(@height height) (list-ref @dimensions (if (equal? @layout "portrait") 1 0))]
[@content (make-ref)]
[(@resources resources) (make-ref (mhash 'ProcSet '(PDF Text ImageB ImageC ImageI)))]
[(@margins margins)
(let ([margin-value (hash-ref @options 'margin #f)])
(struct $page (page-parent options size layout dimensions width height content resources margins dictionary)
#:transparent #:mutable)
(define (make-page [page-parent #false] [options (mhash)])
[define size (hash-ref options 'size "letter")]
[define layout (hash-ref options 'layout "portrait")]
[define dimensions (if (list? size)
size
(hash-ref page-sizes (string-upcase size)))]
[define width (list-ref dimensions (if (equal? layout "portrait") 0 1))]
[define height (list-ref dimensions (if (equal? layout "portrait") 1 0))]
[define content (make-ref)]
[define resources (make-ref (mhash 'ProcSet '(PDF Text ImageB ImageC ImageI)))]
[define margins
(let ([margin-value (hash-ref options 'margin #f)])
(if (number? margin-value)
(margin margin-value margin-value margin-value margin-value)
(hash-ref @options 'margins (current-default-margins))))]
(hash-ref options 'margins (current-default-margins))))]
;; The page dictionary
[(@dictionary dictionary)
[define dictionary
(make-ref
(mhash 'Type 'Page
'Parent @page-parent
'MediaBox (list 0 0 @width @height)
'Contents @content
'Resources @resources))])
'Parent page-parent
'MediaBox (list 0 0 width height)
'Contents content
'Resources resources))]
($page page-parent options size layout dimensions width height content resources margins dictionary))
;; Lazily create these dictionaries
(define/public (fonts)
(dict-ref! @resources 'Font (make-hasheq)))
(define (page-fonts p)
(dict-ref! ($page-resources p) 'Font (make-hasheq)))
(define/public (xobjects)
(dict-ref! @resources 'XObject (make-hasheq)))
(define (page-xobjects p)
(dict-ref! ($page-resources p) 'XObject (make-hasheq)))
(define/public (ext_gstates)
(dict-ref! @resources 'ExtGState (make-hasheq)))
(define (page-ext_gstates p)
(dict-ref! ($page-resources p) 'ExtGState (make-hasheq)))
(define/public (patterns)
(dict-ref! @resources 'Pattern (make-hasheq)))
(define (page-patterns p)
(dict-ref! ($page-resources p) 'Pattern (make-hasheq)))
(define/public (annotations [annot #f])
(define (page-annotations p [annot #f])
(if annot
(dict-update! @dictionary 'Annots (λ (val) (cons annot val)) null)
(dict-ref! @dictionary 'Annots null)))
(dict-update! ($page-dictionary p) 'Annots (λ (val) (cons annot val)) null)
(dict-ref! ($page-dictionary p) 'Annots null)))
(define/public (maxY)
(- @height (margin-bottom @margins)))
(define (page-maxY p)
(- ($page-height p) (margin-bottom ($page-margins p))))
(define/public (write chunk)
(ref-write @content chunk))
(define (page-write p chunk)
(ref-write ($page-content p) chunk))
(define/public (end)
(ref-end @dictionary)
(ref-end @resources)
(ref-end @content))))
(define (page-end p)
(ref-end ($page-dictionary p))
(ref-end ($page-resources p))
(ref-end ($page-content p)))
(define page-sizes

@ -1,6 +1,7 @@
#lang racket/base
(require
"core.rkt"
"page.rkt"
racket/class
racket/match
racket/string
@ -91,7 +92,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
;; flip coordinate system
(save)
(define page-height (get-field height (first @pages)))
(define page-height ($page-height (first @pages)))
(transform 1 0 0 -1 0 page-height)
(define y (- page-height
y-in
@ -100,7 +101,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
;; add current font to page if necessary
(define current-font-id (get-field id @current-font))
(hash-ref! (send (first @pages) fonts) current-font-id (λ () (send @current-font make-font-ref)))
(hash-ref! (page-fonts (first @pages)) current-font-id (λ () (send @current-font make-font-ref)))
(add-content "BT") ; begin the text object
(add-content (format "1 0 0 1 ~a ~a Tm" (numberizer x) (numberizer y))) ; text position

Loading…
Cancel
Save