diff --git a/pitfall/pitfall/helper.rkt b/pitfall/pitfall/helper.rkt index f478dcbc..e3cd76fd 100644 --- a/pitfall/pitfall/helper.rkt +++ b/pitfall/pitfall/helper.rkt @@ -116,3 +116,10 @@ (define-syntax-rule (test-when cond expr) (if cond (raise-test-exn expr) expr)) + + + +(define mixin-tester% + (class object% + (super-new) + (define/public (addContent val) val))) \ No newline at end of file diff --git a/pitfall/pitfall/vector.rkt b/pitfall/pitfall/vector.rkt index 1ee4b26f..a708fe89 100644 --- a/pitfall/pitfall/vector.rkt +++ b/pitfall/pitfall/vector.rkt @@ -14,7 +14,7 @@ [circle (number? number? number? . ->m . object?)] [_windingRule (string? . ->m . string?)] [fill ((string?) ((or/c string? #f)) . ->*m . object?)] - [transform ((number? number? number? number? number? number?) (#:debug boolean?) . ->*m . (or/c object? string?))] + [transform (number? number? number? number? number? number? . ->m . object?)] [translate (number? number? . ->m . object?)] [scale (case->m (number? . -> . object?) @@ -29,11 +29,22 @@ (define default-ctm-value '(1 0 0 1 0 0)) +(define (make-transform-string ctm) + (format "~a cm" (string-join (map number ctm) " "))) -(define (vector-mixin %) +(define (combine-transforms n-transform m-transform) + (match-define (list n11 n12 n21 n22 ndx ndy) n-transform) + (match-define (list m11 m12 m21 m22 mdx mdy) m-transform) + (list (+ (* n11 m11) (* n21 m12)) + (+ (* n12 m11) (* n22 m12)) + (+ (* n11 m21) (* n21 m22)) + (+ (* n12 m21) (* n22 m22)) + (+ (* n11 mdx) (* n21 mdy) ndx) + (+ (* n12 mdx) (* n22 mdy) ndy))) + +(define (vector-mixin [% mixin-tester%]) (class % (super-new) - (init-field [(@test-mode test-mode) #f]) (field [(@_ctm _ctm) default-ctm-value] [(@_ctmStack _ctmStack) null]) @@ -64,8 +75,7 @@ (public [@bezierCurveTo bezierCurveTo]) (define (@bezierCurveTo cp1x cp1y cp2x cp2y x y) - (send this addContent (format "~a c" - (string-join (map number (list cp1x cp1y cp2x cp2y x y)) " ")))) + (send this addContent (format "~a c" (string-join (map number (list cp1x cp1y cp2x cp2y x y)) " ")))) (public [@ellipse ellipse]) @@ -107,22 +117,12 @@ (set! color #f)) (when color (send this fillColor color)) ;; fillColor method is from color mixin (send this addContent (format "f~a" (@_windingRule rule)))) - - + (public [@transform transform]) - (define (@transform m11 m12 m21 m22 dx dy #:debug [debug #f]) + (define (@transform . new-ctm) ;; keep track of the current transformation matrix - (match-define (list m0 m1 m2 m3 m4 m5) @_ctm) - (set! @_ctm (list (+ (* m0 m11) (* m2 m12)) - (+ (* m1 m11) (* m3 m12)) - (+ (* m0 m21) (* m2 m22)) - (+ (* m1 m21) (* m3 m22)) - (+ (* m0 dx) (* m2 dy) m4) - (+ (* m1 dx) (* m3 dy) m5))) - (define values (string-join (map number (list m11 m12 m21 m22 dx dy)) " ")) - (define result (format "~a cm" values)) - (test-when @test-mode result) - (send this addContent result)) + (set! @_ctm (combine-transforms @_ctm new-ctm)) + (send this addContent (make-transform-string new-ctm))) (public [@translate translate]) @@ -144,12 +144,12 @@ )) (module+ test - (require rackunit pitfall/test-helper) - (define v (make-object (vector-mixin object%) #t)) - (check-equal? (· v _ctm) default-ctm-value) - (check-exn-equal? (send v transform 1 2 3 4 5 6 #:debug #t) "1 2 3 4 5 6 cm") - (check-equal? (· v _ctm) '(1 2 3 4 5 6)) - (check-exn-equal? (send v transform 1 2 3 4 5 6 #:debug #t) "1 2 3 4 5 6 cm") - (check-equal? (· v _ctm) '(7 10 15 22 28 40)) - (check-exn-equal? (send v transform 1 2 3 4 5 6 #:debug #t) "1 2 3 4 5 6 cm") - (check-equal? (· v _ctm) '(37 54 81 118 153 222))) \ No newline at end of file + (require rackunit) + (define ctm default-ctm-value) + (define ctm2 '(1 2 3 4 5 6)) + (set! ctm (combine-transforms ctm ctm2)) + (check-equal? ctm '(1 2 3 4 5 6)) + (set! ctm (combine-transforms ctm ctm2)) + (check-equal? ctm '(7 10 15 22 28 40)) + (set! ctm (combine-transforms ctm ctm2)) + (check-equal? ctm '(37 54 81 118 153 222))) \ No newline at end of file