aboutsummaryrefslogtreecommitdiff
path: root/src/Game/Entities.hs
blob: 291f10e164197e9d55030d93769d8c5fb6c0dfd0 (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
module Game.Entities (Entities, Entity, mkEntities, updateAll, render) where

import Control.Monad (when)
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 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 playerRef (M.isBlocked m) (hitPlayer stateRef)
    toEntity playerRef (M.RobotEntity x y) = mkRobot sprites x y playerRef (M.isBlocked m) (hitPlayer stateRef)
    toEntity playerRef (M.BatteryEntity x y) = mkBattery sprites x y playerRef (collectedBattery stateRef)
    toEntity _ (M.PlayerEntity _ _) = error "Player already processed"

processSpawn :: S.SpriteSheet -> Spawn -> IO Entity
processSpawn sprites (DustEffectSpawn x y) = mkEffect sprites x y "dust"

updateAll :: Entities -> IO Entities
updateAll es = do
  -- update the player first (including the reference)
  updatedPlayer <- player.update player
  _ <- writeIORef es.player updatedPlayer
  state <- readIORef es.state
  -- update hit delay if the player was hit
  let playerWasHit = state.hitDelay > 0
  when playerWasHit (writeIORef es.state state {GS.hitDelay = state.hitDelay - 1})
  -- then the other entities
  updated <- (updatedPlayer :) <$> traverse (updateFilter playerWasHit) others
  -- collect new entities
  new <- traverse (processSpawn es.sprites) (concatMap (\e -> e.spawns) updated)
  -- clear spawns (new entities), filter out destroyed entities, and add the new ones
  pure es {entities = map (\e -> e {spawns = []}) (filter (\e -> not e.destroy) updated) ++ new}
  where
    player = head es.entities
    others = tail es.entities

    -- 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 :: 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