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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
module Game.Entities
( Entities,
Entity,
mkEntities,
addExit,
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.Entry
import Game.Entities.Exit
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 qualified SDL
mkEntities :: S.SpriteSheet -> M.Map -> IORef C.Controls -> IO Entities
mkEntities sprites m controls = 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 effect of the player "warping" into the level
entryEffect <- mkEntry sprites player.x player.y
-- the entities list has always player first
pure $ Entities sprites playerRef (player : (entryEffect : entities))
where
toEntity :: IORef Entity -> M.Object -> IO Entity
toEntity playerRef (M.SlimeEntity x y d) = mkSlime sprites x y d (collision playerRef 16) (M.isBlocked m)
toEntity playerRef (M.RobotEntity x y d) = mkRobot sprites x y d (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
addExit :: Entities -> Int -> Int -> IO Entities
addExit es x y = do
exit <- mkExit es.sprites x y (collision es.player 24)
pure es {entities = head es.entities : exit : tail es.entities}
updateAll :: Entities -> GS.State -> IO (Entities, GS.State)
updateAll es state = do
-- update the player first (including the reference), unless the level is completed
updatedPlayer <- if state.levelCompleted /= GS.ExitOff then pure player else player.update player
void $ writeIORef es.player updatedPlayer
-- then the other entities
updated <- (updatedPlayer :) <$> traverse (updateFilter $ state.hitDelay > 0) others
-- process actions
(state', updated') <- processActions (updateState state) updated (concatMap (\e -> e.actions) updated)
-- clear actions and filter out destroyed entities
pure (es {entities = map (\e -> e {actions = []}) (filter (\e -> not e.destroy) updated')}, state')
where
player = head es.entities
others = tail es.entities
-- update state counters
updateState :: GS.State -> GS.State
updateState s = if s.hitDelay > 0 then s {GS.hitDelay = s.hitDelay - 1} else s
-- the actions can change the game state, add new entities, and modify existing ones
processActions :: GS.State -> [Entity] -> [Action] -> IO (GS.State, [Entity])
processActions s ents (a : t) =
case a of
ActionAddEffect x y name -> do
effect <- mkEffect es.sprites x y name
processActions s (ents ++ [effect]) t
ActionAddBattery x y ->
processActions s {GS.batteries = s.batteries + 1, GS.lastBattery = (x, y)} ents t
ActionHitPlayer -> do
let (s', ents') =
if s.lives == 1
then
( s {GS.lives = 0, GS.gameOverDelay = gameOverDelay},
-- the player is not in the action, changing then type disables collision detection
(head ents) {typ = TypeEffect, set = dyingSet, gravity = gravityUp, frame = 0} : tail ents
)
else
( s {GS.lives = s.lives - 1, GS.hitDelay = hitDelay},
ents
)
processActions s' ents' t
ActionExitStarted ->
processActions
s {GS.levelCompleted = GS.ExitStarted}
-- the player is not in the action, changing the type disables collision detection
((head ents) {typ = TypeEffect} : tail ents)
t
ActionEntryDone -> processActions s {GS.levelCompleted = GS.ExitOff} ents t
ActionExitDone -> processActions s {GS.levelCompleted = GS.ExitDone} ents t
processActions s ents [] = pure (s, 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 and state.
renderVisible :: SDL.Renderer -> Entities -> M.Viewport -> GS.State -> IO ()
renderVisible renderer (Entities sprites player entities) v = render renderer (Entities sprites player 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 all entities according to the provided state.
-- Use renderVisible to only render the entities that are in the viewport area.
render :: SDL.Renderer -> Entities -> GS.State -> IO ()
render renderer es state = do
-- 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
-- or we are exiting the level
if testBit state.hitDelay 2 || state.levelCompleted /= GS.ExitOff 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 e.set e.frame
|
