summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--sly/transform.scm31
1 files changed, 20 insertions, 11 deletions
diff --git a/sly/transform.scm b/sly/transform.scm
index afb8d97..05ce32d 100644
--- a/sly/transform.scm
+++ b/sly/transform.scm
@@ -114,17 +114,26 @@ null-transform if called without any arguments."
(define (transform* . transforms)
"Return the product of all given transformation matrices. Return
identity-transform if called without any arguments."
- (define (mul a b)
- (let ((m1 (transform-matrix a))
- (m2 (transform-matrix b))
- (m3 (make-4x4-matrix)))
- (do-ec (: r 4) (: c 4)
- (let ((x (sum-ec (: k 4)
- (* (array-ref m1 r k)
- (array-ref m2 k c)))))
- (array-set! m3 x r c)))
- (%make-transform m3)))
- (reduce mul identity-transform transforms))
+ (cond
+ ((null? transforms)
+ identity-transform)
+ ((null? (cdr transforms))
+ (car transforms))
+ (else
+ (let ((result (make-4x4-matrix)))
+ (array-copy! (transform-matrix (car transforms)) result)
+ (for-each
+ (lambda (t)
+ (let ((m (transform-matrix t)))
+ (do-ec
+ (: r 4) (: c 4)
+ (let ((x (sum-ec
+ (: k 4)
+ (* (array-ref m r k)
+ (array-ref result k c)))))
+ (array-set! result x r c)))))
+ (cdr transforms))
+ (%make-transform result)))))
(define (translate v)
"Return a new transform that translates by the 2D or 3D vector V."