1;;
2;; test for gl.math3d module
3;;
4
5(use gauche.test)
6(add-load-path "../lib")
7
8(test-start "gl.math3d")
9(use gl.math3d)
10(use gauche.sequence)
11(use math.const)
12(use srfi-1)
13
14(define (nearly=? a b)
15  (let ((sizea (size-of a))
16        (sizeb (size-of b)))
17    (and (= sizea sizeb)
18         (let loop ((i 0))
19           (cond ((>= i sizea) #t)
20                 ((< (abs (- (ref a i) (ref b i))) 1.0e-4) (loop (+ i 1)))
21                 (else #f))))))
22
23;;------------------------------------------------------------------
24(test-section "vector4f")
25
26(test* "vector4f" #t
27       (vector4f? (vector4f 0 1 2 3)))
28(test* "vector4f reader" #t
29       (equal? (vector4f 0 1 2 3) #,(vector4f 0 1 2 3)))
30(test* "vector4f converters" #t
31       (let1 v (vector4f 0 1 2 3)
32         (and (equal? v (list->vector4f '(0 1 2 3)))
33              (equal? v (f32vector->vector4f '#f32(0.0 1.0 2.0 3.0)))
34              (equal? v (list->vector4f (vector4f->list v)))
35              (equal? v (f32vector->vector4f (vector4f->f32vector v)))
36              (equal? v (coerce-to <vector4f> '(0 1 2 3)))
37              (equal? v (coerce-to <vector4f> '#(0 1 2 3)))
38              (equal? v (coerce-to <vector4f> '#f32(0 1 2 3)))
39              )))
40(test* "vector4f ref" '(0.0 1.0 2.0 3.0)
41       (let1 v (vector4f 0 1 2 3)
42         (map (pa$ vector4f-ref v) '(0 1 2 3))))
43(test* "vector4f set" #,(vector4f 3.0 2.0 1.0 0.0)
44       (let1 v (vector4f 0 0 0 0)
45         (set! (vector4f-ref v 0) 3.0)
46         (set! (vector4f-ref v 1) 2.0)
47         (set! (vector4f-ref v 2) 1.0)
48         (set! (vector4f-ref v 3) 0.0)
49         v))
50(test* "vector4f +" #,(vector4f 3.0 5.0 7.0 9.0)
51       (+ #,(vector4f 1.0 2.0 3.0 4.0)
52          #,(vector4f 2.0 3.0 4.0 5.0)))
53(test* "vector4f +" #,(vector4f 1.0 1.0 1.0 1.0)
54       (+ #,(vector4f 1.0 2.0 3.0 4.0)
55          #,(vector4f 2.0 3.0 4.0 5.0)
56          #,(vector4f -2.0 -4.0 -6.0 -8.0)))
57(test* "vector4f -" #,(vector4f -1.0 -2.0 -3.0 -4.0)
58       (- #,(vector4f 1.0 2.0 3.0 4.0)
59          #,(vector4f 2.0 4.0 6.0 8.0)))
60(test* "vector4f *" #,(vector4f 2 4 6 8)
61       (* #,(vector4f 1 2 3 4) 2.0))
62(test* "vector4f *" #,(vector4f 2 4 6 8)
63       (* 2.0 #,(vector4f 1 2 3 4)))
64(test* "vector4f /" #,(vector4f 0.5 1.0 1.5 2.0)
65       (/ #,(vector4f 1 2 3 4) 2.0))
66(test* "vector4f dot" 40.0
67       (vector4f-dot #,(vector4f 1.0 2.0 3.0 4.0)
68                     #,(vector4f 2.0 3.0 4.0 5.0)))
69(test* "vector4f cross" #,(vector4f -4.0 8.0 -4.0 0.0)
70       (vector4f-cross #,(vector4f 1.0 2.0 3.0 0.0)
71                       #,(vector4f 5.0 6.0 7.0 0.0)))
72(test* "vector4f normalize" #,(vector4f 0.5 0.5 0.5 0.5)
73       (vector4f-normalize (vector4f 1 1 1 1)))
74(test* "vector4f normalize!" #,(vector4f 0.5 0.5 0.5 0.5)
75       (let1 v (vector4f 4 4 4 4)
76         (vector4f-normalize! v)
77         v))
78
79
80;; sequence access
81(test* "sequence"
82       '(1.0 2.0 3.0 4.0)
83       (coerce-to <list> #,(vector4f 1.0 2.0 3.0 4.0)))
84
85(test* "sequence"
86       #,(vector4f 1.0 2.0 3.0 4.0)
87       (coerce-to <vector4f> '(1.0 2.0 3.0 4.0)))
88
89;;------------------------------------------------------------------
90(test-section "point4f")
91
92(test* "point4f" #t
93       (point4f? (point4f 1 2 3)))
94(test* "point4f reader" #t
95       (equal? (point4f 1 2 3) #,(point4f 1 2 3)))
96(test* "point4f converters" #t
97       (let1 v (point4f 1 2 3)
98         (and (equal? v (list->point4f '(1 2 3)))
99              (equal? v (list->point4f (point4f->list v))))))
100(test* "point4f ref" '(1.0 2.0 3.0)
101       (let1 v (point4f 1 2 3)
102         (map (pa$ point4f-ref v) '(0 1 2))))
103(test* "point4f set" #,(point4f 3.0 2.0 1.0)
104       (let1 v (point4f 0 0 0)
105         (set! (point4f-ref v 0) 3.0)
106         (set! (point4f-ref v 1) 2.0)
107         (set! (point4f-ref v 2) 1.0)
108         v))
109(test* "point4f +" #,(point4f 3.0 5.0 7.0)
110       (+ #,(point4f 1.0 2.0 3.0)
111          #,(vector4f 2.0 3.0 4.0)))
112(test* "point4f +" #,(point4f 1.0 1.0 1.0)
113       (+ #,(point4f 1.0 2.0 3.0)
114          #,(vector4f 2.0 3.0 4.0)
115          #,(vector4f -2.0 -4.0 -6.0)))
116(test* "point4f -" #,(point4f -1.0 -2.0 -3.0)
117       (- #,(point4f 1.0 2.0 3.0)
118          #,(vector4f 2.0 4.0 6.0)))
119(test* "point4f -" #,(vector4f -1.0 -2.0 -3.0)
120       (- #,(point4f 1.0 2.0 3.0)
121          #,(point4f 2.0 4.0 6.0)))
122
123;; sequence access
124(test* "sequence"
125       '(1.0 2.0 3.0 4.0)
126       (coerce-to <list> #,(point4f 1.0 2.0 3.0 4.0)))
127
128(test* "sequence"
129       #,(point4f 1.0 2.0 3.0 4.0)
130       (coerce-to <point4f> '(1.0 2.0 3.0 4.0)))
131
132;;------------------------------------------------------------------
133(test-section "matrix4f")
134
135(test* "matrix4f" #,(matrix4f 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5)
136       (matrix4f 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5))
137(test* "matrix4f row"
138       '(#,(vector4f 0 4 8 2)
139         #,(vector4f 1 5 9 3)
140         #,(vector4f 2 6 0 4)
141         #,(vector4f 3 7 1 5))
142       (let1 m (matrix4f 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5)
143         (map (pa$ matrix4f-row m) '(0 1 2 3))))
144(test* "matrix4f row set!"
145       #,(matrix4f 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5)
146       (let1 m (make-matrix4f)
147         (set! (matrix4f-row m 3) (vector4f 3 7 1 5))
148         (set! (matrix4f-row m 2) (vector4f 2 6 0 4))
149         (set! (matrix4f-row m 1) (vector4f 1 5 9 3))
150         (set! (matrix4f-row m 0) (vector4f 0 4 8 2))
151         m))
152(test* "matrix4f column"
153       '(#,(vector4f 0 1 2 3)
154         #,(vector4f 4 5 6 7)
155         #,(vector4f 8 9 0 1)
156         #,(vector4f 2 3 4 5))
157       (let1 m (matrix4f 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5)
158         (map (pa$ matrix4f-column m) '(0 1 2 3))))
159(test* "matrix4f column set!"
160       #,(matrix4f 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5)
161       (let1 m (make-matrix4f)
162         (set! (matrix4f-column m 3) (vector4f 2 3 4 5))
163         (set! (matrix4f-column m 2) (vector4f 8 9 0 1))
164         (set! (matrix4f-column m 1) (vector4f 4 5 6 7))
165         (set! (matrix4f-column m 0) (vector4f 0 1 2 3))
166         m))
167
168(test* "matrix4f * matrix4f"
169       (let ((A0 (vector4f 0 4 8 12))
170             (A1 (vector4f 1 5 9 13))
171             (A2 (vector4f 2 6 10 14))
172             (A3 (vector4f 3 7 11 15))
173             (B0 (vector4f 16 17 18 19))
174             (B1 (vector4f 20 21 22 23))
175             (B2 (vector4f 24 25 26 27))
176             (B3 (vector4f 28 29 30 31))
177             (dot vector4f-dot))
178         (matrix4f (dot A0 B0) (dot A1 B0) (dot A2 B0) (dot A3 B0)
179                   (dot A0 B1) (dot A1 B1) (dot A2 B1) (dot A3 B1)
180                   (dot A0 B2) (dot A1 B2) (dot A2 B2) (dot A3 B2)
181                   (dot A0 B3) (dot A1 B3) (dot A2 B3) (dot A3 B3)))
182       (* (matrix4f 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)
183          (matrix4f 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31))
184       )
185
186(test* "matrix4f * vector4f"
187       (let ((V (vector4f 1 -2 3 -4)))
188         (vector4f (vector4f-dot (vector4f 0 4 8 12) V)
189                   (vector4f-dot (vector4f 1 5 9 13) V)
190                   (vector4f-dot (vector4f 2 6 10 14) V)
191                   (vector4f-dot (vector4f 3 7 11 15) V)))
192       (* (matrix4f 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)
193          (vector4f 1 -2 3 -4)))
194
195(test* "matrix4f * scalar"
196       (matrix4f 0 -1 -2 -3 -4 -5 -6 -7 -8 -9 -10 -11 -12 -13 -14 -15)
197       (* (matrix4f 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15) -1))
198
199(test* "matrix4f transpose"
200       (matrix4f 0 4 8 12 1 5 9 13 2 6 10 14 3 7 11 15)
201       (matrix4f-transpose
202        (matrix4f 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)))
203
204(test* "matrix4f transpose!"
205       (matrix4f 0 4 8 12 1 5 9 13 2 6 10 14 3 7 11 15)
206       (let1 m (matrix4f 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)
207         (matrix4f-transpose! m)
208         m))
209
210(test* "matrix4f determinant" 1.0
211       (matrix4f-determinant (matrix4f 1 0 0 0 0 2 4 9 0 3 2 6 0 2 3 7)))
212
213(test* "matrix4f determinant" -1.0
214       (matrix4f-determinant (matrix4f 0 1 0 0 2 0 3 9 3 0 2 5 5 0 3 7)))
215
216(test* "matrix4f determinant" 1.0
217       (matrix4f-determinant (matrix4f 0 0 1 0 2 3 0 17 3 2 0 11 6 3 0 16)))
218
219(test* "matrix4f determinant" -1.0
220       (matrix4f-determinant (matrix4f 0 0 0 1 2 3 17 0 3 2 11 0 6 3 16 0)))
221
222(test* "matrix4f determinant" -1.0
223       (matrix4f-determinant (matrix4f 0 2 4 9 1 0 0 0 0 3 2 6 0 2 3 7)))
224
225(test* "matrix4f determinant" 1.0
226       (matrix4f-determinant (matrix4f 0 2 4 9 0 3 2 6 1 0 0 0 0 2 3 7)))
227
228(test* "matrix4f inverse"
229       (matrix4f 1 0 0 0 0 -4 -1 6 0 -9 -4 15 0 5 2 -8)
230       (matrix4f-inverse (matrix4f 1 0 0 0 0 2 4 9 0 3 2 6 0 2 3 7))
231       nearly=?)
232
233(test* "matrix4f inverse, mul"
234       (matrix4f 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1)
235       (let ((m (matrix4f 0 2 4 9 0 3 2 6 1 0 0 0 0 2 3 7)))
236         (matrix4f-mul m (matrix4f-inverse m)))
237       nearly=?)
238
239(test* "matrix4f inverse, mul 2"
240       (matrix4f 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1)
241       (let* ((m (matrix4f 0 2 4 9 0 3 2 6 1 0 0 0 0 2 3 7))
242              (n (matrix4f 0 0 0 1 2 3 17 0 3 2 11 0 6 3 16 0))
243              (1/m (matrix4f-inverse m))
244              (1/n (matrix4f-inverse n)))
245         (matrix4f-mul (matrix4f-mul m n)
246                       (matrix4f-mul 1/n 1/m)))
247       nearly=?)
248
249(test* "matrix4f inverse!"
250       (matrix4f 0 -1 6 -3 1 0 0 0 0 4 -31 17 0 -1 9 -5)
251       (let ((m (matrix4f 0 1 0 0 2 0 3 9 3 0 2 5 5 0 3 7)))
252         (matrix4f-inverse! m)
253         m)
254       nearly=?)
255
256(test* "matrix4f inverse (singular)"
257       #f
258       (matrix4f-inverse (matrix4f 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) #f))
259
260(test* "matrix4f inverse (singular)" *test-error*
261       (matrix4f-inverse (matrix4f 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)))
262
263(let ((t0 -2.0) (t1 -3.0) (t2 -4.0)
264      (phi (* 60 pi/180))
265      (s0  1.1) (s1  1.2) (s2  1.3))
266  (test* "matrix4 and transform"
267         (let* ((cosphi   (cos phi))
268                (1-cosphi (- 1 cosphi))
269                (sinphi   (sin phi))
270                (sqrt14   (sqrt 14))
271                (vx       (/ 1 sqrt14))
272                (vy       (/ 2 sqrt14))
273                (vz       (/ 3 sqrt14))
274                (T (matrix4f 1 0 0 0 0 1 0 0 0 0 1 0 t0 t1 t2 1))
275                (R (matrix4f (+ cosphi (* 1-cosphi vx vx))
276                             (+ (* 1-cosphi vx vy) (* sinphi vz))
277                             (- (* 1-cosphi vx vz) (* sinphi vy))
278                             0.0
279                             (- (* 1-cosphi vx vy) (* sinphi vz))
280                             (+ cosphi (* 1-cosphi vy vy))
281                             (+ (* 1-cosphi vy vz) (* sinphi vx))
282                             0.0
283                             (+ (* 1-cosphi vx vz) (* sinphi vy))
284                             (- (* 1-cosphi vy vz) (* sinphi vx))
285                             (+ cosphi (* 1-cosphi vz vz))
286                             0.0
287                             0.0 0.0 0.0 1.0))
288                (S (matrix4f s0 0 0 0 0 s1 0 0 0 0 s2 0 0 0 0 1))
289                )
290           (matrix4f-mul T (matrix4f-mul R S)))
291         (trs->matrix4f (vector4f t0 t1 t2)
292                        (vector4f (/ 1 (sqrt 14))
293                                  (/ 2 (sqrt 14))
294                                  (/ 3 (sqrt 14)))
295                        phi
296                        (vector4f s0 s1 s2))
297         nearly=?))
298
299;; tests euler angles
300(let* ((rotx (* 23 pi/180))
301       (roty (* -66 pi/180))
302       (rotz (* 171 pi/180))
303       (Rx (rotation->matrix4f (vector4f 1 0 0) rotx))
304       (Ry (rotation->matrix4f (vector4f 0 1 0) roty))
305       (Rz (rotation->matrix4f (vector4f 0 0 1) rotz)))
306  (define (euler-tester sig a b c)
307    (test #`"euler->mat (,sig)" (matrix4f-mul c (matrix4f-mul b a))
308          (lambda () (euler-angle->matrix4f rotx roty rotz sig))
309          nearly=?))
310  (euler-tester 'xyz Rx Ry Rz)
311  (euler-tester 'xzy Rx Rz Ry)
312  (euler-tester 'yzx Ry Rz Rx)
313  (euler-tester 'yxz Ry Rx Rz)
314  (euler-tester 'zxy Rz Rx Ry)
315  (euler-tester 'zyx Rz Ry Rx)
316  )
317
318;; matrix decompose
319(define (matrix-decompose-tester name T R H S)
320  (test name '(#t #t #t #t #t)
321        (lambda ()
322          (let* ((tmat (translation->matrix4f T))
323                 (smat (scale->matrix4f S))
324                 (mat  (matrix4f-mul tmat (matrix4f-mul R smat))))
325            (receive (f t r h s)
326                (matrix4f-decompose mat)
327              ;(print r)
328              ;(print R)
329              ;(print h)
330              ;(print s)
331              (list f
332                    (nearly=? t T)
333                    (nearly=? r R)
334                    (nearly=? h H)
335                    (nearly=? s S)))))))
336
337(matrix-decompose-tester
338 "matrix-decompose"
339 (vector4f 1 3 2)
340 (rotation->matrix4f (vector4f-normalize (vector4f 3 8 -1)) (* 264 pi/180))
341 (vector4f 0 0 0 0)
342 (vector4f 1.1 0.5 0.2))
343
344(matrix-decompose-tester
345 "matrix-decompose (flip)"
346 (vector4f 9 2 4)
347 (rotation->matrix4f (vector4f-normalize (vector4f 6 0 2)) (* 82 pi/180))
348 (vector4f 0 0 0 0)
349 (vector4f -1 -2 -3))
350
351(test* "matrix4f->rotation" #t
352       (let* ((axis  (vector4f-normalize (vector4f 1 2 3)))
353              (angle (* 45 pi/180))
354              (m     (rotation->matrix4f axis angle)))
355         (receive (raxis rangle)
356             (matrix4f->rotation m)
357           (and (nearly=? axis raxis)
358                (< (abs (- rangle angle)) 1.0e-4)))))
359
360;; sequence access
361(test* "sequence"
362       '(1.0 2.0 3.0 4.0 -1.0 -2.0 -3.0 -4.0 4.0 3.0 2.0 1.0 -4.0 -3.0 -2.0 -1.0)
363       (coerce-to <list>
364                  #,(matrix4f 1 2 3 4 -1 -2 -3 -4 4 3 2 1 -4 -3 -2 -1)))
365
366(test* "sequence"
367       #,(matrix4f 1.0 2.0 3.0 4.0 -1.0 -2.0 -3.0 -4.0 4.0 3.0 2.0 1.0 -4.0 -3.0 -2.0 -1.0)
368       (coerce-to <matrix4f>
369                  '(1.0 2.0 3.0 4.0 -1.0 -2.0 -3.0 -4.0 4.0 3.0 2.0 1.0 -4.0 -3.0 -2.0 -1.0)))
370
371;;------------------------------------------------------------------
372(test-section "quatf")
373
374(test* "conjugate"
375       (make-quatf (vector4f 0 (/ 1 (sqrt 5)) (/ 2 (sqrt 5))) -0.5)
376       (quatf-conjugate
377        (make-quatf (vector4f 0 (/ 1 (sqrt 5)) (/ 2 (sqrt 5))) 0.5)))
378
379(let ((p (make-quatf (vector4f-normalize (vector4f 3 2 1)) -1.6))
380      (q (make-quatf (vector4f-normalize (vector4f 0 2 5)) 0.7))
381      (r (make-quatf (vector4f-normalize (vector4f 2 1 3)) 0.1)))
382  (test* "add, sub, and mul"
383         (list (+ p q) (- p q) (* p q) p)
384         (let ((p+ (quatf-copy p))
385               (p- (quatf-copy p))
386               (p* (quatf-copy p)))
387           (quatf-add! p+ q)
388           (quatf-sub! p- q)
389           (quatf-mul! p* q)
390           (list p+ p- p* p))))
391
392(test* "rotation -> quaterion"
393       (let* ((phi (* 75 pi/180))
394              (q   (quatf (* (sin phi) (/ 1 (sqrt 14)))
395                          (* (sin phi) (/ 2 (sqrt 14)))
396                          (* (sin phi) (/ 3 (sqrt 14)))
397                          (cos phi))))
398         (list q q))
399       (let1 rotv (vector4f (/ 1 (sqrt 14))
400                            (/ 2 (sqrt 14))
401                            (/ 3 (sqrt 14)))
402         (list (make-quatf rotv (* 150 pi/180))
403               (let1 q (make-quatf)
404                 (rotation->quatf! q rotv (* 150 pi/180)))))
405       )
406
407
408(test* "transform by quaternion"
409       (* (rotation->matrix4f (vector4f 0 (/ 1 (sqrt 5)) (/ 2 (sqrt 5)))
410                              (* 15 pi/180))
411          (point4f 3.1 2.1 1.1))
412       (quatf-transform (make-quatf (vector4f 0 (/ 1 (sqrt 5)) (/ 2 (sqrt 5)))
413                                    (* 15 pi/180))
414                        (point4f 3.1 2.1 1.1))
415       nearly=?)
416
417(test* "tqs->matrix"
418       (trs->matrix4f #,(vector4f 0 0 0)
419                      (vector4f (/ 2 (sqrt 29))
420                                (/ 3 (sqrt 29))
421                                (/ 4 (sqrt 29)))
422                      (* -41 pi/180)
423                      #,(vector4f 1 2 3))
424       (tqs->matrix4f #,(vector4f 0 0 0)
425                      (make-quatf (vector4f (/ 2 (sqrt 29))
426                                            (/ 3 (sqrt 29))
427                                            (/ 4 (sqrt 29)))
428                                  (* -41 pi/180))
429                      #,(vector4f 1 2 3))
430       nearly=?)
431
432;; matrix <-> quaternion
433(test* "quatf->matrix"
434       (rotation->matrix4f (vector4f (/ 3 (sqrt 14))
435                                     (/ 2 (sqrt 14))
436                                     (/ -1 (sqrt 14)))
437                           (* 75 pi/180))
438       (quatf->matrix4f (make-quatf (vector4f (/ 3 (sqrt 14))
439                                              (/ 2 (sqrt 14))
440                                              (/ -1 (sqrt 14)))
441                                    (* 75 pi/180)))
442       nearly=?)
443
444(test* "matrix->quatf"
445       (make-quatf (vector4f (/ 7 (sqrt 66))
446                             (/ -1 (sqrt 66))
447                             (/ 4 (sqrt 66)))
448                   (* -13 pi/180))
449       (matrix4f->quatf (rotation->matrix4f (vector4f (/ 7 (sqrt 66))
450                                                      (/ -1 (sqrt 66))
451                                                      (/ 4 (sqrt 66)))
452                                            (* -13 pi/180)))
453       nearly=?)
454
455;; rotation check
456(let ()
457  (define (rot-test q v)
458    (let* ((nv (vector4f-normalize v)))
459      (test* (format "rotation by quaternion ~s ~s" q v)
460             (* (quatf->matrix4f q) nv)
461             (quatf-transform q nv)
462             nearly=?)))
463  (define (rot-test* q)
464    (for-each (cute rot-test (quatf-normalize q) <>)
465              '(#,(vector4f 1 0 0 0)
466                #,(vector4f 0 1 0 0)
467                #,(vector4f 0 0 1 0)
468                #,(vector4f 1 1 0 0)
469                #,(vector4f 1 -1 0 0)
470                #,(vector4f -1 0 1 0)
471                #,(vector4f 1 0 -1 0)
472                #,(vector4f 0 1 -1 0)
473                #,(vector4f 0 -1 1 0)
474                #,(vector4f 3 1 4 0))))
475  (for-each rot-test*
476            '(#,(quatf 1 0 0 0) #,(quatf 0 1 0 0) #,(quatf 0 0 1 0)
477              #,(quatf 0 0 0 1) #,(quatf 1 1 1 1) #,(quatf 1 -1 1 -1)
478              #,(quatf 3 1 -4 5))))
479
480;; test case for small trace case
481(test* "matrix->quatf (small trace)"
482       (make-quatf (vector4f 1 0 0) (- pi 0.1))
483       (matrix4f->quatf (rotation->matrix4f (vector4f 1 0 0) (- pi 0.1)))
484       nearly=?)
485(test* "matrix->quatf (small trace)"
486       (make-quatf (vector4f 0 1 0) (- pi 0.1))
487       (matrix4f->quatf (rotation->matrix4f (vector4f 0 1 0) (- pi 0.1)))
488       nearly=?)
489(test* "matrix->quatf (small trace)"
490       (make-quatf (vector4f 0 0 1) (- pi 0.1))
491       (matrix4f->quatf (rotation->matrix4f (vector4f 0 0 1) (- pi 0.1)))
492       nearly=?)
493
494;; two vectors -> quatf
495(let ()
496  (define (2vtest v w)
497    (let ((nv (vector4f-normalize v))
498          (nw (vector4f-normalize w)))
499      (test* (format "2vtest ~s ~s" v w) nw
500             (quatf-transform (vectors->quatf nv nw) nv)
501             nearly=?)
502      (test* (format "2vtest ~s ~s" w v) nv
503             (quatf-transform (vectors->quatf nw nv) nw)
504             nearly=?)))
505  (2vtest #,(vector4f 1 0 0 0) #,(vector4f 0 1 0 0))
506  (2vtest #,(vector4f 0 1 0 0) #,(vector4f 0 0 1 0))
507  (2vtest #,(vector4f 0 0 1 0) #,(vector4f 1 0 0 0))
508  (2vtest #,(vector4f 1 2 3 0) #,(vector4f 4 -5 6 0))
509  (2vtest #,(vector4f 1 1 0 0) #,(vector4f 1 1 0 0))
510  (2vtest #,(vector4f 1 1 0 0) #,(vector4f 1 1 0.001 0))
511  )
512
513;; four vectors -> quatf
514(let ()
515  (define (4vtest v1 v2 w1 w2)
516    (let ((nv1 (vector4f-normalize v1))
517          (nv2 (vector4f-normalize v2))
518          (nw1 (vector4f-normalize w1))
519          (nw2 (vector4f-normalize w2)))
520      (test* (format "4vtest (~s ~s) (~s ~s)" v1 v2 w1 w2)
521             (list '(1.0) nw1 nw2 (+ nw1 nw2))
522             (let1 q (axes->quatf nv1 nv2 nw1 nw2)
523               (list (list (quatf-norm q))
524                     (quatf-transform q nv1)
525                     (quatf-transform q nv2)
526                     (quatf-transform q (+ nv1 nv2))))
527             (cut every nearly=? <> <>))
528      (test* (format "4vtest (~s ~s) (~s ~s)" w1 w2 v1 v2)
529             (list '(1.0) nv1 nv2 (+ nv1 nv2))
530             (let1 q (axes->quatf nw1 nw2 nv1 nv2)
531               (list (list (quatf-norm q))
532                     (quatf-transform q nw1)
533                     (quatf-transform q nw2)
534                     (quatf-transform q (+ nw1 nw2))))
535             (cut every nearly=? <> <>))))
536
537  (4vtest #,(vector4f 1 0 0 0) #,(vector4f 0 1 0 0)
538          #,(vector4f 0 1 0 0) #,(vector4f 0 0 1 0))
539  (4vtest #,(vector4f 1 0 0 0) #,(vector4f 0 1 0 0)
540          #,(vector4f 0 0 -1 0) #,(vector4f 0 1 0 0))
541  (4vtest #,(vector4f 1 1 0 0) #,(vector4f 1 -1 0)
542          #,(vector4f 1 0 0) #,(vector4f 0 0 1 0))
543  )
544
545;; sequence access
546(test* "sequence"
547       '(1.0 2.0 3.0 4.0)
548       (coerce-to <list> #,(quatf 1.0 2.0 3.0 4.0)))
549
550(test* "sequence"
551       #,(quatf 1.0 2.0 3.0 4.0)
552       (coerce-to <quatf> '(1.0 2.0 3.0 4.0)))
553
554
555(test-end)
556