Pass entire model-view-projection matrix from haskell.

3 files changed, 16 insertions, 22 deletions

diff --git a/Matrix.hs b/Matrix.hs
index 07dbab8..2e27d08 100644
--- a/Matrix.hs
+++ b/Matrix.hs
@@ -54,11 +54,6 @@ lookat pos target up = fromRows
 {-# SPECIALIZE lookat :: Vector R -> Vector R -> Vector R -> Matrix R #-}
 
 
-
--- lookat pos target up <> rot t
---    == lookat ((((pos - target) <# rot (-t))) + target)
---              target
---
 -- | Perspective transformation 4×4 matrix.
 perspective :: (Storable a, Floating a) =>
                 a    -- ^ Near plane clipping distance (always positive).
@@ -67,10 +62,10 @@ perspective :: (Storable a, Floating a) =>
                 -> a -- ^ Aspect ratio, i.e. screen's width\/height.
                 -> Matrix a
 perspective n f fovy aspect = (4><4)
-    [ (2*n/(r-l))    , 0             , 0              , 0
-    , 0              , (2*n/(t-b))   , 0              , 0
-    , (-(r+l)/(r-l)) , ((t+b)/(t-b)) , (-(f+n)/(f-n)) , (-1)
-    , 0              , 0             , (-2*f*n/(f-n)) , 0    ]
+    [ (2*n/(r-l)) , 0           , (-(r+l)/(r-l)) , 0
+    , 0           , (2*n/(t-b)) , ((t+b)/(t-b))  , 0
+    , 0           , 0           , (-(f+n)/(f-n)) , (-2*f*n/(f-n))
+    , 0           , 0           , (-1)           , 0              ]
   where
     t = n*tan(fovy/2)
     b = -t
diff --git a/hello_obj2.lc b/hello_obj2.lc
index 7adf8b1..5a95ad7 100644
--- a/hello_obj2.lc
+++ b/hello_obj2.lc
@@ -1,12 +1,6 @@
-deg30 = 0.5235987755982988 -- pi/6
 
 coordmap (cam::Mat 4 4 Float) (p::Vec 4 Float)
-    = perspective 0.1 -- near plane
-                  100 -- far plane
-                deg30 -- y fov radians
-                    1 -- aspect ratio w/h
-                      *. cam
-                      *. p
+    = cam *. p
 
 blendplane = -- NoBlending -- BlendLogicOp Xor
     Blend (FuncAdd,FuncAdd)
diff --git a/mainObj.hs b/mainObj.hs
index 9792ff6..0d53a26 100644
--- a/mainObj.hs
+++ b/mainObj.hs
@@ -74,18 +74,23 @@ destroyState :: GLArea -> State -> IO ()
 destroyState glarea st = do
     widgetRemoveTickCallback glarea (stTickCallback st)
 
+deg30 :: Float
+deg30 = pi/6
+
 setUniforms :: glctx -> GLStorage -> State -> IO ()
 setUniforms gl storage st = do
     t <- getSeconds $ stTimeKeeper st
     let tf = realToFrac t :: Float
-        roZ = rotMatrixZ (-tf)
-        roX = rotMatrixX (-tf)
-        ro = roZ <> roX
-        pos = ro #> fromList [0,0,10]
-        up = ro #> fromList [0,1,0]
+        rot = rotMatrixZ (-tf) <> rotMatrixX (-tf)
+        pos = rot #> fromList [0,0,10]
+        up = rot #> fromList [0,1,0]
         cam = lookat pos 0 up
+        aspect = 1
+        proj = perspective 0.1 100 deg30 aspect
+        mvp = proj <> cam
+
     LC.updateUniforms storage $ do
-      "cam" @= return (cam :: Matrix Float)
+      "cam" @= return (mvp :: Matrix Float)
 
 main :: IO ()
 main = do