From 34df875d6394f523b6a135c01296526afa3ec7a6 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 27 Dec 2018 11:46:31 -0800 Subject: [PATCH] tidy --- pitfall/pitfall/annotations.rkt | 2 +- pitfall/pitfall/color.rkt | 2 +- pitfall/pitfall/document.rkt | 6 ++--- pitfall/pitfall/images.rkt | 2 +- pitfall/pitfall/page.rkt | 47 +++++++++++++++------------------ pitfall/pitfall/text.rkt | 4 +-- 6 files changed, 30 insertions(+), 33 deletions(-) diff --git a/pitfall/pitfall/annotations.rkt b/pitfall/pitfall/annotations.rkt index 202761f4..3be9b987 100644 --- a/pitfall/pitfall/annotations.rkt +++ b/pitfall/pitfall/annotations.rkt @@ -24,7 +24,7 @@ (hash-set! options (string->symbol (string-titlecase (symbol->string k))) v)) (define annots-ref (make-ref options)) - (page-annotations (page doc) annots-ref) + (page-annotations (current-page doc) annots-ref) (ref-end annots-ref) doc) diff --git a/pitfall/pitfall/color.rkt b/pitfall/pitfall/color.rkt index a179ccc2..49aff7c5 100644 --- a/pitfall/pitfall/color.rkt +++ b/pitfall/pitfall/color.rkt @@ -26,7 +26,7 @@ (ref-end ref-dict) (define opacity-index (add1 (length (hash-keys ($doc-opacity-registry doc))))) (list ref-dict (string->symbol (format "Gs~a" opacity-index)))))) - (hash-set! (page-ext_gstates (page doc)) name dictionary) + (hash-set! (page-ext_gstates (current-page doc)) name dictionary) (add-content doc (format "/~a gs" name)))) (define (fill-color doc color [opacity 1]) diff --git a/pitfall/pitfall/document.rkt b/pitfall/pitfall/document.rkt index 9c4bbd11..10977cf3 100644 --- a/pitfall/pitfall/document.rkt +++ b/pitfall/pitfall/document.rkt @@ -75,12 +75,12 @@ (set-$doc-pages! doc (cons (make-page page-parent options-arg) ($doc-pages doc))) ;; reset x and y coordinates - (set-$doc-x! doc (margin-left ($page-margins (page doc)))) - (set-$doc-y! doc (margin-right ($page-margins (page doc)))) + (set-$doc-x! doc (margin-left ($page-margins (current-page doc)))) + (set-$doc-y! doc (margin-right ($page-margins (current-page doc)))) ;; flip PDF coordinate system so that the origin is in ;; the top left rather than the bottom left (set-$doc-ctm! doc default-ctm-value) - (transform doc 1 0 0 -1 0 ($page-height (page doc))) + (transform doc 1 0 0 -1 0 ($page-height (current-page doc))) doc) (define (start-doc doc) diff --git a/pitfall/pitfall/images.rkt b/pitfall/pitfall/images.rkt index 56c227dd..e0e481e7 100644 --- a/pitfall/pitfall/images.rkt +++ b/pitfall/pitfall/images.rkt @@ -31,7 +31,7 @@ [else (open-image doc src)])) (unless ($img-ref image) (($img-embed-proc image) image)) - (hash-ref! (page-xobjects (page doc)) ($img-label image) ($img-ref image)) + (hash-ref! (page-xobjects (current-page doc)) ($img-label image) ($img-ref image)) (define image-width ($img-width image)) (define image-height ($img-height image)) diff --git a/pitfall/pitfall/page.rkt b/pitfall/pitfall/page.rkt index 53d2df78..a3ddd3af 100644 --- a/pitfall/pitfall/page.rkt +++ b/pitfall/pitfall/page.rkt @@ -1,44 +1,41 @@ #lang debug racket/base (require racket/dict + racket/match "reference.rkt" sugar/unstable/dict "core.rkt") (provide (all-defined-out)) -(define (page doc) (car ($doc-pages doc))) +(define (current-page doc) (car ($doc-pages doc))) (define (add-content doc data) - (page-write (page doc) data)) + (page-write (current-page doc) data)) (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) +(define (make-page [page-parent #false] [options (mhasheq)]) + (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))))] - ;; The page dictionary - [define dictionary - (make-ref - (mhash 'Type 'Page - '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)) + (hash-ref page-sizes (string-upcase size)))) + (match-define (list width height) ((if (equal? layout "portrait") values reverse) dimensions)) + (define content (make-ref)) + (define resources (make-ref (mhash 'ProcSet '(PDF Text ImageB ImageC ImageI)))) + (define margins + (match (hash-ref options 'margin #f) + [(? number? margin-value) (margin margin-value margin-value margin-value margin-value)] + [_ (hash-ref options 'margins (current-default-margins))])) + (define page-dictionary + (make-ref (mhasheq 'Type 'Page + '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 page-dictionary)) (define (page-fonts p) (dict-ref! ($page-resources p) 'Font (make-hasheq))) diff --git a/pitfall/pitfall/text.rkt b/pitfall/pitfall/text.rkt index 4a42caab..e8ad28c3 100644 --- a/pitfall/pitfall/text.rkt +++ b/pitfall/pitfall/text.rkt @@ -59,7 +59,7 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee ;; flip coordinate system (save doc) - (define page-height ($page-height (page doc))) + (define page-height ($page-height (current-page doc))) (transform doc 1 0 0 -1 0 page-height) (define y (- page-height y-in @@ -68,7 +68,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 ($doc-current-font doc))) - (hash-ref! (page-fonts (page doc)) current-font-id (λ () (send ($doc-current-font doc) make-font-ref))) + (hash-ref! (page-fonts (current-page doc)) current-font-id (λ () (send ($doc-current-font doc) make-font-ref))) (add-content doc "BT") ; begin the text object (add-content doc (format "1 0 0 1 ~a ~a Tm" (numberizer x) (numberizer y))) ; text position