first powerup including effects works

This commit is contained in:
nek0 2021-04-29 06:09:32 +02:00
parent 03a577fd18
commit 61451a4a10
5 changed files with 68 additions and 12 deletions

View File

@ -11,14 +11,14 @@ data Effect
| Antidote | Antidote
| StopTime | StopTime
| Invisibility | Invisibility
deriving (Show) deriving (Eq, 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) deriving (Eq, Show)
class Collidible c => Collectable c where class Collidible c => Collectable c where

View File

@ -81,6 +81,7 @@ load level progress = do
tex tex
False False
Nothing Nothing
[]
oil = PowerUp oil = PowerUp
(realToFrac <$> (startpos + V2 200 0)) (realToFrac <$> (startpos + V2 200 0))
(V2 0 0) (V2 0 0)

View File

@ -32,11 +32,6 @@ 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
V.map (move dt) collided
modifyTVar modifyTVar
(testCast level) $ \cast -> (testCast level) $ \cast ->
let playedCast = let playedCast =
@ -77,6 +72,42 @@ update level dt = liftIO $ do
) )
walledCast walledCast
updatedCast <- readTVar (testCast level) updatedCast <- readTVar (testCast level)
oldCat <- fromJust <$> readTVar (testPlayer level)
releasedEffects <- stateTVar (testPowerups level) $ \pus ->
let living = V.foldl
(\acc pu ->
let npu = perform dt pu
in
if puTTL npu > 0
then npu `V.cons` acc
else acc
)
V.empty
pus
indexCollected = V.filter ((/= NoCollision) . snd) $
V.zip (V.fromList [0..length living])
(V.map
(collisionCheck dt oldCat)
living
)
collected = V.foldl
(\acc (ind, _) ->
(living V.! ind) `V.cons` acc
)
V.empty
indexCollected
differ = V.foldl
(\acc life -> if life `V.elem` collected
then acc
else life `V.cons` acc
)
V.empty
living
fin = V.map
(\pu -> move dt $ performWorldCollision pu layer dt)
differ
in
(collected, fin)
modifyTVar modifyTVar
(testPlayer level) $ \(Just pituicat) -> (testPlayer level) $ \(Just pituicat) ->
let playedCat = perform dt pituicat let playedCat = perform dt pituicat
@ -99,7 +130,11 @@ update level dt = liftIO $ do
(\(Cast c) cr -> collide playedCat c cr) (\(Cast c) cr -> collide playedCat c cr)
(updatedCast V.! fst partner, snd partner) (updatedCast V.! fst partner, snd partner)
walledCat = performWorldCollision castCat layer dt walledCat = performWorldCollision castCat layer dt
in Just $ move dt walledCat affectedCat = walledCat
{ pcEffects = pcEffects walledCat ++
map puEffect (V.toList releasedEffects)
}
in Just $ move dt affectedCat
performWorldCollision performWorldCollision
:: (Collidible c) :: (Collidible c)

View File

@ -18,6 +18,7 @@ import Classes.Graphics.Bindable
import Classes.Prop import Classes.Prop
import Classes.Actor import Classes.Actor
import Classes.Physics import Classes.Physics
import Classes.Collectable
import Types.Graphics.VertexBuffer import Types.Graphics.VertexBuffer
import Types.Texture import Types.Texture
@ -36,12 +37,13 @@ data Pituicat = Pituicat
, pcTexture :: Texture , pcTexture :: Texture
, pcGrounded :: Bool , pcGrounded :: Bool
, pcMoveState :: Maybe Action , pcMoveState :: Maybe Action
, pcEffects :: [EffectHolder]
} }
deriving (Eq, Show) deriving (Eq, Show)
instance Drawable Pituicat where instance Drawable Pituicat where
toVertices (Pituicat (V2 x y) _ _ _ _ _ _ _ _) = toVertices (Pituicat (V2 x y) _ _ _ _ _ _ _ _ _) =
( V.fromList [0, 1, 2, 2, 3, 0] ( V.fromList [0, 1, 2, 2, 3, 0]
, V.fromList , V.fromList
[ newVertex [ newVertex
@ -77,13 +79,18 @@ instance Actor Pituicat where
perform dt p = perform dt p =
let (V2 _ dy) = velocity physCat let (V2 _ dy) = velocity physCat
moveFact =
if
null (filter ((SpeedUp ==) . effectReleased) (pcEffects p))
then 1
else 2
physCat = (accelerate dt . gravitate constG) physCat = (accelerate dt . gravitate constG)
(p (p
{ pcAcc = V2 0 0 { pcAcc = V2 0 0
, pcTMoveVel = , pcTMoveVel =
case pcMoveState p of case pcMoveState p of
Just MoveRight -> V2 catMoveVelocity 0 Just MoveRight -> V2 (catMoveVelocity * moveFact) 0
Just MoveLeft -> V2 (-catMoveVelocity) 0 Just MoveLeft -> V2 ((-catMoveVelocity) * moveFact) 0
_ -> V2 0 0 _ -> V2 0 0
} }
) )
@ -93,6 +100,19 @@ instance Actor Pituicat where
, pcGrounded = if pcGrounded physCat , pcGrounded = if pcGrounded physCat
then not (abs dy * dt > 2) then not (abs dy * dt > 2)
else False else False
, pcEffects =
foldl
(\acc eff ->
let nduration = effectDuration eff - dt
in
if nduration > 0
then
eff { effectDuration = nduration} : acc
else
acc
)
[]
(pcEffects p)
} }
in in
A.log A.Debug ("*meow* am at: " <> (fromString $ show $ pcPos finalCat)) finalCat A.log A.Debug ("*meow* am at: " <> (fromString $ show $ pcPos finalCat)) finalCat

View File

@ -26,7 +26,7 @@ data PowerUp = PowerUp
, puTexture :: Texture , puTexture :: Texture
, puEffect :: EffectHolder , puEffect :: EffectHolder
} }
deriving (Show) deriving (Eq, Show)
instance Drawable PowerUp where instance Drawable PowerUp where