From 2ec22ea6b0adb99a03843e7fc3ba354797f1c021 Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 20 Apr 2021 04:19:54 +0200 Subject: [PATCH] start collectables --- pituicat.cabal | 2 +- src/Classes.hs | 1 + src/Classes/{Physics => }/Collectable.hs | 4 +- src/Scenes/Test.hs | 13 ++- src/Scenes/Test/Load.hs | 12 ++- src/Scenes/Test/Types.hs | 1 + src/Scenes/Test/Update.hs | 5 + src/Types.hs | 1 + src/Types/Player.hs | 4 +- src/Types/PowerUp.hs | 120 +++++++++++++++++++++++ src/Types/Tangible.hs | 2 +- 11 files changed, 156 insertions(+), 9 deletions(-) rename src/Classes/{Physics => }/Collectable.hs (88%) create mode 100644 src/Types/PowerUp.hs diff --git a/pituicat.cabal b/pituicat.cabal index 223ece7..a8340ab 100644 --- a/pituicat.cabal +++ b/pituicat.cabal @@ -36,6 +36,7 @@ executable pituicat , Classes.Scene , Classes.Actor , Classes.Prop + , Classes.Collectable , Classes.Graphics , Classes.Graphics.Bindable , Classes.Graphics.Buffer @@ -44,7 +45,6 @@ executable pituicat , Classes.Physics , Classes.Physics.Mass , Classes.Physics.Collidible - , Classes.Physics.Collectable , Scenes.Test , Scenes.Test.Types , Scenes.Test.Util diff --git a/src/Classes.hs b/src/Classes.hs index e978f77..9f9c453 100644 --- a/src/Classes.hs +++ b/src/Classes.hs @@ -7,3 +7,4 @@ import Classes.Scene as C import Classes.Prop as C import Classes.Actor as C import Classes.Physics as C +import Classes.Collectable as C diff --git a/src/Classes/Physics/Collectable.hs b/src/Classes/Collectable.hs similarity index 88% rename from src/Classes/Physics/Collectable.hs rename to src/Classes/Collectable.hs index bae864f..9550e22 100644 --- a/src/Classes/Physics/Collectable.hs +++ b/src/Classes/Collectable.hs @@ -1,4 +1,4 @@ -module Classes.Physics.Collectable where +module Classes.Collectable where import Classes.Physics.Collidible (Collidible) @@ -11,12 +11,14 @@ data Effect | Antidote | StopTime | Invisibility + deriving (Show) -- | The Effect holder type definition data EffectHolder = EffectHolder { effectDuration :: Double -- ^ Duration of stored effect , effectReleased :: Effect -- ^ The actual effect released } + deriving (Show) class Collidible c => Collectable c where diff --git a/src/Scenes/Test.hs b/src/Scenes/Test.hs index 5c2c2da..0f2c5a2 100644 --- a/src/Scenes/Test.hs +++ b/src/Scenes/Test.hs @@ -35,6 +35,7 @@ instance Scene Test where <*> newTVarIO Nothing <*> newTVarIO V.empty <*> newTVarIO V.empty + <*> newTVarIO V.empty <*> newTVarIO (PVM identity identity identity) <*> newTVarIO [] @@ -53,8 +54,11 @@ instance Scene Test where stageSet <- readTVarIO (testStageSet level) nonPlayerCast <- readTVarIO (testCast level) - pituicat <- atomically $ readTVar (testPlayer level) - let cast = Cast (fromJust pituicat) `V.cons` nonPlayerCast + powerups <- fmap (V.map Cast) (readTVarIO (testPowerups level)) + pituicat <- readTVarIO (testPlayer level) + let cast = Cast (fromJust pituicat) `V.cons` powerups + -- nonPlayerCast V.++ + -- powerups playerPos@(V2 px py) = realToFrac <$> (pcPos $ fromJust pituicat) atomically $ modifyTVar (testMatrices level) $ \pvm -> @@ -67,7 +71,10 @@ instance Scene Test where (PVM p v m) <- atomically $ readTVar (testMatrices level) setUniform sh "u_mvp" (p !*! v !*! m) - let (indices, vertices) = populate layers stageSet cast + let (indices, vertices) = populate + layers + stageSet + cast bind va bind vb diff --git a/src/Scenes/Test/Load.hs b/src/Scenes/Test/Load.hs index 66e0918..aff49c9 100644 --- a/src/Scenes/Test/Load.hs +++ b/src/Scenes/Test/Load.hs @@ -3,6 +3,7 @@ module Scenes.Test.Load where import qualified Graphics.Rendering.OpenGL as GL +import qualified Data.Vector as V import qualified Data.Vector.Storable as VS import Control.Concurrent.STM @@ -38,7 +39,7 @@ load level progress = do bind vertexArray - vertexBuffer <- newVertexBuffer 1024 + vertexBuffer <- newVertexBuffer 4096 bind vertexBuffer @@ -80,6 +81,14 @@ load level progress = do tex False Nothing + oil = PowerUp + (realToFrac <$> (startpos) + V2 100 0) + (V2 0 0) + (V2 0 0) + 5 + tex + (EffectHolder 5 SpeedUp) + bind shader setUniform shader "u_mvp" (projection !*! view !*! model) @@ -103,6 +112,7 @@ load level progress = do putTMVar (testGraphics level) (GLAssets vertexArray vertexBuffer indexBuffer shader [tex]) writeTVar (testPlayer level) (Just pituicat) + writeTVar (testPowerups level) (V.fromList [oil]) writeTVar (testLoaded level) True writeTVar (testMatrices level) (PVM projection view model) diff --git a/src/Scenes/Test/Types.hs b/src/Scenes/Test/Types.hs index daeda6a..5bbe436 100644 --- a/src/Scenes/Test/Types.hs +++ b/src/Scenes/Test/Types.hs @@ -19,6 +19,7 @@ data Test = Test , testPlayer :: TVar (Maybe Pituicat) , testStageSet :: TVar (V.Vector StageSet) , testCast :: TVar (V.Vector Cast) + , testPowerups :: TVar (V.Vector PowerUp) , testMatrices :: TVar PVM , testClean :: TVar [UUID] } diff --git a/src/Scenes/Test/Update.hs b/src/Scenes/Test/Update.hs index 8eee0f9..0dddfb7 100644 --- a/src/Scenes/Test/Update.hs +++ b/src/Scenes/Test/Update.hs @@ -32,6 +32,11 @@ update level dt = liftIO $ do atomically $ do lmap <- readTMVar (testMap level) let layer = mapLayers lmap V.! fromIntegral (mapWalkLayer lmap) + modifyTVar (testPowerups level) $ \pus -> + let played = V.map (perform dt) pus + collided = V.map (\pu -> performWorldCollision pu layer dt) played + in + collided modifyTVar (testCast level) $ \cast -> let playedCast = diff --git a/src/Types.hs b/src/Types.hs index c47b519..c60de68 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -11,3 +11,4 @@ import Types.StageSet as T import Types.Graphics as T import Types.Player as T import Types.Util as T +import Types.PowerUp as T diff --git a/src/Types/Player.hs b/src/Types/Player.hs index 448ec66..fb3cfb2 100644 --- a/src/Types/Player.hs +++ b/src/Types/Player.hs @@ -35,7 +35,7 @@ data Pituicat = Pituicat , pcHealth :: Int , pcTexture :: Texture , pcGrounded :: Bool - , pcMoveState :: Maybe Action + , pcMoveState :: Maybe Action } deriving (Eq, Show) @@ -79,7 +79,7 @@ instance Actor Pituicat where let (V2 _ dy) = velocity physCat physCat = (accelerate dt . gravitate constG) (p - { pcAcc = 0 + { pcAcc = V2 0 0 , pcTMoveVel = case pcMoveState physCat of Just MoveRight -> V2 catMoveVelocity 0 diff --git a/src/Types/PowerUp.hs b/src/Types/PowerUp.hs new file mode 100644 index 0000000..4b6c7f2 --- /dev/null +++ b/src/Types/PowerUp.hs @@ -0,0 +1,120 @@ +module Types.PowerUp where + +import qualified Data.Vector as V + +import Linear + +-- internal imports + +import Classes.Graphics.Drawable +import Classes.Graphics.Bindable +import Classes.Collectable +import Classes.Prop +import Classes.Actor +import Classes.Physics + +import Types.Graphics.VertexBuffer +import Types.Texture + +import Util + +data PowerUp = PowerUp + { puPos :: V2 Double + , puVel :: V2 Double + , puAcc :: V2 Double + , puTTL :: Double + , puTexture :: Texture + , puEffect :: EffectHolder + } + deriving (Show) + +instance Drawable PowerUp where + + toVertices (PowerUp (V2 x y) _ _ _ _ _) = + ( V.fromList [0, 1, 2, 2, 3, 0] + , V.fromList + [ newVertex + (V3 (realToFrac x - 20) (realToFrac y - 20) 0) + (V4 1 1 1 1) + (V2 0 (1 - 50 / 1024)) + 1 + , newVertex + (V3 (realToFrac x + 20) (realToFrac y - 20) 0) + (V4 1 1 1 1) + (V2 (50 / 1024) (1 - 50 / 1024)) + 1 + , newVertex + (V3 (realToFrac x + 20) (realToFrac y + 20) 0) + (V4 1 1 1 1) + (V2 (50 / 1024) 1) + 1 + , newVertex + (V3 (realToFrac x - 20) (realToFrac y + 20) 0) + (V4 1 1 1 1) + (V2 0 1) + 1 + ] + ) + +instance Prop PowerUp where + + residentLayer _ = 0 + + bindPropTexture = bind . puTexture + +instance Actor PowerUp where + + perform dt o = + let phys = (accelerate dt . gravitate constG) + o + { puAcc = V2 0 0 + , puTTL = puTTL o - dt + } + in + phys + +instance Mass PowerUp where + + mass _ = 1 + + acceleration = puAcc + + accelerationUpdater o = + (\acc -> o + { puAcc = acc + } + ) + + velocity = puVel + + velocityUpdater o = + (\vel -> o + { puVel = vel + } + ) + + position = puPos + + positionUpdater o = + (\pos -> o + { puPos = pos + } + ) + +instance Collidible PowerUp where + + boundary _ = + ( V2 (-20) (-20) + , V2 20 20 + ) + + collide o _ NoCollision = o + + collide o other collr@(Collision ddr (V2 dirx diry)) = + let no = elasticCollision 0.3 o other collr + in + no + +instance Collectable PowerUp where + + effect = puEffect diff --git a/src/Types/Tangible.hs b/src/Types/Tangible.hs index add6bbe..5d7516e 100644 --- a/src/Types/Tangible.hs +++ b/src/Types/Tangible.hs @@ -1,6 +1,6 @@ {-# LANGUAGE ExistentialQuantification #-} module Types.Tangible where -import Classes.Physics.Collectable (Collectable) +import Classes.Collectable (Collectable) data Tangible = forall a . Collectable a => Tangible a