add player and tinker around

pituicat.cabal

@@ -30,6 +30,7 @@ executable pituicat
                      , Types.Graphics.IndexBuffer
                      , Types.Graphics.Shader
                      , Types.Util
+                     , Types.Player
                      , Classes
                      , Classes.Scene
                      , Classes.Actor

res/shaders/frag.shader

@@ -6,12 +6,12 @@ in vec4 v_color;
 in vec2 v_texCoord;
 in float v_texIndex;
 
-uniform sampler2D u_texture;
+uniform sampler2D[2] u_textures;
 
 void main()
 {
   //vec4 texColor = texture(u_texture, v_texCoord);
-  //int index = int(v_texIndex);
-  color = texture(u_texture, v_texCoord);
+  int index = int(v_texIndex);
+  color = texture(u_textures[index], v_texCoord);
   //color = vec4(0.0, 1.0, 0.0, 1.0);
 }

src/Classes/Prop.hs

@@ -4,6 +4,10 @@ module Classes.Prop where
 
 import Classes.Graphics.Drawable
 
+import Types.Texture
+
 class (Drawable a) => Prop a where
 
   residentLayer :: a -> Word
+
+  bindPropTexture :: a -> IO ()

src/Scenes/Test.hs

@@ -38,7 +38,7 @@ data GLAssets = GLAssets
   , glVB :: VertexBuffer
   , glIB :: IndexBuffer
   , glSP :: Shader
-  , glTx :: Texture
+  , glTx :: [Texture]
   }
 
 instance Scene Test where
@@ -91,7 +91,6 @@ instance Scene Test where
     addBuffer (undefined :: Vertex) vertexBuffer
 
     (_, tex) <- newTexture "res/pituicat/pituicat.png" 1
-
     bind tex
 
     shader <- newShader
@@ -101,7 +100,22 @@ instance Scene Test where
 
     bind shader
     setUniform shader "u_mvp" (projection !*! view !*! model)
-    setUniform shader "u_texture" (0 :: GL.GLint)
+    setUniformList
+      shader
+      "u_textures"
+      (map
+        ((\(GL.TextureObject o) -> o) . textureId)
+        [ (tileMapTexture $ mapTileMap loadedMap)
+        , tex
+        ]
+        )
+
+    let pituicat = Pituicat
+          (V2 0 (-1748))
+          (V2 0 0)
+          (V2 0 0)
+          100
+          tex
 
     unbind vertexArray
     unbind vertexBuffer
@@ -111,7 +125,8 @@ instance Scene Test where
 
     atomically $ do
       putTMVar (testGraphics level)
-        (GLAssets vertexArray vertexBuffer indexBuffer shader tex)
+        (GLAssets vertexArray vertexBuffer indexBuffer shader [tex])
+      modifyTVar (testStageSet level) (\set -> StageSet pituicat `V.cons` set)
       writeTVar (testLoaded level) True
 
     void $ atomically $ do
@@ -119,7 +134,7 @@ instance Scene Test where
       putTMVar progress (1, "Loaded graphics!")
 
 
-  isSceneLoaded = liftIO . atomically . readTVar . testLoaded
+  isSceneLoaded = liftIO . readTVarIO . testLoaded
 
   update level dt = liftIO $ do
     logIO Debug ("FPS: " <> fromString (show $ 1 / dt))
@@ -132,22 +147,39 @@ instance Scene Test where
     (LevelMap layers _ _ tileMap _) <-
       atomically (readTMVar $ testMap level)
 
-    stageSet <- atomically (readTVar $ testStageSet level)
-    cast <- atomically (readTVar $ testCast level)
+    logIO Debug "loaded level"
+
+    stageSet <- readTVarIO (testStageSet level)
+    cast <- readTVarIO (testCast level)
+
+    logIO Debug "Read stage set and cast"
 
     let (indices, vertices) = populate layers stageSet cast
 
+    logIO Debug "Populated"
+
     bind va
     bind vb
-
-    write vb 0 (VS.convert vertices)
-
     bind ib
 
+    logIO Debug "Bound buffers"
+
+    write vb 0 vertices
+
+    logIO Debug ("Written " <> fromString (show $ VS.length vertices) <> " vertices")
+
     write ib 0 (VS.map fromIntegral indices)
+
+    logIO Debug ("Written " <> fromString (show $ VS.length vertices) <> " indices")
+
+    logIO Debug "Wrote buffers"
+
     bind (tileMapTexture tileMap)
+    mapM_ (\(StageSet p) -> bindPropTexture p) stageSet
     R.draw va ib sh
 
+    logIO Debug "Drawn"
+
 testLevelDesc :: LevelDescriptor
 testLevelDesc = LevelDescriptor
   [ (0, "res/maps/00_test/00_test.bmp")
@@ -198,7 +230,7 @@ populate layers props actors =
                 , avs V.++ nvs)
               )
             (V.empty, V.empty)
-            (propsHere)
+            propsHere
           (cisRaw, cvs) = V.foldl
             (\(ais, avs) (Cast c) ->
               let (nis, nvs) = toVertices c
@@ -207,7 +239,7 @@ populate layers props actors =
                 , avs V.++ nvs)
               )
             (V.empty, V.empty)
-            (actorsHere)
+            actorsHere
           (lisRaw, lvs) = toVertices l
           lis = V.map
             (+ if null is then 0 else V.maximum is)

src/Types.hs

@@ -9,4 +9,5 @@ import Types.Texture as T
 import Types.Cast as T
 import Types.StageSet as T
 import Types.Graphics as T
+import Types.Player as T
 import Types.Util as T

src/Types/Graphics/Texture.hs

@@ -42,7 +42,7 @@ newTexture fp slot = do
   eimg <- readImage fp
 
   case eimg of
-    Left err ->
+    Left err -> do
       let mesg = ("reading file " <> fp <> " failed: " <> show err)
       logIO Error (fromString mesg)
       return $ Left mesg

src/Types/Map.hs

@@ -54,22 +54,22 @@ instance Drawable Tile where
         (V3 (fromIntegral x * 32) (fromIntegral y * 32) 0)
         (V4 0 0 0 1)
         (V2 u1 v1)
-        (fromIntegral 0)
+        0
       , newVertex
         (V3 (fromIntegral (x + 1) * 32) (fromIntegral y * 32) 0)
         (V4 0 0 0 1)
         (V2 u2 v1)
-        (fromIntegral 0)
+        0
       , newVertex
         (V3 (fromIntegral (x + 1) * 32) (fromIntegral (y + 1) * 32) 0)
         (V4 0 0 0 1)
         (V2 u2 v2)
-        (fromIntegral 0)
+        0
       , newVertex
         (V3 (fromIntegral x * 32) (fromIntegral (y + 1) * 32) 0)
         (V4 0 0 0 1)
         (V2 u1 v2)
-        (fromIntegral 0)
+        0
       ]
     )
 

src/Types/Player.hs

@@ -0,0 +1,58 @@
+module Types.Player where
+
+import qualified Graphics.Rendering.OpenGL as GL
+
+import Linear
+
+import qualified Data.Vector as V
+
+-- internal imports
+
+import Classes.Graphics.Drawable
+import Classes.Graphics.Bindable
+import Classes.Prop
+
+import Types.Graphics.VertexBuffer
+import Types.Texture
+
+data Pituicat = Pituicat
+  { pcPos  :: V2 Double
+  , pcVel :: V2 Double
+  , pcAcc :: V2 Double
+  , pcHealth :: Int
+  , pcTexture :: Texture
+  }
+
+instance Drawable Pituicat where
+
+  toVertices (Pituicat pos@(V2 x y) _ _ _ tex) =
+    ( V.fromList [0, 1, 2, 2, 3, 0]
+    , V.fromList
+      [ newVertex
+        (V3 (realToFrac x - 25) (realToFrac y - 25) 0)
+        (V4 0 0 0 1)
+        (V2 0 (1 - 50 / 1024))
+        1
+      , newVertex
+        (V3 (realToFrac x + 25) (realToFrac y - 25) 0)
+        (V4 0 0 0 1)
+        (V2 (50 / 1024) (1 - 50 / 1024))
+        1
+      , newVertex
+        (V3 (realToFrac x + 25) (realToFrac y + 25) 0)
+        (V4 0 0 0 1)
+        (V2 (50 / 1024) 1)
+        1
+      , newVertex
+        (V3 (realToFrac x - 25) (realToFrac y + 25) 0)
+        (V4 0 0 0 1)
+        (V2 (50 / 1024) 1)
+        1
+      ]
+    )
+
+instance Prop Pituicat where
+
+  residentLayer _ = 0
+
+  bindPropTexture = bind . pcTexture