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

renaming

Browse Source
main
Matthew Butterick 5 years ago
parent eedcb734a4
commit c8a2e7cb01
12 changed files with 79 additions and 79 deletions
Show Stats Download Patch File Download Diff File

2
pitfall/pitfall/annotation.rkt
Unescape Escape View File

@ -44,7 +44,7 @@
(let ([y2 y1] (let ([y2 y1]
[y1 (+ y1 h)] [y1 (+ y1 h)]
[x2 (+ x1 w)]) [x2 (+ x1 w)])
(match-define (list m0 m1 m2 m3 m4 m5) ($doc-ctm doc)) (match-define (list m0 m1 m2 m3 m4 m5) (pdf-ctm doc))
(let* ([x1 (+ (* x1 m0) (* y1 m2) m4)] (let* ([x1 (+ (* x1 m0) (* y1 m2) m4)]
[y1 (+ (* x1 m1) (* y1 m3) m5)] [y1 (+ (* x1 m1) (* y1 m3) m5)]
[x2 (+ (* x2 m0) (* y2 m2) m4)] [x2 (+ (* x2 m0) (* y2 m2) m4)]

6
pitfall/pitfall/color.rkt
Unescape Escape View File

@ -15,7 +15,7 @@
(if fill-opacity (numberizer fill-opacity) "") (if fill-opacity (numberizer fill-opacity) "")
(if stroke-opacity (numberizer stroke-opacity) ""))) (if stroke-opacity (numberizer stroke-opacity) "")))
(match-define (list dictionary name) (match-define (list dictionary name)
(hash-ref! ($doc-opacity-registry doc) key (hash-ref! (pdf-opacity-registry doc) key
(λ () (λ ()
(define dictionary (make-hasheq '((Type . ExtGState)))) (define dictionary (make-hasheq '((Type . ExtGState))))
(when fill-opacity (when fill-opacity
@ -24,7 +24,7 @@
(hash-set! dictionary 'CA stroke-opacity)) (hash-set! dictionary 'CA stroke-opacity))
(define ref-dict (make-ref dictionary)) (define ref-dict (make-ref dictionary))
(ref-end ref-dict) (ref-end ref-dict)
(define opacity-index (add1 (length (hash-keys ($doc-opacity-registry doc))))) (define opacity-index (add1 (length (hash-keys (pdf-opacity-registry doc)))))
(list ref-dict (string->symbol (format "Gs~a" opacity-index)))))) (list ref-dict (string->symbol (format "Gs~a" opacity-index))))))
(hash-set! (page-ext_gstates (current-page doc)) name dictionary) (hash-set! (page-ext_gstates (current-page doc)) name dictionary)
(add-content doc (format "/~a gs" name)))) (add-content doc (format "/~a gs" name))))
@ -35,7 +35,7 @@
(when (set-color doc color #f) (fill-opacity doc opacity)) (when (set-color doc color #f) (fill-opacity doc opacity))
;; save this for text wrapper, which needs to reset ;; save this for text wrapper, which needs to reset
;; the fill color on new pages ;; the fill color on new pages
(set-$doc-current-fill-color! doc (list color opacity)) (set-pdf-current-fill-color! doc (list color opacity))
doc) doc)
(define (fill-opacity doc opacity) (define (fill-opacity doc opacity)

2
pitfall/pitfall/core.rkt
Unescape Escape View File

@ -4,7 +4,7 @@
;; structs ;; structs
(struct $doc (options (struct pdf (options
pages pages
refs refs
root root

30
pitfall/pitfall/font.rkt
Unescape Escape View File

@ -12,39 +12,39 @@
(make-object (if (standard-font-name? name) standard-font% embedded-font%) name id)) (make-object (if (standard-font-name? name) standard-font% embedded-font%) name id))
(define (current-line-height doc [include-gap #f]) (define (current-line-height doc [include-gap #f])
(send ($doc-current-font doc) line-height ($doc-current-font-size doc) include-gap)) (send (pdf-current-font doc) line-height (pdf-current-font-size doc) include-gap))
(define (font doc src [size #f]) (define (font doc src [size #f])
;; check registered fonts if src is a string ;; check registered fonts if src is a string
(define cache-key (define cache-key
(match src (match src
[(? string?) #:when (hash-has-key? ($doc-registered-fonts doc) src) [(? string?) #:when (hash-has-key? (pdf-registered-fonts doc) src)
(define ck src) (define ck src)
(set! src (hash-ref (hash-ref ($doc-registered-fonts doc) ck) 'src)) (set! src (hash-ref (hash-ref (pdf-registered-fonts doc) ck) 'src))
ck] ck]
[(? string?) src] [(? string?) src]
[_ #false])) [_ #false]))
(when size (font-size doc size)) (when size (font-size doc size))
(match (hash-ref ($doc-font-families doc) cache-key #f) ; check if the font is already in the PDF (match (hash-ref (pdf-font-families doc) cache-key #f) ; check if the font is already in the PDF
[(? values val) (set-$doc-current-font! doc val)] [(? values val) (set-pdf-current-font! doc val)]
[_ ; if not, load the font [_ ; if not, load the font
(define font-index (add1 (length (hash-keys ($doc-font-families doc))))) (define font-index (add1 (length (hash-keys (pdf-font-families doc)))))
(define id (string->symbol (format "F~a" font-index))) (define id (string->symbol (format "F~a" font-index)))
(set-$doc-current-font! doc (open-pdf-font src id)) (set-pdf-current-font! doc (open-pdf-font src id))
;; check for existing font families with the same name already in the PDF ;; check for existing font families with the same name already in the PDF
(match (hash-ref ($doc-font-families doc) (get-field name ($doc-current-font doc)) #f) (match (hash-ref (pdf-font-families doc) (get-field name (pdf-current-font doc)) #f)
[(? values font) (set-$doc-current-font! doc font)] [(? values font) (set-pdf-current-font! doc font)]
[_ ;; save the font for reuse later [_ ;; save the font for reuse later
(when cache-key (hash-set! ($doc-font-families doc) cache-key ($doc-current-font doc))) (when cache-key (hash-set! (pdf-font-families doc) cache-key (pdf-current-font doc)))
(hash-set! ($doc-font-families doc) (get-field name ($doc-current-font doc)) ($doc-current-font doc))])]) (hash-set! (pdf-font-families doc) (get-field name (pdf-current-font doc)) (pdf-current-font doc))])])
doc) doc)
(define (font-size doc size) (define (font-size doc size)
(unless (and (number? size) (not (negative? size))) (unless (and (number? size) (not (negative? size)))
(raise-argument-error 'font-size "non-negative number" size)) (raise-argument-error 'font-size "non-negative number" size))
(set-$doc-current-font-size! doc size) (set-pdf-current-font-size! doc size)
doc) doc)
(define (net-features feats) (define (net-features feats)
@ -78,10 +78,10 @@
(define new-features (append (make-feat-pairs features-on 1) (define new-features (append (make-feat-pairs features-on 1)
(make-feat-pairs features-off 0))) (make-feat-pairs features-off 0)))
(set-$doc-current-font-features! (set-pdf-current-font-features!
doc (net-features (append ($doc-current-font-features doc) new-features))) doc (net-features (append (pdf-current-font-features doc) new-features)))
doc) doc)
(define (register-font doc name src) (define (register-font doc name src)
(hash-set! ($doc-registered-fonts doc) name (make-hasheq (list (cons 'src src)))) (hash-set! (pdf-registered-fonts doc) name (make-hasheq (list (cons 'src src))))
doc) doc)

14
pitfall/pitfall/image.rkt
Unescape Escape View File

@ -22,11 +22,11 @@
(img-constructor data label)) (img-constructor data label))
(define (image doc src [x-in #f] [y-in #f] [options (mhasheq)]) (define (image doc src [x-in #f] [y-in #f] [options (mhasheq)])
(define x (or x-in (hash-ref options 'x #f) ($doc-x doc))) (define x (or x-in (hash-ref options 'x #f) (pdf-x doc)))
(define y (or y-in (hash-ref options 'y #f) ($doc-y doc))) (define y (or y-in (hash-ref options 'y #f) (pdf-y doc)))
(define image (cond (define image (cond
[(and (string? src) (hash-ref ($doc-image-registry doc) src #f))] [(and (string? src) (hash-ref (pdf-image-registry doc) src #f))]
[(and ($img? src) ($img-width src) ($img-height src)) src] [(and ($img? src) ($img-width src) ($img-height src)) src]
[else (open-image doc src)])) [else (open-image doc src)]))
(unless ($img-ref image) (($img-embed-proc image) image)) (unless ($img-ref image) (($img-embed-proc image) image))
@ -93,7 +93,7 @@
[("bottom") (set! y (+ y bh - h))])) [("bottom") (set! y (+ y bh - h))]))
;; Set the current y position to below the image if it is in the document flow ;; Set the current y position to below the image if it is in the document flow
(when (= ($doc-y doc) y) (set! y (+ y h))) (when (= (pdf-y doc) y) (set! y (+ y h)))
(save doc) (save doc)
(transform doc w 0 0 (- h) x (+ y h)) (transform doc w 0 0 (- h) x (+ y h))
(add-content doc (format "/~a Do" ($img-label image))) (add-content doc (format "/~a Do" ($img-label image)))
@ -102,11 +102,11 @@
(define (open-image doc src) (define (open-image doc src)
(cond (cond
[(and (string? src) (hash-ref ($doc-image-registry doc) src #f))] [(and (string? src) (hash-ref (pdf-image-registry doc) src #f))]
[else [else
(define image-idx (add1 (length (hash-keys ($doc-image-registry doc))))) (define image-idx (add1 (length (hash-keys (pdf-image-registry doc)))))
(define image-id (string->symbol (format "I~a" image-idx))) (define image-id (string->symbol (format "I~a" image-idx)))
(define new-image (open-pdf-image src image-id)) (define new-image (open-pdf-image src image-id))
(when (string? src) (hash-set! ($doc-image-registry doc) src new-image)) (when (string? src) (hash-set! (pdf-image-registry doc) src new-image))
new-image])) new-image]))

4
pitfall/pitfall/main.rkt
Unescape Escape View File

@ -1,3 +1,3 @@
#lang racket/base #lang racket/base
(require "document.rkt") (require "pdf.rkt")
(provide (all-from-out "document.rkt")) (provide (all-from-out "pdf.rkt"))

2
pitfall/pitfall/page-test.rkt
Unescape Escape View File

@ -2,7 +2,7 @@
(require racket/class (require racket/class
rackunit rackunit
racket/dict racket/dict
"document.rkt" "pdf.rkt"
"page.rkt" "page.rkt"
"reference.rkt" "reference.rkt"
"core.rkt" "core.rkt"

2
pitfall/pitfall/page.rkt
Unescape Escape View File

@ -8,7 +8,7 @@
(provide (all-defined-out)) (provide (all-defined-out))
(define (current-page doc) (car ($doc-pages doc))) (define (current-page doc) (car (pdf-pages doc)))
(define (add-content doc data) (define (add-content doc data)
(page-write (current-page doc) data)) (page-write (current-page doc) data))

42
pitfall/pitfall/document.rkt → pitfall/pitfall/pdf.rkt
Unescape Escape View File

@ -14,9 +14,9 @@
(provide (all-defined-out)) (provide (all-defined-out))
(define (store-ref doc ref) (define (store-ref doc ref)
(set-$doc-refs! doc (cons ref ($doc-refs doc)))) (set-pdf-refs! doc (cons ref (pdf-refs doc))))
(define (make-$doc [options (make-hasheq)]) (define (make-pdf [options (make-hasheq)])
;; initial values ;; initial values
(define pages null) (define pages null)
@ -39,7 +39,7 @@
(define x 0) (define x 0)
(define y 0) (define y 0)
(define image-registry (make-hash)) (define image-registry (make-hash))
(define new-doc ($doc options (define new-doc (pdf options
pages pages
refs refs
'dummy-root-value-that-will-be-replaced-below 'dummy-root-value-that-will-be-replaced-below
@ -60,7 +60,7 @@
(set-current-ref-id! 1) (set-current-ref-id! 1)
(reset-annotations-cache!) (reset-annotations-cache!)
(register-ref-listener (λ (ref) (store-ref new-doc ref))) (register-ref-listener (λ (ref) (store-ref new-doc ref)))
(set-$doc-root! new-doc (make-ref (mhasheq 'Type 'Catalog (set-pdf-root! new-doc (make-ref (mhasheq 'Type 'Catalog
'Pages (make-ref (mhasheq 'Type 'Pages))))) 'Pages (make-ref (mhasheq 'Type 'Pages)))))
;; initialize params ;; initialize params
@ -71,17 +71,17 @@
new-doc) new-doc)
(define (add-page doc [options-arg ($doc-options doc)]) (define (add-page doc [options-arg (pdf-options doc)])
;; create a page object ;; create a page object
(define page-parent (dict-ref ($doc-root doc) 'Pages)) (define page-parent (dict-ref (pdf-root doc) 'Pages))
(set-$doc-pages! doc (cons (make-page page-parent options-arg) ($doc-pages doc))) (set-pdf-pages! doc (cons (make-page page-parent options-arg) (pdf-pages doc)))
;; reset x and y coordinates ;; reset x and y coordinates
(set-$doc-x! doc (margin-left ($page-margins (current-page doc)))) (set-pdf-x! doc (margin-left ($page-margins (current-page doc))))
(set-$doc-y! doc (margin-right ($page-margins (current-page doc)))) (set-pdf-y! doc (margin-right ($page-margins (current-page doc))))
;; 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-$doc-ctm! doc default-ctm-value) (set-pdf-ctm! doc default-ctm-value)
(transform doc 1 0 0 -1 0 ($page-height (current-page doc))) (transform doc 1 0 0 -1 0 ($page-height (current-page doc)))
doc) doc)
@ -90,36 +90,36 @@
(write-bytes-out "%ÿÿÿÿ")) (write-bytes-out "%ÿÿÿÿ"))
(define (end-doc doc) (define (end-doc doc)
(for-each page-end ($doc-pages doc)) (for-each page-end (pdf-pages doc))
(define doc-info (make-ref ($doc-info doc))) (define doc-info (make-ref (pdf-info doc)))
(ref-end doc-info) (ref-end doc-info)
(for ([font (in-hash-values ($doc-font-families doc))]) (for ([font (in-hash-values (pdf-font-families doc))])
(send font font-end)) (send font font-end))
(define pages-ref (dict-ref ($doc-root doc) 'Pages)) (define pages-ref (dict-ref (pdf-root doc) 'Pages))
(dict-set! pages-ref 'Count (length ($doc-pages doc))) (dict-set! pages-ref 'Count (length (pdf-pages doc)))
(dict-set! pages-ref 'Kids (map $page-ref (reverse ($doc-pages doc)))) (dict-set! pages-ref 'Kids (map $page-ref (reverse (pdf-pages doc))))
(ref-end pages-ref) (ref-end pages-ref)
(ref-end ($doc-root doc)) (ref-end (pdf-root doc))
(define xref-offset (file-position (current-output-port))) (define xref-offset (file-position (current-output-port)))
(write-bytes-out "xref") (write-bytes-out "xref")
(define xref-count (add1 (length ($doc-refs doc)))) (define xref-count (add1 (length (pdf-refs doc))))
(write-bytes-out (format "0 ~a" xref-count)) (write-bytes-out (format "0 ~a" xref-count))
(write-bytes-out "0000000000 65535 f ") (write-bytes-out "0000000000 65535 f ")
(for ([ref (in-list (reverse ($doc-refs doc)))]) (for ([ref (in-list (reverse (pdf-refs doc)))])
(write-bytes-out (write-bytes-out
(string-append (~r ($ref-offset ref) #:min-width 10 #:pad-string "0") " 00000 n "))) (string-append (~r ($ref-offset ref) #:min-width 10 #:pad-string "0") " 00000 n ")))
(write-bytes-out "trailer") (write-bytes-out "trailer")
(write-bytes-out (convert (mhasheq 'Size xref-count (write-bytes-out (convert (mhasheq 'Size xref-count
'Root ($doc-root doc) 'Root (pdf-root doc)
'Info doc-info))) 'Info doc-info)))
(write-bytes-out "startxref") (write-bytes-out "startxref")
(write-bytes-out (numberizer xref-offset)) (write-bytes-out (numberizer xref-offset))
(write-bytes-out "%%EOF")) (write-bytes-out "%%EOF"))
(module+ test (module+ test
(define d (make-$doc))) (define d (make-pdf)))

6
pitfall/pitfall/pdftest.rkt
Unescape Escape View File

@ -11,8 +11,8 @@
(test-mode #t) (test-mode #t)
(require rackunit pitfall/document pitfall/vector pitfall/color pitfall/text pitfall/font pitfall/image racket/runtime-path racket/class) (require rackunit pitfall/pdf pitfall/vector pitfall/color pitfall/text pitfall/font pitfall/image racket/runtime-path racket/class)
(provide (all-from-out rackunit racket/runtime-path pitfall/document pitfall/vector pitfall/text pitfall/color pitfall/font pitfall/image racket/class)) (provide (all-from-out rackunit racket/runtime-path pitfall/pdf pitfall/vector pitfall/text pitfall/color pitfall/font pitfall/image racket/class))
(define (this->control this) (path-add-extension this #"" #" copy.")) (define (this->control this) (path-add-extension this #"" #" copy."))
@ -37,7 +37,7 @@
(time (time
(with-output-to-file ps (with-output-to-file ps
(λ () (λ ()
(define doc (make-$doc (hash 'compress compress?))) (define doc (make-pdf (hash 'compress compress?)))
(start-doc doc) (start-doc doc)
(proc doc) (proc doc)
(end-doc doc)) (end-doc doc))

28
pitfall/pitfall/text.rkt
Unescape Escape View File

@ -21,8 +21,8 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
|# |#
(define (text doc str [x #f] [y #f] [options (mhash)]) (define (text doc str [x #f] [y #f] [options (mhash)])
(when x (set-$doc-x! doc x)) (when x (set-pdf-x! doc x))
(when y (set-$doc-y! doc y)) (when y (set-pdf-y! doc y))
(line doc str options) (line doc str options)
doc) doc)
@ -44,9 +44,9 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
(when (or (hash-ref options 'underline #f) (hash-ref options 'strike #f)) (when (or (hash-ref options 'underline #f) (hash-ref options 'strike #f))
(save doc) (save doc)
(unless (hash-ref options 'stroke #f) (unless (hash-ref options 'stroke #f)
(define fill-color-args ($doc-current-fill-color doc)) (define fill-color-args (pdf-current-fill-color doc))
(apply stroke-color doc fill-color-args)) (apply stroke-color doc fill-color-args))
(define new-line-width (if (< ($doc-current-font-size doc) 10) 0.5 (floor (/ ($doc-current-font-size doc) 10)))) (define new-line-width (if (< (pdf-current-font-size doc) 10) 0.5 (floor (/ (pdf-current-font-size doc) 10))))
(line-width doc new-line-width) (line-width doc new-line-width)
(define d (if (hash-ref options 'underline) 1 2)) (define d (if (hash-ref options 'underline) 1 2))
(define line-y (+ y-in (/ (current-line-height doc) d))) (define line-y (+ y-in (/ (current-line-height doc) d)))
@ -63,17 +63,17 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
(transform doc 1 0 0 -1 0 page-height) (transform doc 1 0 0 -1 0 page-height)
(define y (- page-height (define y (- page-height
y-in y-in
(* (/ (get-field ascender ($doc-current-font doc)) 1000) (* (/ (get-field ascender (pdf-current-font doc)) 1000)
($doc-current-font-size doc)))) (pdf-current-font-size doc))))
;; add current font to page if necessary ;; add current font to page if necessary
(define current-font-id (get-field id ($doc-current-font doc))) (define current-font-id (get-field id (pdf-current-font doc)))
(hash-ref! (page-fonts (current-page doc)) current-font-id (λ () (send ($doc-current-font doc) make-font-ref))) (hash-ref! (page-fonts (current-page doc)) current-font-id (λ () (send (pdf-current-font doc) make-font-ref)))
(add-content doc "BT") ; begin the text object (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 (add-content doc (format "1 0 0 1 ~a ~a Tm" (numberizer x) (numberizer y))) ; text position
(add-content doc (format "/~a ~a Tf" current-font-id (add-content doc (format "/~a ~a Tf" current-font-id
(numberizer ($doc-current-font-size doc)))) ; font and font size (numberizer (pdf-current-font-size doc)))) ; font and font size
(let ([mode (+ (if (hash-ref options 'fill #f) 1 0) (if (hash-ref options 'stroke #f) 1 0))]) (let ([mode (+ (if (hash-ref options 'fill #f) 1 0) (if (hash-ref options 'stroke #f) 1 0))])
(when (and mode (not (zero? mode))) (when (and mode (not (zero? mode)))
(add-content doc (format "~a Tr" mode)))) (add-content doc (format "~a Tr" mode))))
@ -82,9 +82,9 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
;; Add the actual text ;; Add the actual text
(match-define (list encoded-char-strs positions) (match-define (list encoded-char-strs positions)
(send ($doc-current-font doc) encode text (hash-ref options 'features ($doc-current-font-features doc)))) (send (pdf-current-font doc) encode text (hash-ref options 'features (pdf-current-font-features doc))))
(define scale (/ ($doc-current-font-size doc) 1000.0)) (define scale (/ (pdf-current-font-size doc) 1000.0))
(define commands empty) (define commands empty)
;; Adds a segment of text to the TJ command buffer ;; Adds a segment of text to the TJ command buffer
@ -133,11 +133,11 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee
(restore doc)) ; restore flipped coordinate system (restore doc)) ; restore flipped coordinate system
(define (line doc str [options (mhasheq)]) (define (line doc str [options (mhasheq)])
(fragment doc str ($doc-x doc) ($doc-y doc) options) (fragment doc str (pdf-x doc) (pdf-y doc) options)
;; 181224 unsuppress size tracking in test mode to preserve test 04 ;; 181224 unsuppress size tracking in test mode to preserve test 04
;; otherwise we'll be doing our own line measurement ;; otherwise we'll be doing our own line measurement
(when (test-mode) (set-$doc-x! doc (+ ($doc-x doc) (string-width doc str))))) (when (test-mode) (set-pdf-x! doc (+ (pdf-x doc) (string-width doc str)))))
(define (string-width doc str [options (mhash)]) (define (string-width doc str [options (mhash)])
(+ (send ($doc-current-font doc) string-width str ($doc-current-font-size doc) (hash-ref options 'features ($doc-current-font-features doc))) (+ (send (pdf-current-font doc) string-width str (pdf-current-font-size doc) (hash-ref options 'features (pdf-current-font-features doc)))
(* (hash-ref options 'characterSpacing 0) (sub1 (string-length str))))) (* (hash-ref options 'characterSpacing 0) (sub1 (string-length str)))))

20
pitfall/pitfall/vector.rkt
Unescape Escape View File

@ -15,15 +15,15 @@
(define default-ctm-value '(1 0 0 1 0 0)) (define default-ctm-value '(1 0 0 1 0 0))
(define (save doc) (define (save doc)
(set-$doc-ctm-stack! doc (cons ($doc-ctm doc) ($doc-ctm-stack doc))) (set-pdf-ctm-stack! doc (cons (pdf-ctm doc) (pdf-ctm-stack doc)))
(add-content doc "q")) (add-content doc "q"))
(define (restore doc) (define (restore doc)
(set-$doc-ctm! doc (set-pdf-ctm! doc
(if (pair? ($doc-ctm-stack doc)) (if (pair? (pdf-ctm-stack doc))
(begin0 (begin0
(car ($doc-ctm-stack doc)) (car (pdf-ctm-stack doc))
(set-$doc-ctm-stack! doc (cdr ($doc-ctm-stack doc)))) (set-pdf-ctm-stack! doc (cdr (pdf-ctm-stack doc))))
default-ctm-value)) default-ctm-value))
(add-content doc "Q")) (add-content doc "Q"))
@ -125,10 +125,10 @@
(define scale (define scale
(match-lambda* (match-lambda*
[(list (? $doc? doc) (? number? x-factor)) (scale doc x-factor (mhash))] [(list (? pdf? doc) (? number? x-factor)) (scale doc x-factor (mhash))]
[(list (? $doc? doc) (? number? xFactor) (? hash? options)) (scale doc xFactor xFactor options)] [(list (? pdf? doc) (? number? xFactor) (? hash? options)) (scale doc xFactor xFactor options)]
[(list (? $doc? doc) (? number? xFactor) (? number? yFactor)) (scale doc xFactor yFactor (mhash))] [(list (? pdf? doc) (? number? xFactor) (? number? yFactor)) (scale doc xFactor yFactor (mhash))]
[(list (? $doc? doc) (? number? xFactor) (? number? yFactor) (? hash? options)) [(list (? pdf? doc) (? number? xFactor) (? number? yFactor) (? hash? options))
(match-define (list x y) (match-define (list x y)
(match-let ([(list xo yo) (hash-ref options 'origin '(0 0))]) (match-let ([(list xo yo) (hash-ref options 'origin '(0 0))])
(list (* xo (- 1 xFactor)) (* yo (- 1 yFactor))))) (list (* xo (- 1 xFactor)) (* yo (- 1 yFactor)))))
@ -143,7 +143,7 @@
(define (transform doc scaleX shearY shearX scaleY mdx mdy) (define (transform doc scaleX shearY shearX scaleY mdx mdy)
(define new-ctm (list scaleX shearY shearX scaleY mdx mdy)) (define new-ctm (list scaleX shearY shearX scaleY mdx mdy))
(set-$doc-ctm! doc (combine-transforms ($doc-ctm doc) new-ctm)) (set-pdf-ctm! doc (combine-transforms (pdf-ctm doc) new-ctm))
(add-content doc (make-transform-string new-ctm))) (add-content doc (make-transform-string new-ctm)))
(define (translate doc x y) (define (translate doc x y)

Write Preview
Loading…
Cancel
Save