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