objdemo: pass view matrix from haskell.

1 files changed, 27 insertions, 8 deletions

diff --git a/mainObj.hs b/mainObj.hs
index 1513075..caa4fa4 100644
--- a/mainObj.hs
+++ b/mainObj.hs
@@ -13,23 +13,31 @@ import Data.Text (Text)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import qualified Data.Vector     as V
+import Data.Vector.Generic as VG (init,snoc)
 import GI.Gdk.Objects
 import GI.GLib.Constants
 import GI.Gtk                    as Gtk hiding (main)
 import LambdaCube.GL             as LC
 import LambdaCube.GL.Mesh        as LC
+import Numeric.LinearAlgebra hiding ((<>))
 import System.Environment
 import System.IO
 import System.IO.Error
 
 import GLWidget
+import LambdaCube.GL.HMatrix
 import LambdaCubeWidget
 import TimeKeeper
 import LoadMesh
 import InfinitePlane
 import MtlParser (ObjMaterial(..))
+import Matrix
 
-type State = (TimeKeeper, TickCallbackHandle)
+-- State created by uploadState.
+data State = State
+    { stTimeKeeper   :: TimeKeeper
+    , stTickCallback :: TickCallbackHandle
+    }
 
 addOBJToObjectArray :: GLStorage -> String -> [(GPUMesh, Maybe Text)] -> Map Text (ObjMaterial,TextureData) -> IO [LC.Object]
 addOBJToObjectArray storage slotName objMesh mtlLib = forM objMesh $ \(mesh,mat) -> do
@@ -57,17 +65,28 @@ uploadState obj glarea storage = do
     -- setup FrameClock
     tm <- newTimeKeeper
     tickcb <- widgetAddTickCallback glarea (tick tm)
-    return (tm,tickcb)
+
+    return State
+        { stTimeKeeper   = tm
+        , stTickCallback = tickcb
+        }
 
 destroyState :: GLArea -> State -> IO ()
-destroyState glarea (tm,tickcb) = do
-    widgetRemoveTickCallback glarea tickcb
+destroyState glarea st = do
+    widgetRemoveTickCallback glarea (stTickCallback st)
 
 setUniforms :: glctx -> GLStorage -> State -> IO ()
-setUniforms gl storage (tm,_) = do
-    t <- withMVar (tmSeconds tm) return
+setUniforms gl storage st = do
+    t <- getSeconds $ stTimeKeeper st
+    let tf = realToFrac t :: Float
+        roZ = rotMatrixZ (-tf)
+        roX = rotMatrixX (-tf)
+        ro = roZ <> roX
+        pos = VG.init (ro #> fromList [0,0,10,0])
+        up = VG.init (ro #> fromList [0,1,0,0])
+        cam = lookat pos 0 up
     LC.updateUniforms storage $ do
-      "time" @= return (realToFrac t :: Float)
+      "cam" @= return (cam :: Matrix Float)
 
 main :: IO ()
 main = do
@@ -82,7 +101,7 @@ main = do
           defObjectArray "plane" Triangles $ do
             "position"  @: Attribute_V4F
           defUniforms $ do
-            "time"            @: Float
+            "cam"             @: M44F
             "diffuseTexture"  @: FTexture2D
             "diffuseColor"    @: V4F
         return $ (,) <$> mobj <*> mpipeline