From 2f03adc8f4ac45061eaac39c412fb5cce3635121 Mon Sep 17 00:00:00 2001 From: nek0 Date: Wed, 23 Dec 2020 07:47:20 +0100 Subject: [PATCH] add player and tinker around --- pituicat.cabal | 1 + res/shaders/frag.shader | 6 ++-- src/Classes/Prop.hs | 4 +++ src/Scenes/Test.hs | 56 +++++++++++++++++++++++++-------- src/Types.hs | 1 + src/Types/Graphics/Texture.hs | 2 +- src/Types/Map.hs | 8 ++--- src/Types/Player.hs | 58 +++++++++++++++++++++++++++++++++++ 8 files changed, 116 insertions(+), 20 deletions(-) create mode 100644 src/Types/Player.hs diff --git a/pituicat.cabal b/pituicat.cabal index 99d846a..d11b8e5 100644 --- a/pituicat.cabal +++ b/pituicat.cabal @@ -30,6 +30,7 @@ executable pituicat , Types.Graphics.IndexBuffer , Types.Graphics.Shader , Types.Util + , Types.Player , Classes , Classes.Scene , Classes.Actor diff --git a/res/shaders/frag.shader b/res/shaders/frag.shader index 7592df4..b5b4e56 100644 --- a/res/shaders/frag.shader +++ b/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); } diff --git a/src/Classes/Prop.hs b/src/Classes/Prop.hs index ba9a9ab..e919c91 100644 --- a/src/Classes/Prop.hs +++ b/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 () diff --git a/src/Scenes/Test.hs b/src/Scenes/Test.hs index 818c31f..3e90045 100644 --- a/src/Scenes/Test.hs +++ b/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) diff --git a/src/Types.hs b/src/Types.hs index dc496ec..c47b519 100644 --- a/src/Types.hs +++ b/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 diff --git a/src/Types/Graphics/Texture.hs b/src/Types/Graphics/Texture.hs index 7d2a312..dbd4b91 100644 --- a/src/Types/Graphics/Texture.hs +++ b/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 diff --git a/src/Types/Map.hs b/src/Types/Map.hs index a2d2a40..b358ab9 100644 --- a/src/Types/Map.hs +++ b/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 ] ) diff --git a/src/Types/Player.hs b/src/Types/Player.hs new file mode 100644 index 0000000..e629747 --- /dev/null +++ b/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