diff options
| -rw-r--r-- | sly/transform.scm | 31 |
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." |