start collectables
This commit is contained in:
parent
039d567be8
commit
2ec22ea6b0
11 changed files with 156 additions and 9 deletions
|
@ -36,6 +36,7 @@ executable pituicat
|
||||||
, Classes.Scene
|
, Classes.Scene
|
||||||
, Classes.Actor
|
, Classes.Actor
|
||||||
, Classes.Prop
|
, Classes.Prop
|
||||||
|
, Classes.Collectable
|
||||||
, Classes.Graphics
|
, Classes.Graphics
|
||||||
, Classes.Graphics.Bindable
|
, Classes.Graphics.Bindable
|
||||||
, Classes.Graphics.Buffer
|
, Classes.Graphics.Buffer
|
||||||
|
@ -44,7 +45,6 @@ executable pituicat
|
||||||
, Classes.Physics
|
, Classes.Physics
|
||||||
, Classes.Physics.Mass
|
, Classes.Physics.Mass
|
||||||
, Classes.Physics.Collidible
|
, Classes.Physics.Collidible
|
||||||
, Classes.Physics.Collectable
|
|
||||||
, Scenes.Test
|
, Scenes.Test
|
||||||
, Scenes.Test.Types
|
, Scenes.Test.Types
|
||||||
, Scenes.Test.Util
|
, Scenes.Test.Util
|
||||||
|
|
|
@ -7,3 +7,4 @@ import Classes.Scene as C
|
||||||
import Classes.Prop as C
|
import Classes.Prop as C
|
||||||
import Classes.Actor as C
|
import Classes.Actor as C
|
||||||
import Classes.Physics as C
|
import Classes.Physics as C
|
||||||
|
import Classes.Collectable as C
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
module Classes.Physics.Collectable where
|
module Classes.Collectable where
|
||||||
|
|
||||||
import Classes.Physics.Collidible (Collidible)
|
import Classes.Physics.Collidible (Collidible)
|
||||||
|
|
||||||
|
@ -11,12 +11,14 @@ data Effect
|
||||||
| Antidote
|
| Antidote
|
||||||
| StopTime
|
| StopTime
|
||||||
| Invisibility
|
| Invisibility
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
-- | The Effect holder type definition
|
-- | The Effect holder type definition
|
||||||
data EffectHolder = EffectHolder
|
data EffectHolder = EffectHolder
|
||||||
{ effectDuration :: Double -- ^ Duration of stored effect
|
{ effectDuration :: Double -- ^ Duration of stored effect
|
||||||
, effectReleased :: Effect -- ^ The actual effect released
|
, effectReleased :: Effect -- ^ The actual effect released
|
||||||
}
|
}
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
class Collidible c => Collectable c where
|
class Collidible c => Collectable c where
|
||||||
|
|
|
@ -35,6 +35,7 @@ instance Scene Test where
|
||||||
<*> newTVarIO Nothing
|
<*> newTVarIO Nothing
|
||||||
<*> newTVarIO V.empty
|
<*> newTVarIO V.empty
|
||||||
<*> newTVarIO V.empty
|
<*> newTVarIO V.empty
|
||||||
|
<*> newTVarIO V.empty
|
||||||
<*> newTVarIO (PVM identity identity identity)
|
<*> newTVarIO (PVM identity identity identity)
|
||||||
<*> newTVarIO []
|
<*> newTVarIO []
|
||||||
|
|
||||||
|
@ -53,8 +54,11 @@ instance Scene Test where
|
||||||
|
|
||||||
stageSet <- readTVarIO (testStageSet level)
|
stageSet <- readTVarIO (testStageSet level)
|
||||||
nonPlayerCast <- readTVarIO (testCast level)
|
nonPlayerCast <- readTVarIO (testCast level)
|
||||||
pituicat <- atomically $ readTVar (testPlayer level)
|
powerups <- fmap (V.map Cast) (readTVarIO (testPowerups level))
|
||||||
let cast = Cast (fromJust pituicat) `V.cons` nonPlayerCast
|
pituicat <- readTVarIO (testPlayer level)
|
||||||
|
let cast = Cast (fromJust pituicat) `V.cons` powerups
|
||||||
|
-- nonPlayerCast V.++
|
||||||
|
-- powerups
|
||||||
playerPos@(V2 px py) = realToFrac <$> (pcPos $ fromJust pituicat)
|
playerPos@(V2 px py) = realToFrac <$> (pcPos $ fromJust pituicat)
|
||||||
|
|
||||||
atomically $ modifyTVar (testMatrices level) $ \pvm ->
|
atomically $ modifyTVar (testMatrices level) $ \pvm ->
|
||||||
|
@ -67,7 +71,10 @@ instance Scene Test where
|
||||||
(PVM p v m) <- atomically $ readTVar (testMatrices level)
|
(PVM p v m) <- atomically $ readTVar (testMatrices level)
|
||||||
setUniform sh "u_mvp" (p !*! v !*! m)
|
setUniform sh "u_mvp" (p !*! v !*! m)
|
||||||
|
|
||||||
let (indices, vertices) = populate layers stageSet cast
|
let (indices, vertices) = populate
|
||||||
|
layers
|
||||||
|
stageSet
|
||||||
|
cast
|
||||||
|
|
||||||
bind va
|
bind va
|
||||||
bind vb
|
bind vb
|
||||||
|
|
|
@ -3,6 +3,7 @@ module Scenes.Test.Load where
|
||||||
|
|
||||||
import qualified Graphics.Rendering.OpenGL as GL
|
import qualified Graphics.Rendering.OpenGL as GL
|
||||||
|
|
||||||
|
import qualified Data.Vector as V
|
||||||
import qualified Data.Vector.Storable as VS
|
import qualified Data.Vector.Storable as VS
|
||||||
|
|
||||||
import Control.Concurrent.STM
|
import Control.Concurrent.STM
|
||||||
|
@ -38,7 +39,7 @@ load level progress = do
|
||||||
|
|
||||||
bind vertexArray
|
bind vertexArray
|
||||||
|
|
||||||
vertexBuffer <- newVertexBuffer 1024
|
vertexBuffer <- newVertexBuffer 4096
|
||||||
|
|
||||||
bind vertexBuffer
|
bind vertexBuffer
|
||||||
|
|
||||||
|
@ -80,6 +81,14 @@ load level progress = do
|
||||||
tex
|
tex
|
||||||
False
|
False
|
||||||
Nothing
|
Nothing
|
||||||
|
oil = PowerUp
|
||||||
|
(realToFrac <$> (startpos) + V2 100 0)
|
||||||
|
(V2 0 0)
|
||||||
|
(V2 0 0)
|
||||||
|
5
|
||||||
|
tex
|
||||||
|
(EffectHolder 5 SpeedUp)
|
||||||
|
|
||||||
|
|
||||||
bind shader
|
bind shader
|
||||||
setUniform shader "u_mvp" (projection !*! view !*! model)
|
setUniform shader "u_mvp" (projection !*! view !*! model)
|
||||||
|
@ -103,6 +112,7 @@ load level progress = do
|
||||||
putTMVar (testGraphics level)
|
putTMVar (testGraphics level)
|
||||||
(GLAssets vertexArray vertexBuffer indexBuffer shader [tex])
|
(GLAssets vertexArray vertexBuffer indexBuffer shader [tex])
|
||||||
writeTVar (testPlayer level) (Just pituicat)
|
writeTVar (testPlayer level) (Just pituicat)
|
||||||
|
writeTVar (testPowerups level) (V.fromList [oil])
|
||||||
writeTVar (testLoaded level) True
|
writeTVar (testLoaded level) True
|
||||||
writeTVar (testMatrices level) (PVM projection view model)
|
writeTVar (testMatrices level) (PVM projection view model)
|
||||||
|
|
||||||
|
|
|
@ -19,6 +19,7 @@ data Test = Test
|
||||||
, testPlayer :: TVar (Maybe Pituicat)
|
, testPlayer :: TVar (Maybe Pituicat)
|
||||||
, testStageSet :: TVar (V.Vector StageSet)
|
, testStageSet :: TVar (V.Vector StageSet)
|
||||||
, testCast :: TVar (V.Vector Cast)
|
, testCast :: TVar (V.Vector Cast)
|
||||||
|
, testPowerups :: TVar (V.Vector PowerUp)
|
||||||
, testMatrices :: TVar PVM
|
, testMatrices :: TVar PVM
|
||||||
, testClean :: TVar [UUID]
|
, testClean :: TVar [UUID]
|
||||||
}
|
}
|
||||||
|
|
|
@ -32,6 +32,11 @@ update level dt = liftIO $ do
|
||||||
atomically $ do
|
atomically $ do
|
||||||
lmap <- readTMVar (testMap level)
|
lmap <- readTMVar (testMap level)
|
||||||
let layer = mapLayers lmap V.! fromIntegral (mapWalkLayer lmap)
|
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
|
modifyTVar
|
||||||
(testCast level) $ \cast ->
|
(testCast level) $ \cast ->
|
||||||
let playedCast =
|
let playedCast =
|
||||||
|
|
|
@ -11,3 +11,4 @@ import Types.StageSet as T
|
||||||
import Types.Graphics as T
|
import Types.Graphics as T
|
||||||
import Types.Player as T
|
import Types.Player as T
|
||||||
import Types.Util as T
|
import Types.Util as T
|
||||||
|
import Types.PowerUp as T
|
||||||
|
|
|
@ -35,7 +35,7 @@ data Pituicat = Pituicat
|
||||||
, pcHealth :: Int
|
, pcHealth :: Int
|
||||||
, pcTexture :: Texture
|
, pcTexture :: Texture
|
||||||
, pcGrounded :: Bool
|
, pcGrounded :: Bool
|
||||||
, pcMoveState :: Maybe Action
|
, pcMoveState :: Maybe Action
|
||||||
}
|
}
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
@ -79,7 +79,7 @@ instance Actor Pituicat where
|
||||||
let (V2 _ dy) = velocity physCat
|
let (V2 _ dy) = velocity physCat
|
||||||
physCat = (accelerate dt . gravitate constG)
|
physCat = (accelerate dt . gravitate constG)
|
||||||
(p
|
(p
|
||||||
{ pcAcc = 0
|
{ pcAcc = V2 0 0
|
||||||
, pcTMoveVel =
|
, pcTMoveVel =
|
||||||
case pcMoveState physCat of
|
case pcMoveState physCat of
|
||||||
Just MoveRight -> V2 catMoveVelocity 0
|
Just MoveRight -> V2 catMoveVelocity 0
|
||||||
|
|
120
src/Types/PowerUp.hs
Normal file
120
src/Types/PowerUp.hs
Normal file
|
@ -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
|
|
@ -1,6 +1,6 @@
|
||||||
{-# LANGUAGE ExistentialQuantification #-}
|
{-# LANGUAGE ExistentialQuantification #-}
|
||||||
module Types.Tangible where
|
module Types.Tangible where
|
||||||
|
|
||||||
import Classes.Physics.Collectable (Collectable)
|
import Classes.Collectable (Collectable)
|
||||||
|
|
||||||
data Tangible = forall a . Collectable a => Tangible a
|
data Tangible = forall a . Collectable a => Tangible a
|
||||||
|
|
Loading…
Reference in a new issue