add player and tinker around

This commit is contained in:
nek0 2020-12-23 07:47:20 +01:00
parent a859814fda
commit 2f03adc8f4
8 changed files with 116 additions and 20 deletions

View File

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

View File

@ -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);
}

View File

@ -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 ()

View File

@ -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)

View File

@ -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

View File

@ -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

View File

@ -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
]
)

58
src/Types/Player.hs Normal file
View File

@ -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