some ST functions for Mat4

Gruntfile.js

@@ -13,11 +13,11 @@ module.exports = function(grunt) {
 
         psc: {
             options: {
-                main: "Data.ST.Matrix",
-                modules: ["Data.ST.Matrix"]
+                main: "Test",
+                modules: ["Test"]
             },
             test1: {
-              src: ["src/Data/ST/Matrix.purs","<%=libFiles%>"],
+              src: ["src/Test.purs","<%=libFiles%>"],
               dest: "test1.js"
             }
         },

src/Data/ST/Matrix.purs

@@ -33,9 +33,6 @@ import Control.Apply
 import Prelude.Unsafe
 import Math
 
-import Debug.Trace (print)
-import Extensions
-
 
 data STMat s h a = STMat [[a]] (STArray h a)
 {-
@@ -87,19 +84,14 @@ foreign import unsafeThaw """
 
 
 
-type STMat4 h = STMat Four h Number
-
-
 -- TODO unify slicing by splitting function in Data.Matrix 
 
 
 -- careful, clears stack!
 identityST :: forall s h r. (M.Matrix (M.Mat s) Number) => Eff (st :: ST h | r) (STMat s h Number)
 identityST =
-    let
-        m   = M.identity :: M.Mat s Number
-        arr = unsafeThaw $ M.toArray $ m
-    in return (STMat [] arr) 
+    let m = M.identity :: M.Mat s Number
+    in STMat [] <$> thaw (M.toArray m)
 
 transposeST :: forall s h r a. (M.Matrix (M.Mat s) a) => (STMat s h a) -> Eff (st :: ST h | r) (STMat s h a)
 transposeST (STMat st arr) =
@@ -108,7 +100,7 @@ transposeST (STMat st arr) =
         m   = M.fromArray x :: M.Mat s a
         m'  = M.transpose m
         ar' = unsafeThaw $ M.toArray $ m'
-    in return (STMat st ar') 
+    in return (STMat st ar')                                            -- TODO needs testing! 
 
 {-
 instance eqMat :: (Eq a) => Eq (Mat s a) where
@@ -177,15 +169,4 @@ runSTMatrix :: forall s a r. (forall h. Eff (st :: ST h | r) (STMat s h a)) -> E
 runSTMatrix eff = M.Mat <$> runSTMatrixInt eff
 
 
-testm = M.identity      :: M.Mat4
-
-ble :: forall h r . Eff (st :: ST h | r) (STMat4 h)
--- ble = fromMatrix (M.fromArray [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16]) >>= stackPush >>= scaleSTMatrix 2 >>= stackPop
-ble = identityST >>= scaleSTMatrix 2
-
-
-main = do
-    xs <- runSTMatrix ble
-    print xs
-
 

src/Data/ST/Matrix4.purs

@@ -1,7 +1,7 @@
 -----------------------------------------------------------------------------
 --
--- Module      :  Matrix
--- Copyright   :  Jürgen Nicklisch-Franken
+-- Module      :  ST.Matrix4
+-- Copyright   :  Michael Karg
 -- License     :  Apache-2.0
 --
 -- Maintainer  :  [email protected]
@@ -15,31 +15,22 @@
 module Data.ST.Matrix4 where
 
 import Data.TypeNat
-import Data.Matrix
+import Data.Matrix4
+import Data.ST.Matrix
 import qualified Data.Vector3 as V3
 import qualified Data.Vector as V
-
+import Control.Monad.Eff
+import Control.Monad.ST (ST())
+import Control.Apply
 import Data.Array
+import Data.Array.ST
 import Prelude.Unsafe
 import Math
 
 
-type Vec3N = V3.Vec3 Number
-type Mat4 = Mat Four Number
-
-mat4 :: [Number] -> Mat4
-mat4 = fromArray
-
--- | Multiply a V.Vector by a 4x4 matrix: m * v
-transform :: Mat4 -> Vec3N -> Vec3N
-transform (Mat [x11, x12, x13, x14, x21, x22, x23, x24, x31, x32, x33, x34, x41, x42, x43, x44]) v =
-  let t1 = V.Vec[x11,x21,x31]
-      t2 = V.Vec[x12,x22,x32]
-      t3 = V.Vec[x13,x23,x33]
-      t4 = V.Vec[x14,x24,x34]
-      w  = V.dot v t4 + x44
-  in V.Vec [(V.dot v t1 + x41) / w,(V.dot v t2 + x42) / w,(V.dot v t3 + x43) / w]
+type STMat4 h = STMat Four h Number
 
+{-
 -- | Computes the inverse of the given matrix m, assuming that the matrix is
 --   orthonormal.
 inverseOrthonormal :: Mat4 -> Mat4
@@ -176,48 +167,69 @@ makeRotate angle axis =
               x*y*c1-z*s,y*y*c1+c,y*z*c1+x*s,0,
               x*z*c1+y*s,y*z*c1-x*s,z*z*c1+c,0,
               0,0,0,1]
+-}
+
+
+foreign import rotateSTInt """
+  function rotateSTInt(angle) {
+      return function(a){
+        return function(arr){
+           return function(){
+             var l      = Math.sqrt (a[0]*a[0] + a[1]*a[1] + a[2]*a[2]);
+             var im     = 1.0 / l;
+             var x      = a[0] * im;
+             var y      = a[1] * im;
+             var z      = a[2] * im;
+             var c      = Math.cos (angle);
+             var c1     = 1-c
+             var s      = Math.sin (angle);
+             var xs     = x*s;
+             var ys     = y*s;
+             var zs     = z*s;
+             var xyc1   = x*y*c1;
+             var xzc1   = x*z*c1;
+             var yzc1   = y*z*c1;
+             var t11    = x*x*c1+c;
+             var t21    = xyc1+zs;
+             var t31    = xzc1-ys;
+             var t12    = xyc1-zs;
+             var t22    = y*y*c1+c;
+             var t32    = yzc1+xs;
+             var t13    = xzc1+ys;
+             var t23    = yzc1-xs;
+             var t33    = z*z*c1+c;           
+
+             var m  = arr.slice();
+             for (var i=0; i<4; i++){
+                arr[i] = m[i] * t11 + m[i+4] * t21 + m[i+8] * t31;
+                arr[i+4] = m[i] * t12 + m[i+4] * t22 + m[i+8] * t32;
+                arr[i+8] = m[i] * t13 + m[i+4] * t23 + m[i+8] * t33;
+             };
+           };
+        };
+      };
+  }""" :: forall h r. Number -> [Number] -> STArray h Number -> Eff (st :: ST h | r) Unit
+
+
+rotateST :: forall h r. Number -> Vec3N -> STMat4 h -> Eff (st :: ST h | r) (STMat4 h)
+rotateST angle (V.Vec a) v@(STMat _ arr) = rotateSTInt angle a arr *> return v
+
+foreign import translate3STInt """
+  function translate3STInt(a) {
+      return function(m){
+           return function(){
+             for (var i=0; i<4; i++){
+                m[i+12] += m[i] * a[0] + m[i+4] * a[1] + m[i+8] * a[2];
+             };
+           };
+      };
+  }""" :: forall h r. [Number] -> STArray h Number -> Eff (st :: ST h | r) Unit
 
--- | Concatenates a rotation in radians about an axis to the given matrix.
-rotate :: Number -> Vec3N -> Mat4 -> Mat4
-rotate angle (V.Vec [a0,a1,a2])
-    (Mat [m11, m21, m31, m41, m12, m22, m32, m42, m13, m23, m33, m43, m14, m24, m34, m44]) =
-  let l = sqrt (a0*a0 + a1*a1 + a2*a2)
-      im = 1.0 / l
-      x = a0 * im
-      y = a1 * im
-      z = a2 * im
-      c = cos angle
-      c1 = 1-c
-      s = sin angle
-      xs = x*s
-      ys = y*s
-      zs = z*s
-      xyc1 = x * y * c1
-      xzc1 = x * z * c1
-      yzc1 = y * z * c1
-      t11 = x * x * c1 + c
-      t21 = xyc1 + zs
-      t31 = xzc1 - ys
-      t12 = xyc1 - zs
-      t22 = y * y * c1 + c
-      t32 = yzc1 + xs
-      t13 = xzc1 + ys
-      t23 = yzc1 - xs
-      t33 = z * z * c1 + c
-  in Mat [m11 * t11 + m12 * t21 + m13 * t31,
-            m21 * t11 + m22 * t21 + m23 * t31,
-              m31 * t11 + m32 * t21 + m33 * t31,
-                m41 * t11 + m42 * t21 + m43 * t31,
-          m11 * t12 + m12 * t22 + m13 * t32,
-            m21 * t12 + m22 * t22 + m23 * t32,
-              m31 * t12 + m32 * t22 + m33 * t32,
-                m41 * t12 + m42 * t22 + m43 * t32,
-          m11 * t13 + m12 * t23 + m13 * t33,
-            m21 * t13 + m22 * t23 + m23 * t33,
-              m31 * t13 + m32 * t23 + m33 * t33,
-                m41 * t13 + m42 * t23 + m43 * t33,
-          m14,m24,m34,m44]
+translateST :: forall h r. Vec3N -> STMat4 h -> Eff (st :: ST h | r) (STMat4 h)
+translateST (V.Vec a) v@(STMat _ arr) =
+    translate3STInt a arr *> return v
 
+{-
 -- | Creates a transformation matrix for scaling by 3 scalar values, one for
 -- each of the x, y, and z directions.
 makeScale3 :: Number -> Number -> Number -> Mat4
@@ -256,20 +268,7 @@ makeTranslate3 x y z = Mat [1,0,0,0,
 makeTranslate :: Vec3N -> Mat4
 makeTranslate (V.Vec [x,y,z]) = makeTranslate3 x y z
 
--- | Concatenates a translation to the given matrix.
-translate3 :: Number -> Number -> Number -> Mat4 -> Mat4
-translate3 x y z (Mat [m11, m21, m31, m41, m12, m22, m32, m42, m13, m23, m33, m43, m14, m24, m34, m44]) =
-  Mat [m11, m21, m31, m41,
-        m12, m22, m32, m42,
-        m13, m23, m33, m43,
-        m11 * x + m12 * y + m13 * z + m14,
-          m21 * x + m22 * y + m23 * z + m24,
-            m31 * x + m32 * y + m33 * z + m34,
-              m41 * x + m42 * y + m43 * z + m44]
 
--- | Concatenates a translation to the given matrix.
-translate :: Vec3N -> Mat4 -> Mat4
-translate (V.Vec [x,y,z]) m = translate3 x y z m
 
 -- | Creates a transformation matrix for a camera.
 -- Parameters:
@@ -301,3 +300,4 @@ makeBasis (V.Vec [x0,x1,x2]) (V.Vec [y0,y1,y2]) (V.Vec [z0,z1,z2])=
         y0,y1,y2,0,
         z0,z1,z2,0,
         0,0,0,1]
+-}

src/Test.purs

@@ -0,0 +1,38 @@
+
+module Test where
+
+import qualified Data.Matrix4 as M
+import qualified Data.ST.Matrix4 as M
+import qualified Data.Matrix as M
+import qualified Data.ST.Matrix as M
+import qualified Data.Vector as V
+
+import Control.Monad.Eff
+import Control.Monad.ST (ST())
+import Debug.Trace (print)
+
+
+ble :: forall h r . Eff (st :: ST h | r) (M.STMat4 h)
+-- ble = fromMatrix (M.fromArray [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16]) >>= stackPush >>= scaleSTMatrix 2 >>= stackPop
+-- ble = M.identityST >>= M.scaleSTMatrix 2
+ble = M.identityST
+
+meh :: M.Vec3N
+meh = V.Vec [0.5,1.5,0.9]
+
+ys :: M.Mat4
+ys = M.rotate 90 meh $ M.identity
+
+zs :: M.Mat4
+zs = M.translate meh $ M.identity
+
+main = do
+
+    xs <- M.runSTMatrix (ble >>= M.rotateST 90 meh)
+    print xs
+    print ys
+
+
+    bs <- M.runSTMatrix (ble >>= M.translateST meh)
+    print bs
+    print zs