make camera follow the cat

src/Scenes/Test.hs

@@ -5,6 +5,8 @@ module Scenes.Test
 
 import Affection as A
 
+import Linear
+
 import qualified Data.Vector.Storable as VS
 import qualified Data.Vector as V
 
@@ -33,6 +35,7 @@ instance Scene Test where
       <*> newTVarIO Nothing
       <*> newTVarIO V.empty
       <*> newTVarIO V.empty
+      <*> newTVarIO (PVM identity identity identity)
       <*> newTVarIO []
 
   loadScene = load
@@ -52,6 +55,17 @@ instance Scene Test where
     nonPlayerCast <- readTVarIO (testCast level)
     pituicat <- atomically $ readTVar (testPlayer level)
     let cast = Cast (fromJust pituicat) `V.cons` nonPlayerCast
+        playerPos@(V2 px py) = realToFrac <$> (pcPos $ fromJust pituicat)
+
+    atomically $ modifyTVar (testMatrices level) $ \pvm ->
+      pvm
+        { pvmV = mkTransformationMat
+            identity
+            (V3 (400 - px) (300 - py) 0)
+        }
+
+    (PVM p v m) <- atomically $ readTVar (testMatrices level)
+    setUniform sh "u_mvp" (p !*! v !*! m)
 
     let (indices, vertices) = populate layers stageSet cast
 

src/Scenes/Test/Load.hs

@@ -34,12 +34,6 @@ load level progress = do
     putTMVar progress (0.5, "Loaded test level map!")
   void $ atomically $ swapTVar (testLoaded level) True
 
-  let projection = ortho 0 800 0 600 (-1) 1 :: M44 GL.GLfloat
-      view = mkTransformationMat
-        (identity :: M33 GL.GLfloat)
-        (V3 0 ((-64) * 32 + 600) 0)
-      model = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0)
-
   vertexArray <- newVertexArray
 
   bind vertexArray
@@ -70,6 +64,23 @@ load level progress = do
     , ShaderSource GL.FragmentShader "./res/shaders/frag.shader"
     ]
 
+  let projection = ortho 0 800 0 600 (-1) 1 :: M44 GL.GLfloat
+      view = mkTransformationMat
+        (identity :: M33 GL.GLfloat)
+        (V3 (400 - sx) (300 - sy) 0)
+      model = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0)
+      startpos@(V2 sx sy) = V2 100 1948
+      pituicat = Pituicat
+        (realToFrac <$> startpos)
+        (V2 0 0)
+        (V2 0 0)
+        (V2 0 0)
+        (V2 0 0)
+        100
+        tex
+        False
+        Nothing
+
   bind shader
   setUniform shader "u_mvp" (projection !*! view !*! model)
   setUniformList
@@ -82,17 +93,6 @@ load level progress = do
       ]
       )
 
-  let pituicat = Pituicat
-        (V2 100 1948)
-        (V2 0 1)
-        (V2 0 0)
-        (V2 0 0)
-        (V2 0 0)
-        100
-        tex
-        False
-        Nothing
-
   unbind vertexArray
   unbind vertexBuffer
   unbind indexBuffer
@@ -104,6 +104,7 @@ load level progress = do
       (GLAssets vertexArray vertexBuffer indexBuffer shader [tex])
     writeTVar (testPlayer level) (Just pituicat)
     writeTVar (testLoaded level) True
+    writeTVar (testMatrices level) (PVM projection view model)
 
   void $ atomically $ do
     void $ takeTMVar progress

src/Scenes/Test/Types.hs

@@ -2,6 +2,8 @@ module Scenes.Test.Types where
 
 import Affection
 
+import Linear
+
 import Control.Concurrent.STM
 
 import qualified Data.Vector as V
@@ -17,6 +19,7 @@ data Test = Test
   , testPlayer   :: TVar (Maybe Pituicat)
   , testStageSet :: TVar (V.Vector StageSet)
   , testCast     :: TVar (V.Vector Cast)
+  , testMatrices :: TVar PVM
   , testClean    :: TVar [UUID]
   }
 
@@ -27,3 +30,9 @@ data GLAssets = GLAssets
   , glSP :: Shader
   , glTx :: [Texture]
   }
+
+data PVM = PVM
+  { pvmP :: M44 Float
+  , pvmV :: M44 Float
+  , pvmM :: M44 Float
+  }