From 85ec995c9dd5e2a973c16d699ac5ab3ab4c2b871 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 26 Dec 2018 14:22:40 -0800 Subject: [PATCH] step19 --- pitfall/pitfall/fonts.rkt | 62 +---------- pitfall/pitfall/path.rkt | 86 --------------- pitfall/pitfall/pdftest.rkt | 2 +- pitfall/pitfall/text.rkt | 10 +- pitfall/pitfall/vector.rkt | 205 ++++++++++++++++++------------------ pitfall/ptest/test10.rkt | 12 +-- pitfall/ptest/test11.rkt | 15 ++- pitfall/ptest/test12.rkt | 13 ++- pitfall/ptest/test13.rkt | 9 +- pitfall/ptest/test14.rkt | 9 +- pitfall/ptest/test15.rkt | 9 +- pitfall/ptest/test16.rkt | 9 +- pitfall/ptest/test17.rkt | 9 +- pitfall/ptest/test18.rkt | 17 ++- pitfall/ptest/test19.rkt | 11 +- pitfall/ptest/test6.rkt | 23 ++-- pitfall/ptest/test7.rkt | 9 +- pitfall/ptest/test8.rkt | 9 +- pitfall/ptest/test9.rkt | 20 ++-- 19 files changed, 191 insertions(+), 348 deletions(-) delete mode 100644 pitfall/pitfall/path.rkt diff --git a/pitfall/pitfall/fonts.rkt b/pitfall/pitfall/fonts.rkt index b41f1636..47b995e4 100644 --- a/pitfall/pitfall/fonts.rkt +++ b/pitfall/pitfall/fonts.rkt @@ -8,7 +8,7 @@ (provide (all-defined-out)) (define (current-line-height doc [include-gap #f]) - (send ($doc-current-font doc) line-height ($doc-current-font-size doc) include-gap)) + (send ($doc-current-font doc) line-height ($doc-current-font-size doc) include-gap)) (define (font doc src [size-or-family #f] [maybe-size #f]) (match-define (list family size) @@ -47,59 +47,7 @@ (set-$doc-current-font-size! doc size) doc) -(define (fonts-mixin [% object%]) - (class % - (super-new) - (field [@font-families (make-hash)] - [@font-count 0] - [(@current-font-size current-font-size) 12] ; font state used by text.rkt - [(@current-font current-font) #f] ; font state used by text.rkt - [@registered-fonts (make-hash)]) - - (define/public (font src [size-or-family #f] [maybe-size #f]) - (match-define (list family size) - (match size-or-family - [(? number?) (list #f size-or-family)] - [_ (list size-or-family maybe-size)])) - ;; check registered fonts if src is a string - (define cache-key - (match src - [(? string?) #:when (hash-has-key? @registered-fonts src) - (define ck src) - (set! src (hash-ref (hash-ref @registered-fonts ck) 'src)) - (set! family (hash-ref (hash-ref @registered-fonts ck) 'family)) - ck] - [_ (match (or family src) - [(? string? str) str] - [_ #false])])) - - (when size (font-size size)) - - (match (hash-ref @font-families cache-key #f) ; check if the font is already in the PDF - [(? values val) (set! @current-font val)] - [_ ; if not, load the font - (set! @font-count (add1 @font-count)) - (define id (string->symbol (format "F~a" @font-count))) - (set! @current-font (PDFFont-open src family id)) - ;; check for existing font families with the same name already in the PDF - (match (hash-ref @font-families (get-field name @current-font) #f) - [(? values font) (set! @current-font font)] - [_ ;; save the font for reuse later - (when cache-key (hash-set! @font-families cache-key @current-font)) - (hash-set! @font-families (get-field name @current-font) @current-font)])]) - this) - - (define/public (font-size size) - (set! @current-font-size size) - this) - - - - (define/public (register-font name src [family #f]) - (hash-set! @registered-fonts name (make-hash (list (cons 'src src) - (cons 'family family)))) - this))) - - -(module+ test - (define fo (new (fonts-mixin)))) +(define (register-font doc name src [family #f]) + (hash-set! ($doc-registered-fonts doc) name (make-hash (list (cons 'src src) + (cons 'family family)))) + doc) diff --git a/pitfall/pitfall/path.rkt b/pitfall/pitfall/path.rkt deleted file mode 100644 index 5a98c5c6..00000000 --- a/pitfall/pitfall/path.rkt +++ /dev/null @@ -1,86 +0,0 @@ -#lang racket/base -(require - racket/class - racket/match - racket/list - brag/support - sugar/list) -(provide parse-svg-path) - -(define (parse-svg-path doc path) - (define commands (parse path)) - (apply-commands commands doc)) - -(define (parse path) - (define lex-1 - (lexer - [(eof) eof] - [alphabetic (string->symbol lexeme)] - [(:: (:? "-") (:* numeric) (:? ".") (:+ numeric)) (string->number lexeme)] - [(:or whitespace ",") (lex-1 input-port)])) - (slicef-at (for/list ([tok (in-port lex-1 (open-input-string path))]) - tok) symbol?)) - -(module+ test - (require rackunit) - (check-equal? - (parse "M 0,20 L 100,160 Q 130,200 150,120 C 190,-40 200,200 300,150 L 400,90") - '((M 0 20) - (L 100 160) - (Q 130 200 150 120) - (C 190 -40 200 200 300 150) - (L 400 90))) - - (check-equal? - (parse "M-122.304 84.285C-122.304 84.285 -122.203 86.179 -123.027 86.16C-123.851 86.141 -140.305 38.066 -160.833 40.309C-160.833 40.309 -143.05 32.956 -122.304 84.285z") - '((M -122.304 84.285) - (C -122.304 84.285 -122.203 86.179 -123.027 86.16) - (C -123.851 86.141 -140.305 38.066 -160.833 40.309) - (C -160.833 40.309 -143.05 32.956 -122.304 84.285) - (z))) - - (check-equal? (parse "L100-160") '((L 100 -160)))) - -(define (apply-commands commands doc) - (for/fold ([cx 0][cy 0][px 0][py 0][sx 0][sy 0]) - ([cmd (in-list commands)]) - (match-define (cons cmd-name cmd-args) cmd) - (let loop ([cmd-name cmd-name][cmd-args cmd-args]) - (match-define (list a0 a1 a2 a3 a4 a5) - (append cmd-args (make-list (- 6 (length cmd-args)) #f))) - (case cmd-name - [(M) (send doc move-to . cmd-args) - (values a0 a1 #f #f a0 a1)] - [(m) (loop 'M (list (+ cx a0) (+ cy a1)))] - [(C) (send doc bezier-curve-to . cmd-args) - (values a4 a5 a2 a3 sx sy)] - [(c) (loop 'C (list (+ cx a0) (+ cy a1) - (+ cx a2) (+ cy a3) - (+ cx a4) (+ cy a5)))] - [(S) (match-let ([(list px py) (if (not px) - (list cx cy) - (list px py))]) - (send doc bezierCurveyTo (- cx (- px cx)) (- cy (- py cy)) a0 a1 a2 a3) - (values a2 a3 a0 a1 sx sy))] - [(s) (loop 'S (list (+ cx a0) (+ cy a1) - (+ cx a2) (+ cy a3)))] - [(L) (send doc line-to . cmd-args) - (values a0 a1 #f #f sx sy)] - [(l) (loop 'L (list (+ cx a0) (+ cy a1)))] - [(H) (loop 'L (list a0 cy))] - [(h) (loop 'L (list (+ cx a0) cy))] - [(V) (loop 'L (list cx a0))] - [(v) (loop 'L (list cx (+ cy a0)))] - [(Q) (send doc quadratic-curve-to . cmd-args) - (values a2 a3 a0 a1 sx sy)] - [(q) (loop 'Q (list (+ cx a0) (+ cy a1) - (+ cx a2) (+ cy a3)))] - [(T) (match-define (list px py) - (if (not px) - (list cx py) - (list (- cx (- px cx) (- cy (- py cy)))))) - (send doc quadratic-curve-to . cmd-args)] - ;; todo other path ops - [(z) (send doc close-path . cmd-args) - (values sx sy px py sx sy)] - [else (raise-argument-error 'apply-commands "valid command name" cmd-name)])))) \ No newline at end of file diff --git a/pitfall/pitfall/pdftest.rkt b/pitfall/pitfall/pdftest.rkt index f0ead9da..9d395482 100644 --- a/pitfall/pitfall/pdftest.rkt +++ b/pitfall/pitfall/pdftest.rkt @@ -12,7 +12,7 @@ (test-mode #t) (require rackunit pitfall/document pitfall/vector pitfall/color pitfall/text pitfall/fonts pitfall/images racket/runtime-path racket/class) -(provide (all-from-out rackunit racket/runtime-path pitfall/document pitfall/vector pitfall/text pitfall/fonts pitfall/images pitfall/color racket/class)) +(provide (all-from-out rackunit racket/runtime-path pitfall/document pitfall/vector pitfall/text pitfall/color pitfall/fonts pitfall/images racket/class)) (define (this->control this) (path-add-extension this #"" #" copy.")) diff --git a/pitfall/pitfall/text.rkt b/pitfall/pitfall/text.rkt index 2e3183b7..166c21b9 100644 --- a/pitfall/pitfall/text.rkt +++ b/pitfall/pitfall/text.rkt @@ -49,14 +49,14 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/mixins/text.coffee (define fill-color-args ($doc-current-fill-color doc)) (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)))) - (line-width new-line-width) + (line-width doc new-line-width) (define d (if (hash-ref options 'underline) 1 2)) - (define line-y (+ y-in (/ (current-line-height) d))) + (define line-y (+ y-in (/ (current-line-height doc) d))) (when (hash-ref options 'underline) (set! line-y (+ line-y (- new-line-width)))) - (move-to x line-y) - (line-to (+ x (force rendered-width)) line-y) - (stroke) + (move-to doc x line-y) + (line-to doc (+ x (force rendered-width)) line-y) + (stroke doc) (restore doc)) ;; flip coordinate system diff --git a/pitfall/pitfall/vector.rkt b/pitfall/pitfall/vector.rkt index 9852c983..99b55ea8 100644 --- a/pitfall/pitfall/vector.rkt +++ b/pitfall/pitfall/vector.rkt @@ -10,7 +10,9 @@ sugar/unstable/class sugar/unstable/js sugar/unstable/dict - "path.rkt") + brag/support + sugar/list + racket/list) (provide (all-defined-out)) (define default-ctm-value '(1 0 0 1 0 0)) @@ -34,6 +36,9 @@ (define (circle doc x y radius) (ellipse doc x y radius)) +(define (clip doc [rule #f]) + (add-content doc (string-append "W" (winding-rule rule) " n"))) + (define (close-path doc) (add-content doc "h")) @@ -100,6 +105,10 @@ (define (move-to doc x y) (add-content doc (format "~a ~a m" x y))) +(define (path doc path-data) + (parse-svg-path doc path-data) + doc) + (define (polygon doc . points) (match points [(cons (list x y) other-points) @@ -117,6 +126,17 @@ (define (rect doc x y w h) (add-content doc (format "~a re" (string-join (map numberizer (list x y w h)) " ")))) +(define scale + (match-lambda* + [(list (? $doc? doc) (? number? x-factor)) (scale doc x-factor (mhash))] + [(list (? $doc? doc) (? number? xFactor) (? hash? options)) (scale doc xFactor xFactor options)] + [(list (? $doc? doc) (? number? xFactor) (? number? yFactor)) (scale doc xFactor yFactor (mhash))] + [(list (? $doc? doc) (? number? xFactor) (? number? yFactor) (? hash? options)) + (match-define (list x y) + (match-let ([(list xo yo) (hash-ref options 'origin '(0 0))]) + (list (* xo (- 1 xFactor)) (* yo (- 1 yFactor))))) + (transform doc xFactor 0 0 yFactor x y)])) + (define (shear doc x y) (transform doc 1 y x 1 0 0)) @@ -135,109 +155,6 @@ (define (winding-rule rule) (if (and (string? rule) (regexp-match #rx"^even-?odd$" rule)) "*" "")) - -#;(define (vector-mixin [% mixin-tester%]) - (class % - (super-new) - (field [@ctm default-ctm-value] - [@ctm-stack null]) - (inherit add-content) ; from base - (inherit stroke-color fill-color) ; from color - - (define/public (save) - (set! @ctm-stack (cons @ctm @ctm-stack)) - (add-content "q")) - - (define/public (restore) - (set! @ctm (if (pair? @ctm-stack) - (begin0 - (car @ctm-stack) - (set! @ctm-stack (cdr @ctm-stack))) - default-ctm-value)) - (add-content "Q")) - - (define/public (close-path) - (add-content "h")) - - - - - - (define/public (move-to x y) - (add-content (format "~a ~a m" x y))) - - (define/public (line-to x y) - (add-content (format "~a ~a l" x y))) - - (define/public (bezier-curve-to cp1x cp1y cp2x cp2y x y) - (add-content (format "~a c" (string-join (map numberizer (list cp1x cp1y cp2x cp2y x y)) " ")))) - - (define/public (quadratic-curve-to cpx cpy x y) - (add-content (format "~a v" (string-join (map numberizer (list cpx cpy x y)) " ")))) - - - - (define/public (ellipse x y r1 [r2 r1]) - ;; based on http://stackoverflow.com/questions/2172798/how-to-draw-an-oval-in-html5-canvas/2173084#2173084 - ;; This constant is used to approximate a symmetrical arc using a cubic Bezier curve. - (define kappa (* 4 (/ (- (sqrt 2) 1) 3.0))) - (-= x r1) - (-= y r2) - (define ox (* r1 kappa)) ; control point offset horizontal - (define oy (* r2 kappa)) ; control point offset vertical - (define xe (+ x (* r1 2))) ; x-end - (define ye (+ y (* r2 2))) ; y-end - (define xm (+ x r1)) ; x-middle - (define ym (+ y r2)) ; y-middle - (move-to x ym) - (bezier-curve-to x (- ym oy) (- xm ox) y xm y) - (bezier-curve-to (+ xm ox) y xe (- ym oy) xe ym) - (bezier-curve-to xe (+ ym oy) (+ xm ox) ye xm ye) - (bezier-curve-to (- xm ox) ye x (+ ym oy) x ym) - (close-path)) - - (define/public (circle x y radius) - (ellipse x y radius)) - - - - (define/public (path path-data) - (parse-svg-path this path-data) - this) - - (define/public (_windingRule rule) - (if (and (string? rule) (regexp-match #rx"^even-?odd$" rule)) "*" "")) - - (define/public (fill [color #f] #:rule [rule #f]) - (when color (fill-color color)) ;; fill-color method is from color mixin - (add-content (format "f~a" (_windingRule rule)))) - - (define/public (stroke [color #f]) - (when color (stroke-color color)) - (add-content "S")) - - - - (define tm/c (list/c number? number? number? number? number? number?)) - (define/public (make-transform-string ctm) - (format "~a cm" (string-join (map numberizer ctm) " "))) - - (define/public (clip [rule #f]) - (add-content (string-append "W" (_windingRule rule) " n"))) - - - - (define/public scale - (match-lambda* - [(list (? object? this) (? number? x-factor)) (scale x-factor (mhash))] - [(list (? object? this) (? number? xFactor) (? hash? options)) (scale xFactor xFactor options)] - [(list (? object? this) (? number? xFactor) (? number? yFactor)) (scale this xFactor yFactor (mhash))] - [(list (? object? this) (? number? xFactor) (? number? yFactor) (? hash? options)) - (match-define (list x y) - (match-let ([(list xo yo) (hash-ref options 'origin '(0 0))]) - (list (* xo (- 1 xFactor)) (* yo (- 1 yFactor))))) - (transform xFactor 0 0 yFactor x y)])))) - (define (combine-transforms m new-ctm) (match-define (list m0 m1 m2 m3 m4 m5) m) (match-define (list m11 m12 m21 m22 dx dy) new-ctm) @@ -264,4 +181,82 @@ (check-equal? (combine-transforms '(1 0 0 -1 0 792.0) '(1 0 0 1 50 50)) '(1 0 0 -1 50 742.0)) (check-equal? (combine-transforms '(1 0 0 -1 50 742.0) '(1 0 0 -1 0 792)) - '(1 0 0 1 50 -50.0))) \ No newline at end of file + '(1 0 0 1 50 -50.0))) + +(define (parse-svg-path doc path) + (define commands (parse path)) + (apply-commands commands doc)) + +(define (parse path) + (define lex-1 + (lexer + [(eof) eof] + [alphabetic (string->symbol lexeme)] + [(:: (:? "-") (:* numeric) (:? ".") (:+ numeric)) (string->number lexeme)] + [(:or whitespace ",") (lex-1 input-port)])) + (slicef-at (for/list ([tok (in-port lex-1 (open-input-string path))]) + tok) symbol?)) + +(module+ test + (require rackunit) + (check-equal? + (parse "M 0,20 L 100,160 Q 130,200 150,120 C 190,-40 200,200 300,150 L 400,90") + '((M 0 20) + (L 100 160) + (Q 130 200 150 120) + (C 190 -40 200 200 300 150) + (L 400 90))) + + (check-equal? + (parse "M-122.304 84.285C-122.304 84.285 -122.203 86.179 -123.027 86.16C-123.851 86.141 -140.305 38.066 -160.833 40.309C-160.833 40.309 -143.05 32.956 -122.304 84.285z") + '((M -122.304 84.285) + (C -122.304 84.285 -122.203 86.179 -123.027 86.16) + (C -123.851 86.141 -140.305 38.066 -160.833 40.309) + (C -160.833 40.309 -143.05 32.956 -122.304 84.285) + (z))) + + (check-equal? (parse "L100-160") '((L 100 -160)))) + +(define (apply-commands commands doc) + (for/fold ([cx 0][cy 0][px 0][py 0][sx 0][sy 0]) + ([cmd (in-list commands)]) + (match-define (cons cmd-name cmd-args) cmd) + (let loop ([cmd-name cmd-name][cmd-args cmd-args]) + (match-define (list a0 a1 a2 a3 a4 a5) + (append cmd-args (make-list (- 6 (length cmd-args)) #f))) + (case cmd-name + [(M) (apply move-to doc cmd-args) + (values a0 a1 #f #f a0 a1)] + [(m) (loop 'M (list (+ cx a0) (+ cy a1)))] + [(C) (apply bezier-curve-to doc cmd-args) + (values a4 a5 a2 a3 sx sy)] + [(c) (loop 'C (list (+ cx a0) (+ cy a1) + (+ cx a2) (+ cy a3) + (+ cx a4) (+ cy a5)))] + [(S) (match-let ([(list px py) (if (not px) + (list cx cy) + (list px py))]) + (apply bezier-curve-to doc (- cx (- px cx)) (- cy (- py cy)) a0 a1 a2 a3) + (values a2 a3 a0 a1 sx sy))] + [(s) (loop 'S (list (+ cx a0) (+ cy a1) + (+ cx a2) (+ cy a3)))] + [(L) (apply line-to doc cmd-args) + (values a0 a1 #f #f sx sy)] + [(l) (loop 'L (list (+ cx a0) (+ cy a1)))] + [(H) (loop 'L (list a0 cy))] + [(h) (loop 'L (list (+ cx a0) cy))] + [(V) (loop 'L (list cx a0))] + [(v) (loop 'L (list cx (+ cy a0)))] + [(Q) (apply quadratic-curve-to doc cmd-args) + (values a2 a3 a0 a1 sx sy)] + [(q) (loop 'Q (list (+ cx a0) (+ cy a1) + (+ cx a2) (+ cy a3)))] + [(T) (match-define (list px py) + (if (not px) + (list cx py) + (list (- cx (- px cx) (- cy (- py cy)))))) + (apply quadratic-curve-to doc cmd-args)] + ;; todo other path ops + [(z) (apply close-path doc cmd-args) + (values sx sy px py sx sy)] + [else (raise-argument-error 'apply-commands "valid command name" cmd-name)])))) \ No newline at end of file diff --git a/pitfall/ptest/test10.rkt b/pitfall/ptest/test10.rkt index a0f5a335..c7756a5d 100644 --- a/pitfall/ptest/test10.rkt +++ b/pitfall/ptest/test10.rkt @@ -4,22 +4,22 @@ (define-runtime-path tiger "assets/tiger.json") (define (proc doc) - (send doc translate 220 300) + (translate doc 220 300) (for* ([datum (in-list (read (open-input-string (string-replace (file->string tiger) #rx"[,:]" " "))))] [part (in-value (apply hash datum))]) - (send doc path (hash-ref part 'path)) + (path doc (hash-ref part 'path)) (when (hash-has-key? part "stroke-width") - (send doc line-width (string->number (hash-ref part "stroke-width")))) + (line-width doc (string->number (hash-ref part "stroke-width")))) (if (and (not (string=? (hash-ref part 'fill "none") "none")) (not (string=? (hash-ref part 'stroke "none") "none"))) - (send doc fill-and-stroke (hash-ref part 'fill) (hash-ref part 'stroke)) + (fill-and-stroke doc (hash-ref part 'fill) (hash-ref part 'stroke)) (begin (unless (string=? (hash-ref part 'fill "none") "none") - (send doc fill (hash-ref part 'fill))) + (fill doc (hash-ref part 'fill))) (unless (string=? (hash-ref part 'stroke "none") "none") - (send doc fill (hash-ref part 'stroke))))))) + (fill doc (hash-ref part 'stroke))))))) (define-runtime-path this "test10rkt.pdf") (make-doc this #f proc) diff --git a/pitfall/ptest/test11.rkt b/pitfall/ptest/test11.rkt index fed03773..60780287 100644 --- a/pitfall/ptest/test11.rkt +++ b/pitfall/ptest/test11.rkt @@ -2,14 +2,13 @@ (require pitfall/pdftest) (define (proc doc) - (send* doc - [fill-color "blue"] - [font "Helvetica" 30] - [translate 50 50] - [text "Here is a link!" 100 100 (hash - 'link "http://google.com/" - 'underline #t - 'width #f)])) + [fill-color doc "blue"] + [font doc "Helvetica" 30] + [translate doc 50 50] + [text doc "Here is a link!" 100 100 (hash + 'link "http://google.com/" + 'underline #t + 'width #f)]) (define-runtime-path this "test11rkt.pdf") (make-doc this #f proc) diff --git a/pitfall/ptest/test12.rkt b/pitfall/ptest/test12.rkt index b1338aa2..a154372e 100644 --- a/pitfall/ptest/test12.rkt +++ b/pitfall/ptest/test12.rkt @@ -1,18 +1,17 @@ - #lang racket/base +#lang racket/base (require pitfall/pdftest) (define-runtime-path charter-path "assets/charter.ttf") (define (proc doc) ;; Register a font name for use later - (send doc register-font "Charter" (path->string charter-path)) + (register-font doc "Charter" (path->string charter-path)) ;; Set the font, draw some text - (send* doc - [font "Charter"] - [font-size 25] - [text "Some text with an embedded font" 100 100 (hash - 'width #f)])) + [font doc "Charter"] + [font-size doc 25] + [text doc "Some text with an embedded font" 100 100 (hash + 'width #f)]) ;; test against non-subsetted font version (define-runtime-path this "test12rkt.pdf") diff --git a/pitfall/ptest/test13.rkt b/pitfall/ptest/test13.rkt index 324da34f..b9cc690f 100644 --- a/pitfall/ptest/test13.rkt +++ b/pitfall/ptest/test13.rkt @@ -5,13 +5,12 @@ (define (proc doc) ;; Register a font name for use later - (send doc register-font "Charter" (path->string charter-path)) + (register-font doc "Charter" (path->string charter-path)) ;; Set the font, draw some text - (send* doc - [font "Charter"] - [font-size 25] - [text "Åcçénts äre în" 100 100 (hash 'width #f)])) + [font doc "Charter"] + [font-size doc 25] + [text doc "Åcçénts äre în" 100 100 (hash 'width #f)]) ;; test against non-subsetted font version (define-runtime-path this "test13rkt.pdf") diff --git a/pitfall/ptest/test14.rkt b/pitfall/ptest/test14.rkt index 5c75cdb3..313a4051 100644 --- a/pitfall/ptest/test14.rkt +++ b/pitfall/ptest/test14.rkt @@ -6,13 +6,12 @@ (define (proc doc) ;; Register a font name for use later - (send doc register-font "the-font" (path->string ttf-path)) + (register-font doc "the-font" (path->string ttf-path)) ;; Set the font, draw some text - (send* doc - [font "the-font"] - [font-size 25] - [text "Hola Hola" 100 100 (hash 'width #f)])) + [font doc "the-font"] + [font-size doc 25] + [text doc "Hola Hola" 100 100 (hash 'width #f)]) ;; test against non-subsetted font version (define-runtime-path this "test14rkt.pdf") diff --git a/pitfall/ptest/test15.rkt b/pitfall/ptest/test15.rkt index a123da8a..9fb4755f 100644 --- a/pitfall/ptest/test15.rkt +++ b/pitfall/ptest/test15.rkt @@ -7,13 +7,12 @@ (define (proc doc) ;; Register a font name for use later - (send doc register-font "the-font" (path->string ttf-path)) + (register-font doc "the-font" (path->string ttf-path)) ;; Set the font, draw some text - (send* doc - [font "the-font"] - [font-size 25] - [text "HTAVATH" 100 100 (hash 'width #f)])) + [font doc "the-font"] + [font-size doc 25] + [text doc "HTAVATH" 100 100 (hash 'width #f)]) (define-runtime-path this "test15rkt.pdf") diff --git a/pitfall/ptest/test16.rkt b/pitfall/ptest/test16.rkt index 3587864c..fc7bd000 100644 --- a/pitfall/ptest/test16.rkt +++ b/pitfall/ptest/test16.rkt @@ -7,13 +7,12 @@ (define (proc doc) ;; Register a font name for use later - (send doc register-font "the-font" (path->string ttf-path)) + (register-font doc "the-font" (path->string ttf-path)) ;; Set the font, draw some text - (send* doc - [font "the-font"] - [font-size 100] - [text "Wofine" 100 100 (hash 'width #f)])) + [font doc "the-font"] + [font-size doc 100] + [text doc "Wofine" 100 100 (hash 'width #f)]) (define-runtime-path this "test16rkt.pdf") diff --git a/pitfall/ptest/test17.rkt b/pitfall/ptest/test17.rkt index 26a849f8..1578bea9 100644 --- a/pitfall/ptest/test17.rkt +++ b/pitfall/ptest/test17.rkt @@ -7,13 +7,12 @@ (define (proc doc) ;; Register a font name for use later - (send doc register-font "the-font" (path->string ttf-path)) + (register-font doc "the-font" (path->string ttf-path)) ;; Set the font, draw some text - (send* doc - [font "the-font"] - [font-size 50] - [text "The fifth rifle" 100 100 (hash 'width #f)])) + [font doc "the-font"] + [font-size doc 50] + [text doc "The fifth rifle" 100 100 (hash 'width #f)]) (define-runtime-path this "test17rkt.pdf") diff --git a/pitfall/ptest/test18.rkt b/pitfall/ptest/test18.rkt index 7413cca8..07c44c50 100644 --- a/pitfall/ptest/test18.rkt +++ b/pitfall/ptest/test18.rkt @@ -7,17 +7,16 @@ (define (proc doc) ;; Register a font name for use later - (send doc register-font "the-font" (path->string ttf-path)) + (register-font doc "the-font" (path->string ttf-path)) ;; Set the font, draw some text - (send* doc - [font "the-font"] - [font-size 25] - [text "In Xanadu did Kubla Khan" 100 100 (hash 'width #f)] - [text "A stately pleasure dome decree:" 100 140 (hash 'width #f)] - [text "Where Alph, the sacred river, ran" 100 180 (hash 'width #f)] - [text "Through caverns measureless to man" 100 220 (hash 'width #f)] - [text "Down to a sunless sea." 100 260 (hash 'width #f)])) + [font doc "the-font"] + [font-size doc 25] + [text doc "In Xanadu did Kubla Khan" 100 100 (hash 'width #f)] + [text doc "A stately pleasure dome decree:" 100 140 (hash 'width #f)] + [text doc "Where Alph, the sacred river, ran" 100 180 (hash 'width #f)] + [text doc "Through caverns measureless to man" 100 220 (hash 'width #f)] + [text doc "Down to a sunless sea." 100 260 (hash 'width #f)]) (define-runtime-path this "test18rkt.pdf") diff --git a/pitfall/ptest/test19.rkt b/pitfall/ptest/test19.rkt index 451ed4fe..0db9f9af 100644 --- a/pitfall/ptest/test19.rkt +++ b/pitfall/ptest/test19.rkt @@ -8,14 +8,13 @@ (define (proc doc) ;; Register a font name for use later - (send doc register-font "the-font" (path->string ttf-path)) + (register-font doc "the-font" (path->string ttf-path)) ;; Set the font, draw some text - (send* doc - [font "the-font"] - [font-size 100] - [text "A&B" 100 100 (hash 'width #f)] - [text "X&Y" 100 200 (hash 'width #f 'features '(ss03))])) + [font doc "the-font"] + [font-size doc 100] + [text doc "A&B" 100 100 (hash 'width #f)] + [text doc "X&Y" 100 200 (hash 'width #f 'features '(ss03))]) ;; test against non-subsetted font version (define-runtime-path this "test19rkt.pdf") diff --git a/pitfall/ptest/test6.rkt b/pitfall/ptest/test6.rkt index 58596541..643dc6b8 100644 --- a/pitfall/ptest/test6.rkt +++ b/pitfall/ptest/test6.rkt @@ -2,18 +2,17 @@ (require pitfall/pdftest) (define (proc doc) - (send* doc - [text "Page 1"] - [add-page] - [text "Page 2"] - [add-page] - [text "Page 3"] - [add-page] - [text "Page 4"] - [add-page] - [text "Page 5"] - [add-page] - [text "Page 6"])) + [text doc "Page 1"] + [add-page doc] + [text doc "Page 2"] + [add-page doc] + [text doc "Page 3"] + [add-page doc] + [text doc "Page 4"] + [add-page doc] + [text doc "Page 5"] + [add-page doc] + [text doc "Page 6"]) (define-runtime-path this "test6rkt.pdf") (make-doc this #f proc) diff --git a/pitfall/ptest/test7.rkt b/pitfall/ptest/test7.rkt index aaee8225..8775fedd 100644 --- a/pitfall/ptest/test7.rkt +++ b/pitfall/ptest/test7.rkt @@ -4,11 +4,10 @@ (define-runtime-path test-jpeg "assets/test.jpeg") (define (proc doc) - (send* doc - [font "Times-Italic"] - [font-size 25] - [text "Here comes a JPEG!" 100 100 (hash 'lineBreak #f)] - [image test-jpeg 100 160 (hash 'width 412)])) + [font doc "Times-Italic"] + [font-size doc 25] + [text doc "Here comes a JPEG!" 100 100 (hash 'lineBreak #f)] + [image doc test-jpeg 100 160 (hash 'width 412)]) (define-runtime-path this "test7rkt.pdf") (make-doc this #f proc) diff --git a/pitfall/ptest/test8.rkt b/pitfall/ptest/test8.rkt index 66929fb0..e4b5e135 100644 --- a/pitfall/ptest/test8.rkt +++ b/pitfall/ptest/test8.rkt @@ -4,11 +4,10 @@ (define-runtime-path pic "assets/test.png") (define (proc doc) - (send* doc - [font "Helvetica-Bold"] - [font-size 25] - [text "Another fantastic pic" 100 100 (hash 'lineBreak #f)] - [image pic 100 160 (hash 'width 412)])) + [font doc "Helvetica-Bold"] + [font-size doc 25] + [text doc "Another fantastic pic" 100 100 (hash 'lineBreak #f)] + [image doc pic 100 160 (hash 'width 412)]) ; node's zlib.deflate makes smaller files, for some reason ; so don't compare file sizes in this case diff --git a/pitfall/ptest/test9.rkt b/pitfall/ptest/test9.rkt index c4f6f5aa..f609119b 100644 --- a/pitfall/ptest/test9.rkt +++ b/pitfall/ptest/test9.rkt @@ -2,19 +2,17 @@ (require pitfall/pdftest) (define (proc doc) - (send* doc - [move-to 0 20] - [line-to 100 160] - [quadratic-curve-to 130 200 150 120] - [bezier-curve-to 190 -40 200 200 300 150] - [line-to 400 90] - [stroke]) + [move-to doc 0 20] + [line-to doc 100 160] + [quadratic-curve-to doc 130 200 150 120] + [bezier-curve-to doc 190 -40 200 200 300 150] + [line-to doc 400 90] + [stroke doc] - (send* doc [translate 0 200]) + [translate doc 0 200] - (send* doc - [path "M 0,20 L 100,160 Q 130,200 150,120 C 190,-40 200,200 300,150 L 400,90"] - [stroke])) + [path doc "M 0,20 L 100,160 Q 130,200 150,120 C 190,-40 200,200 300,150 L 400,90"] + [stroke doc]) (define-runtime-path this "test9rkt.pdf") (make-doc this #false proc)