1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
module Game.Entities (Entities, Entity, mkEntities, updateAll, render, renderVisible, playerPosition) where
import Control.Monad
import Data.Bits (Bits (..))
import Data.Foldable (find, traverse_)
import Data.IORef
import Data.List (sort)
import qualified Game.Controller as C
import Game.Entities.Common
import Game.Entities.Const
import Game.Entities.Effect
import Game.Entities.Pickup
import Game.Entities.Player
import Game.Entities.Robot
import Game.Entities.Slime
import Game.Entities.Types
import qualified Game.Map as M
import qualified Game.Sprites as S
import qualified Game.State as GS
import SDL (($~))
import qualified SDL
mkEntities :: S.SpriteSheet -> M.Map -> IORef C.Controls -> IORef GS.State -> IO Entities
mkEntities sprites m controls stateRef = do
player <- case find M.isPlayer (M.objects m) of
Just (M.PlayerEntity x y) -> mkPlayer sprites x y controls (M.isBlocked m)
_ -> error "No player entity in map"
playerRef <- newIORef player
entities <- traverse (toEntity playerRef) $ sort $ filter (not . M.isPlayer) (M.objects m)
-- the entities list has always player first
pure $ Entities sprites playerRef stateRef (player : entities)
where
toEntity :: IORef Entity -> M.Object -> IO Entity
toEntity playerRef (M.SlimeEntity x y) = mkSlime sprites x y (collision playerRef 16) (M.isBlocked m)
toEntity playerRef (M.RobotEntity x y) = mkRobot sprites x y (collision playerRef 24) (M.isBlocked m)
toEntity playerRef (M.BatteryEntity x y) = mkBattery sprites x y (collision playerRef 16)
toEntity _ (M.PlayerEntity _ _) = error "Player already processed"
-- | Return the player's entity position (x, y).
playerPosition :: Entities -> (Int, Int)
playerPosition (Entities _ _ _ entities) =
(player.x, player.y)
where
player = head entities
updateAll :: Entities -> IO Entities
updateAll es = do
-- update the player first (including the reference)
updatedPlayer <- player.update player
void $ writeIORef es.player updatedPlayer
state <- readIORef stateRef
-- update hit delay if the player was hit
let playerWasHit = state.hitDelay > 0
when playerWasHit (writeIORef stateRef state {GS.hitDelay = state.hitDelay - 1})
-- then the other entities
updated <- (updatedPlayer :) <$> traverse (updateFilter playerWasHit) others
-- process actions
updated' <- processActions updated (concatMap (\e -> e.actions) updated)
-- clear actions, filter out destroyed entities, and add the new ones
pure es {entities = map (\e -> e {actions = []}) (filter (\e -> not e.destroy) updated')}
where
stateRef = es.state
player = head es.entities
others = tail es.entities
-- the actions can add new entities of modify existing ones
processActions :: [Entity] -> [Action] -> IO [Entity]
processActions ents (a : t) =
case a of
ActionAddDustEffect x y -> do
effect <- mkEffect es.sprites x y "dust"
processActions (ents ++ [effect]) t
ActionAddBattery -> do
stateRef $~ (\s -> s {GS.batteries = s.batteries + 1})
processActions ents t
ActionHitPlayer -> do
s <- readIORef stateRef
ents' <-
if s.lives == 1
then do
writeIORef stateRef s {GS.lives = 0, GS.gameOverDelay = gameOverDelay}
pure $ (head ents) {dir = Dying, gravity = gravityUp, frame = 0} : tail ents
else do
writeIORef stateRef s {GS.lives = s.lives - 1, GS.hitDelay = hitDelay}
pure ents
processActions ents' t
processActions ents [] = pure ents
-- Update entities skipping enemies if the player was hit.
updateFilter :: Bool -> Entity -> IO Entity
updateFilter False e = e.update e
updateFilter True e
| notEnemy e = e.update e
| otherwise = pure e
notEnemy :: Entity -> Bool
notEnemy ent = case ent.typ of
TypeEnemy -> False
_ -> True
-- | Render only visible entities according to the provided viewport.
renderVisible :: SDL.Renderer -> Entities -> M.Viewport -> IO ()
renderVisible renderer (Entities sprites player state entities) v =
render renderer (Entities sprites player state visible)
where
-- FIXME: entities should have size so we can be exact here and
-- avoid the hardcoded size
visible = filter (\e -> isVisible v e.x e.y 16 16) entities
isVisible :: M.Viewport -> Int -> Int -> Int -> Int -> Bool
isVisible (M.Viewport vx vy vw vh) x y w h =
x < vx + vw && vx < x + w && y < vy + vh && vy < y + h
render :: SDL.Renderer -> Entities -> IO ()
render renderer es = do
state <- readIORef es.state
-- if the player was hit, make the enemies wiggle before unfreezing
if state.hitDelay == 0 || state.hitDelay > hitDelay `div` 3
then traverse_ renderOne others
else traverse_ (renderWiggling ((.&.) 2 state.hitDelay)) others
-- always render player last
-- won't draw all the frames if the player was hit
if testBit state.hitDelay 2 then pure () else renderOne player
where
player = head es.entities
others = tail es.entities
renderWiggling :: Int -> Entity -> IO ()
renderWiggling m e = case e.typ of
TypeEnemy -> renderOne e {x = e.x + m}
_ -> renderOne e
renderOne :: Entity -> IO ()
renderOne e =
S.render renderer e.sprite e.x e.y set e.frame
where
set = toSpriteSet e.dir
|
