diff --git a/pitfall/pitfall/annotations.rkt b/pitfall/pitfall/annotations.rkt index 201a10fb..516a9444 100644 --- a/pitfall/pitfall/annotations.rkt +++ b/pitfall/pitfall/annotations.rkt @@ -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) diff --git a/pitfall/pitfall/color.rkt b/pitfall/pitfall/color.rkt index 2988d82b..ece7cdb1 100644 --- a/pitfall/pitfall/color.rkt +++ b/pitfall/pitfall/color.rkt @@ -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 diff --git a/pitfall/pitfall/document.rkt b/pitfall/pitfall/document.rkt index 9e1b62dd..52a8ef8a 100644 --- a/pitfall/pitfall/document.rkt +++ b/pitfall/pitfall/document.rkt @@ -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) diff --git a/pitfall/pitfall/images.rkt b/pitfall/pitfall/images.rkt index 9648ca23..051eb85a 100644 --- a/pitfall/pitfall/images.rkt +++ b/pitfall/pitfall/images.rkt @@ -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)) diff --git a/pitfall/pitfall/page-test.rkt b/pitfall/pitfall/page-test.rkt index 7a234f22..7fafe96d 100644 --- a/pitfall/pitfall/page-test.rkt +++ b/pitfall/pitfall/page-test.rkt @@ -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))) \ No newline at end of file +(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))) \ No newline at end of file diff --git a/pitfall/pitfall/page.rkt b/pitfall/pitfall/page.rkt index f24e2294..d0a6cbae 100644 --- a/pitfall/pitfall/page.rkt +++ b/pitfall/pitfall/page.rkt @@ -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 diff --git a/pitfall/pitfall/text.rkt b/pitfall/pitfall/text.rkt index 6edbe82a..0474b458 100644 --- a/pitfall/pitfall/text.rkt +++ b/pitfall/pitfall/text.rkt @@ -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