aboutsummaryrefslogtreecommitdiff
path: root/src/Game/Entities.hs
blob: 6506a6078c3e63698aeb1942e24556b139a1d799 (plain)
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