store math.matrices.simd matrices in column-major order so that m4.v, frustum, and...

diff --git a/extra/math/matrices/simd/simd-tests.factor b/extra/math/matrices/simd/simd-tests.factor
index 3798c3e98e0936be4efeb01f560f891fec060b5f..965c2bddb54165a338b537036c411e8b092459ca 100644 (file)
--- a/extra/math/matrices/simd/simd-tests.factor
+++ b/extra/math/matrices/simd/simd-tests.factor
@@ -52,10 +52,10 @@ IN: math.matrices.simd.tests
 [ 
     S{ matrix4 f
         float-4-array{
-            float-4{ 1.0 0.0 0.0 3.0 }
-            float-4{ 0.0 1.0 0.0 4.0 }
-            float-4{ 0.0 0.0 1.0 2.0 }
-            float-4{ 0.0 0.0 0.0 1.0 }
+            float-4{ 1.0 0.0 0.0 0.0 }
+            float-4{ 0.0 1.0 0.0 0.0 }
+            float-4{ 0.0 0.0 1.0 0.0 }
+            float-4{ 3.0 4.0 2.0 1.0 }
         }
     }
 ] [ float-4{ 3.0 4.0 2.0 0.0 } translation-matrix4 ] unit-test
@@ -77,9 +77,9 @@ IN: math.matrices.simd.tests
     float-4{ 0.0 1.0 0.0 1.0 } pi 1/2. * rotation-matrix4
     S{ matrix4 f
         float-4-array{
-            float-4{  0.0  0.0  1.0 0.0 }
+            float-4{  0.0  0.0 -1.0 0.0 }
             float-4{  0.0  1.0  0.0 0.0 }
-            float-4{ -1.0  0.0  0.0 0.0 }
+            float-4{  1.0  0.0  0.0 0.0 }
             float-4{  0.0  0.0  0.0 1.0 }
         }
     }
@@ -89,10 +89,10 @@ IN: math.matrices.simd.tests
 [
     S{ matrix4 f
         float-4-array{
-            float-4{ 2.0 0.0 0.0 10.0 }
-            float-4{ 0.0 3.0 0.0 18.0 }
-            float-4{ 0.0 0.0 4.0 28.0 }
-            float-4{ 0.0 0.0 0.0  1.0 }
+            float-4{  2.0  0.0  0.0  0.0 }
+            float-4{  0.0  3.0  0.0  0.0 }
+            float-4{  0.0  0.0  4.0  0.0 }
+            float-4{ 10.0 18.0 28.0  1.0 }
         }
     }
 ] [
@@ -106,10 +106,10 @@ IN: math.matrices.simd.tests
     }
     S{ matrix4 f
         float-4-array{
-            float-4{ 1.0 0.0 0.0 5.0 }
-            float-4{ 0.0 1.0 0.0 6.0 }
-            float-4{ 0.0 0.0 1.0 7.0 }
-            float-4{ 0.0 0.0 0.0 1.0 }
+            float-4{ 1.0 0.0 0.0 0.0 }
+            float-4{ 0.0 1.0 0.0 0.0 }
+            float-4{ 0.0 0.0 1.0 0.0 }
+            float-4{ 5.0 6.0 7.0 1.0 }
         }
     }
     m4.
@@ -118,10 +118,10 @@ IN: math.matrices.simd.tests
 [
     S{ matrix4 f
         float-4-array{
-            float-4{ 3.0 0.0 0.0 5.0 }
-            float-4{ 0.0 4.0 0.0 6.0 }
-            float-4{ 0.0 0.0 5.0 7.0 }
-            float-4{ 0.0 0.0 0.0 2.0 }
+            float-4{ 3.0 0.0 0.0 0.0 }
+            float-4{ 0.0 4.0 0.0 0.0 }
+            float-4{ 0.0 0.0 5.0 0.0 }
+            float-4{ 5.0 6.0 7.0 2.0 }
         }
     }
 ] [
@@ -135,10 +135,10 @@ IN: math.matrices.simd.tests
     }
     S{ matrix4 f
         float-4-array{
-            float-4{ 1.0 0.0 0.0 5.0 }
-            float-4{ 0.0 1.0 0.0 6.0 }
-            float-4{ 0.0 0.0 1.0 7.0 }
-            float-4{ 0.0 0.0 0.0 1.0 }
+            float-4{ 1.0 0.0 0.0 0.0 }
+            float-4{ 0.0 1.0 0.0 0.0 }
+            float-4{ 0.0 0.0 1.0 0.0 }
+            float-4{ 5.0 6.0 7.0 1.0 }
         }
     }
     m4+
@@ -147,10 +147,10 @@ IN: math.matrices.simd.tests
 [
     S{ matrix4 f
         float-4-array{
-            float-4{ 1.0 0.0 0.0 -5.0 }
-            float-4{ 0.0 2.0 0.0 -6.0 }
-            float-4{ 0.0 0.0 3.0 -7.0 }
-            float-4{ 0.0 0.0 0.0  0.0 }
+            float-4{  1.0  0.0  0.0 0.0 }
+            float-4{  0.0  2.0  0.0 0.0 }
+            float-4{  0.0  0.0  3.0 0.0 }
+            float-4{ -5.0 -6.0 -7.0 0.0 }
         }
     }
 ] [
@@ -164,10 +164,10 @@ IN: math.matrices.simd.tests
     }
     S{ matrix4 f
         float-4-array{
-            float-4{ 1.0 0.0 0.0 5.0 }
-            float-4{ 0.0 1.0 0.0 6.0 }
-            float-4{ 0.0 0.0 1.0 7.0 }
-            float-4{ 0.0 0.0 0.0 1.0 }
+            float-4{ 1.0 0.0 0.0 0.0 }
+            float-4{ 0.0 1.0 0.0 0.0 }
+            float-4{ 0.0 0.0 1.0 0.0 }
+            float-4{ 5.0 6.0 7.0 1.0 }
         }
     }
     m4-
@@ -219,10 +219,10 @@ IN: math.matrices.simd.tests
 [
     S{ matrix4 f
         float-4-array{
-            float-4{ 1/2. 0.0   0.0    0.0  }
-            float-4{ 0.0  1/2.  0.0    0.0  }
-            float-4{ 0.0  0.0  -6/4. -10/4. }
-            float-4{ 0.0  0.0  -1.0    0.0  }
+            float-4{ 1/2. 0.0   0.0   0.0 }
+            float-4{ 0.0  1/2.  0.0   0.0 }
+            float-4{ 0.0  0.0  -6/4. -1.0 }
+            float-4{ 0.0  0.0 -10/4.  0.0 }
         }
     }
 ] [

diff --git a/extra/math/matrices/simd/simd.factor b/extra/math/matrices/simd/simd.factor
index da1149dfec547cf63aa55856e86761da188694a8..edbe77781f7d043ffb1f050231c4e290d734bf65 100644 (file)
--- a/extra/math/matrices/simd/simd.factor
+++ b/extra/math/matrices/simd/simd.factor
@@ -9,34 +9,34 @@ SPECIALIZED-ARRAY: float-4
 IN: math.matrices.simd
 
 STRUCT: matrix4
-    { rows float-4[4] } ;
+    { columns float-4[4] } ;
 
 INSTANCE: matrix4 immutable-sequence
 
 M: matrix4 length drop 4 ; inline
-M: matrix4 nth-unsafe rows>> nth-unsafe ; inline
+M: matrix4 nth-unsafe columns>> nth-unsafe ; inline
 M: matrix4 new-sequence 2drop matrix4 (struct) ; inline
 
 <PRIVATE
 
-: rows ( a -- a1 a2 a3 a4 )
-    rows>> 4 firstn ; inline
+: columns ( a -- a1 a2 a3 a4 )
+    columns>> 4 firstn ; inline
 
-:: set-rows ( c1 c2 c3 c4 c -- c )
-    c rows>> :> rows
-    c1 rows set-first
-    c2 rows set-second
-    c3 rows set-third
-    c4 rows set-fourth
+:: set-columns ( c1 c2 c3 c4 c -- c )
+    c columns>> :> columns
+    c1 columns set-first
+    c2 columns set-second
+    c3 columns set-third
+    c4 columns set-fourth
     c ; inline
 
 : make-matrix4 ( quot: ( -- c1 c2 c3 c4 ) -- c )
-    matrix4 (struct) swap dip set-rows ; inline
+    matrix4 (struct) swap dip set-columns ; inline
 
-:: 2map-rows ( a b quot -- c )
+:: 2map-columns ( a b quot -- c )
     [
-        a rows :> a4 :> a3 :> a2 :> a1
-        b rows :> b4 :> b3 :> b2 :> b1
+        a columns :> a4 :> a3 :> a2 :> a1
+        b columns :> b4 :> b3 :> b2 :> b1
 
         a1 b1 quot call
         a2 b2 quot call
@@ -44,57 +44,57 @@ M: matrix4 new-sequence 2drop matrix4 (struct) ; inline
         a4 b4 quot call
     ] make-matrix4 ; inline
 
-: map-rows ( a quot -- c )
-    '[ rows _ 4 napply ] make-matrix4 ; inline
+: map-columns ( a quot -- c )
+    '[ columns _ 4 napply ] make-matrix4 ; inline
     
 PRIVATE>
 
-TYPED: m4+ ( a: matrix4 b: matrix4 -- c: matrix4 ) [ v+ ] 2map-rows ;
-TYPED: m4- ( a: matrix4 b: matrix4 -- c: matrix4 ) [ v- ] 2map-rows ;
-TYPED: m4* ( a: matrix4 b: matrix4 -- c: matrix4 ) [ v* ] 2map-rows ;
-TYPED: m4/ ( a: matrix4 b: matrix4 -- c: matrix4 ) [ v/ ] 2map-rows ;
+TYPED: m4+ ( a: matrix4 b: matrix4 -- c: matrix4 ) [ v+ ] 2map-columns ;
+TYPED: m4- ( a: matrix4 b: matrix4 -- c: matrix4 ) [ v- ] 2map-columns ;
+TYPED: m4* ( a: matrix4 b: matrix4 -- c: matrix4 ) [ v* ] 2map-columns ;
+TYPED: m4/ ( a: matrix4 b: matrix4 -- c: matrix4 ) [ v/ ] 2map-columns ;
 
-TYPED: m4*n ( a: matrix4 b: float -- c: matrix4 ) [ v*n ] curry map-rows ;
-TYPED: m4/n ( a: matrix4 b: float -- c: matrix4 ) [ v/n ] curry map-rows ;
-TYPED: n*m4 ( a: float b: matrix4 -- c: matrix4 ) [ n*v ] with map-rows ;
-TYPED: n/m4 ( a: float b: matrix4 -- c: matrix4 ) [ n/v ] with map-rows ;
+TYPED: m4*n ( a: matrix4 b: float -- c: matrix4 ) [ v*n ] curry map-columns ;
+TYPED: m4/n ( a: matrix4 b: float -- c: matrix4 ) [ v/n ] curry map-columns ;
+TYPED: n*m4 ( a: float b: matrix4 -- c: matrix4 ) [ n*v ] with map-columns ;
+TYPED: n/m4 ( a: float b: matrix4 -- c: matrix4 ) [ n/v ] with map-columns ;
 
 TYPED:: m4. ( a: matrix4 b: matrix4 -- c: matrix4 )
     [
-        a rows :> a4 :> a3 :> a2 :> a1
-        b rows :> b4 :> b3 :> b2 :> b1
-
-        a1 first  b1 n*v :> c1a
-        a2 first  b1 n*v :> c2a
-        a3 first  b1 n*v :> c3a
-        a4 first  b1 n*v :> c4a
-
-        a1 second b2 n*v c1a v+ :> c1b 
-        a2 second b2 n*v c2a v+ :> c2b
-        a3 second b2 n*v c3a v+ :> c3b
-        a4 second b2 n*v c4a v+ :> c4b
-
-        a1 third  b3 n*v c1b v+ :> c1c 
-        a2 third  b3 n*v c2b v+ :> c2c
-        a3 third  b3 n*v c3b v+ :> c3c
-        a4 third  b3 n*v c4b v+ :> c4c
-
-        a1 fourth b4 n*v c1c v+
-        a2 fourth b4 n*v c2c v+
-        a3 fourth b4 n*v c3c v+
-        a4 fourth b4 n*v c4c v+
+        a columns :> a4 :> a3 :> a2 :> a1
+        b columns :> b4 :> b3 :> b2 :> b1
+
+        b1 first  a1 n*v :> c1a
+        b2 first  a1 n*v :> c2a
+        b3 first  a1 n*v :> c3a
+        b4 first  a1 n*v :> c4a
+
+        b1 second a2 n*v c1a v+ :> c1b 
+        b2 second a2 n*v c2a v+ :> c2b
+        b3 second a2 n*v c3a v+ :> c3b
+        b4 second a2 n*v c4a v+ :> c4b
+
+        b1 third  a3 n*v c1b v+ :> c1c 
+        b2 third  a3 n*v c2b v+ :> c2c
+        b3 third  a3 n*v c3b v+ :> c3c
+        b4 third  a3 n*v c4b v+ :> c4c
+
+        b1 fourth a4 n*v c1c v+
+        b2 fourth a4 n*v c2c v+
+        b3 fourth a4 n*v c3c v+
+        b4 fourth a4 n*v c4c v+
     ] make-matrix4 ;
 
-TYPED:: v.m4 ( a: float-4 b: matrix4 -- c: float-4 )
-    b rows :> b4 :> b3 :> b2 :> b1
+TYPED:: m4.v ( m: matrix4 v: float-4 -- v': float-4 )
+    m columns :> m4 :> m3 :> m2 :> m1
     
-    a first  b1 n*v
-    a second b2 n*v v+
-    a third  b3 n*v v+
-    a fourth b4 n*v v+ ;
+    v first  m1 n*v
+    v second m2 n*v v+
+    v third  m3 n*v v+
+    v fourth m4 n*v v+ ;
 
-TYPED:: m4.v ( a: matrix4 b: float-4 -- c: float-4 )
-    a rows [ b v. ] 4 napply float-4-boa ;
+TYPED:: v.m4 ( v: float-4 m: matrix4 -- c: float-4 )
+    m columns [ v v. ] 4 napply float-4-boa ;
 
 CONSTANT: identity-matrix4
     S{ matrix4 f
@@ -131,37 +131,37 @@ TYPED: diagonal-matrix4 ( diagonal: float-4 -- matrix: matrix4 )
     [ (vmerge) ] bi-curry@ bi* ; inline
 
 TYPED: transpose-matrix4 ( matrix: matrix4 -- matrix: matrix4 )
-    [ rows vmerge-transpose vmerge-transpose ] make-matrix4 ;
+    [ columns vmerge-transpose vmerge-transpose ] make-matrix4 ;
+
+: linear>homogeneous ( v -- v' )
+    [ float-4{ t t t f } ] dip float-4{ 0.0 0.0 0.0 1.0 } v? ; inline
 
 : scale-matrix4 ( factors -- matrix )
-    [ float-4{ t t t f } ] dip float-4{ 0.0 0.0 0.0 1.0 } v?
-    diagonal-matrix4 ; inline
+    linear>homogeneous diagonal-matrix4 ; inline
 
 : ortho-matrix4 ( factors -- matrix )
     float-4{ 1.0 1.0 1.0 1.0 } swap v/ scale-matrix4 ; inline
 
-TYPED:: translation-matrix4 ( offset: float-4 -- matrix: matrix4 )
+TYPED: translation-matrix4 ( offset: float-4 -- matrix: matrix4 )
     [
-        float-4{ 1.0 1.0 1.0 1.0 } :> diagonal
-
-        offset 0 float-4-with (vmerge)
-        [ 0 float-4-with swap (vmerge) ] bi@ drop :> z :> y :> x
-
-        diagonal y vmerge-diagonal*
-        [ x vmerge-diagonal* ]
-        [ z vmerge-diagonal* ] bi*
+        linear>homogeneous
+        [ 
+            float-4{ 1.0 0.0 0.0 0.0 }
+            float-4{ 0.0 1.0 0.0 0.0 }
+            float-4{ 0.0 0.0 1.0 0.0 }
+        ] dip
     ] make-matrix4 ;
 
 TYPED:: rotation-matrix4 ( axis: float-4 theta: float -- matrix: matrix4 )
-    !   x*x + c*(1.0 - x*x)   x*y*(1.0 - c) - s*z   x*z*(1.0 - c) + s*y   0
-    !   x*y*(1.0 - c) + s*z   y*y + c*(1.0 - y*y)   y*z*(1.0 - c) - s*x   0
-    !   x*z*(1.0 - c) - s*y   y*z*(1.0 - c) + s*x   z*z + c*(1.0 - z*z)   0
+    !   x*x + c*(1.0 - x*x)   x*y*(1.0 - c) + s*z   x*z*(1.0 - c) - s*y   0
+    !   x*y*(1.0 - c) - s*z   y*y + c*(1.0 - y*y)   y*z*(1.0 - c) + s*x   0
+    !   x*z*(1.0 - c) + s*y   y*z*(1.0 - c) - s*x   z*z + c*(1.0 - z*z)   0
     !   0                     0                     0                     1
     matrix4 (struct) :> triangle-m
     theta cos :> c
     theta sin :> s
 
-    float-4{  1.0 -1.0  1.0 0.0 } :> triangle-sign
+    float-4{ -1.0  1.0 -1.0 0.0 } :> triangle-sign
 
     c float-4-with :> cc
     s float-4-with :> ss
@@ -184,7 +184,7 @@ TYPED:: rotation-matrix4 ( axis: float-4 theta: float -- matrix: matrix4 )
     triangle-lo { 1 0 3 3 } vshuffle
     float-4 new
 
-    triangle-m set-rows drop
+    triangle-m set-columns drop
 
     diagonal-m triangle-m m4+ ;
 
@@ -194,8 +194,10 @@ TYPED:: frustum-matrix4 ( xy: float-4 near: float far: float -- matrix: matrix4
         float-4{ t t f f } xy near far - float-4-with v? ! denom
         v/ :> fov
         
-        fov 0.0 float-4-with (vmerge-head) vmerge-diagonal
-        fov float-4{ f f t t } vand
-        float-4{ 0.0 0.0 -1.0 0.0 }
+        float-4{ 0.0 -1.0 0.0 0.0 } :> negone
+
+        fov vmerge-diagonal
+        [ vmerge-diagonal ]
+        [ negone (vmerge) ] bi*
     ] make-matrix4 ;