diff --git a/pitfall/pitfall/path.rkt b/pitfall/pitfall/path.rkt index a88c07b3..1c496ceb 100644 --- a/pitfall/pitfall/path.rkt +++ b/pitfall/pitfall/path.rkt @@ -42,12 +42,29 @@ [(M) (send doc moveTo . cmd-args) (match-define (list a0 a1) cmd-args) (values a0 a1 #f #f a0 a1)] + [(m) (match-define (list a0 a1) cmd-args) + (loop 'M (list (+ cx a0) (+ cy a1)))] [(C) (send doc bezierCurveTo . cmd-args) (match-define (list a0 a1 a2 a3 a4 a5) cmd-args) (values a4 a5 a2 a3 sx sy)] + [(c) (match-define (list a0 a1 a2 a3 a4 a5) cmd-args) + (loop 'C (list (+ cx a0) (+ cy a1) + (+ cx a2) (+ cy a3) + (+ cx a4) (+ cy a5)))] [(L) (send doc lineTo . cmd-args) (match-define (list a0 a1) cmd-args) (values a0 a1 #f #f sx sy)] + [(l) (match-define (list a0 a1) cmd-args) + (loop 'L (list (+ cx a0) (+ cy a1)))] + [(H) (match-define (list a0) cmd-args) + (loop 'L (list a0 cy))] + [(h) (match-define (list a0) cmd-args) + (loop 'L (list (+ cx a0) cy))] + [(V) (match-define (list a0) cmd-args) + (loop 'L (list cx a0))] + [(v) (match-define (list a0) cmd-args) + (loop 'L (list cx (+ cy a0)))] + [(Q) (send doc quadraticCurveTo . cmd-args) (match-define (list a0 a1 a2 a3) cmd-args) (values a2 a3 a0 a1 sx sy)] diff --git a/pitfall/pitfall/test/test11.rkt b/pitfall/pitfall/test/test11.rkt new file mode 100644 index 00000000..dfcd3104 --- /dev/null +++ b/pitfall/pitfall/test/test11.rkt @@ -0,0 +1,15 @@ +#lang pitfall/pdftest + +(define (proc doc) + (send doc translate 200 300) + (send* doc [path "m 0 0 v 100 h 100 v -100 h -100"] + [stroke]) + + (send doc translate 0 150) + (send* doc [path "M 0 0 L 0 100 L 100 0 L 0 -100 L -100 0"] + [stroke])) + + + +(define-runtime-path that "test11crkt.pdf") +(make-doc that #t proc #:test #f) diff --git a/pitfall/pitfall/test/test11crkt.pdf b/pitfall/pitfall/test/test11crkt.pdf new file mode 100644 index 00000000..43436d46 Binary files /dev/null and b/pitfall/pitfall/test/test11crkt.pdf differ