Haskell roguelike - Multiple levels
A second level
Supporting only a single level is not much of an improvement. Lets look at what is required to support multiple levels and changing levels on some event.
Stairs
In this example the player is going to move from level one to level two by going down the stairs
18_multi_level/src/EntityType.hs (8 to 18)
data EntityType = Blank
| Door
| DoorClosed
| Wall
| Player
| Bug
| Snake
| Dark
| Stairs
| Unknown
deriving (Show, Eq, Ord)
18_multi_level/src/Entities.hs (27 to 27)
Level two
The world now needs to track which level is currently active.
18_multi_level/src/GameCore.hs (79 to 79)
As there are two possible levels.
18_multi_level/src/GameCore.hs (107 to 108)
Handling events
Levels will have different entities and different interactions rules. There is no way a global handler should try to keep track of all of this.
Previously tryMoveActor in GameEngine.hs did the collision detection etc. To support the levels this code is removed and each level gets to decide what is allowed.
Each level has its own tryMove function
18_multi_level/src/GameCore.hs (99 to 103)
data Level = Level { _lvlName :: !Text
, _lvlBoot :: !(World -> World)
, _lvlMapText :: !Text
, _lvlTryMove :: !([Actor] -> Maybe E.EntityType -> World -> WorldPos -> Actor -> [RogueAction])
}
ActMoveActor and ActGotoLevel are added as actions. These are new actions that the level can request.
18_multi_level/src/GameCore.hs (115 to 119)
data RogueAction = ActMovePlayer (Int, Int)
| ActMoveActor Actor WorldPos
| ActSetPlayerViewPortStyle ViewPortStyle
| ActTogglePlayerProp Text Text
| ActGotoLevel Levels
These actions are returned when GameEngine’s tryMoveActor calls the current level’s lvlTryMove and are passed to runActions for execution as before.
18_multi_level/src/GameEngine.hs (484 to 487)
-- Get actions
actions = (world ^. wdLevel ^. lvlTryMove) destActors destEntityType world tryWorldTo' actor
in
Just $ runActions world actions
Moves
Handling moves is nothing new, just the code that was in tryMoveActor moved out to the ActMoveActor case
18_multi_level/src/GameEngine.hs (435 to 441)
ActMoveActor actor worldPos ->
let
movedActor = actor & acWorldPos .~ worldPos
w2 = updatePlayerViewport $ updateActor world movedActor
pa = w2 ^. wdPlayer ^. plActor
in
updateActor w2 (updateActorFov w2 pa)
Changing levels
Changing levels is then a call to bootWorld with the requested level and the existing connection, screen size and stdGen properties.
18_multi_level/src/GameEngine.hs (445 to 451)
ActGotoLevel l ->
bootWorld
(world ^. wdPlayer ^. plConn)
(world ^. wdPlayer ^. plScreenSize)
(world ^. wdPlayer ^. plActor ^. acStdGen)
(world ^. wdGetLevel)
l
Levels
Level one
The only addition to level one is tryMove, which does the collision detection. If the player steps on the stairs then it returns ActGotoLevel
18_multi_level/src/Levels/Level01.hs (69 to 77)
tryMove :: [Actor] -> Maybe E.EntityType -> World -> WorldPos -> Actor -> [RogueAction]
tryMove destActors destEntityType _ posTo movingActor =
-- Is the move allowed
case (destActors, destEntityType) of
([], Just E.Blank) -> [ActMoveActor movingActor posTo]
([], Just E.Door) -> [ActMoveActor movingActor posTo]
([], Nothing) -> [ActMoveActor movingActor posTo]
(_, Just E.Stairs) -> [ActGotoLevel Levels02]
_ -> []
Level two
Level two does nothing exiting
18_multi_level/src/Levels/Level02.hs (12 to 30)
mkLevel :: Text -> Level
mkLevel mapData = Level { _lvlName = "L02"
, _lvlBoot = bootLevel
, _lvlMapText = mapData
, _lvlTryMove = tryMove
}
bootLevel :: World -> World
bootLevel w = w
tryMove :: [Actor] -> Maybe E.EntityType -> World -> WorldPos -> Actor -> [RogueAction]
tryMove destActors destEntityType _ posTo movingActor =
-- Is the move allowed
case (destActors, destEntityType) of
([], Just E.Blank) -> [ActMoveActor movingActor posTo]
([], Just E.Door) -> [ActMoveActor movingActor posTo]
([], Nothing) -> [ActMoveActor movingActor posTo]
_ -> []
Main
Finally the main function loads the maps as before
18_multi_level/app/Main.hs (15 to 23)
main :: IO ()
main = do
map01 <- Txt.readFile "worlds/simple.csv"
map02 <- Txt.readFile "worlds/level02.csv"
GE.runGame (getLevel map01 map02)
getLevel :: Text -> Text -> GC.Levels -> GC.Level
getLevel map01 _ GC.Levels01 = L01.mkLevel map01
getLevel _ map02 GC.Levels02 = L02.mkLevel map02
Levels
That is it, we now support multiple levels and each level can have its own collision logic.
Chapters
Changes
src/Entities.hs
diff -w -B -a -d -u -b -r --new-file 17_levels/src/Entities.hs 18_multi_level/src/Entities.hs
--- 17_levels/src/Entities.hs
+++ 18_multi_level/src/Entities.hs
@@ -23,6 +23,9 @@
, (E.Bug , (25, 3), Nothing)
, (E.Snake , (38, 4), Nothing)
, (E.Dark , (43, 11), Nothing)
+
+ , (E.Stairs , (56, 44), Just "s")
+
]
in
let mkData (typ, pos@(x, y), l) (tiles', entities', loads') =
src/EntityType.hs
diff -w -B -a -d -u -b -r --new-file 17_levels/src/EntityType.hs 18_multi_level/src/EntityType.hs
--- 17_levels/src/EntityType.hs
+++ 18_multi_level/src/EntityType.hs
@@ -12,5 +13,7 @@
| Bug
| Snake
| Dark
+ | Stairs
| Unknown
deriving (Show, Eq, Ord)
+
src/GameCore.hs
diff -w -B -a -d -u -b -r --new-file 17_levels/src/GameCore.hs 18_multi_level/src/GameCore.hs
--- 17_levels/src/GameCore.hs
+++ 18_multi_level/src/GameCore.hs
@@ -74,9 +74,10 @@
, _wdMinMoveEnergy :: !Int -- ^ min energy required before any more, regardless of cost, can be attempted
, _wdEnergyIncrements :: !Int -- ^ amount of energy that is added per game loop
, _wdUtilBrainAnnotations :: ![(E.EntityType, [UtilAnnotationEntry], [UtilAnnotationEntry])]
-
, _wdGetLevel :: !(Levels -> Level)
+ , _wdLevel :: !Level
+
}
data Config = Config { _cfgKeys :: !(Map Text Text)
@@ -98,11 +99,13 @@
data Level = Level { _lvlName :: !Text
, _lvlBoot :: !(World -> World)
, _lvlMapText :: !Text
+ , _lvlTryMove :: !([Actor] -> Maybe E.EntityType -> World -> WorldPos -> Actor -> [RogueAction])
}
data Levels = Levels01
+ | Levels02
newtype WorldPos = WorldPos (Int, Int) deriving (Show, Eq, Ord)
@@ -108,9 +111,12 @@
newtype WorldPos = WorldPos (Int, Int) deriving (Show, Eq, Ord)
newtype PlayerPos = PlayerPos (Int, Int) deriving (Show, Eq, Ord)
+
data RogueAction = ActMovePlayer (Int, Int)
+ | ActMoveActor Actor WorldPos
| ActSetPlayerViewPortStyle ViewPortStyle
| ActTogglePlayerProp Text Text
+ | ActGotoLevel Levels
data ViewPortStyle = ViewPortCentre
src/GameEngine.hs
diff -w -B -a -d -u -b -r --new-file 17_levels/src/GameEngine.hs 18_multi_level/src/GameEngine.hs
--- 17_levels/src/GameEngine.hs
+++ 18_multi_level/src/GameEngine.hs
@@ -79,15 +79,14 @@
Left "missing / invalid screen size"
Just (width, height) ->
- Right $ bootWorld conn (width, height) std getLevel
-
+ Right $ bootWorld conn (width, height) std getLevel Levels01
-bootWorld :: Host.Connection -> (Int, Int) -> Rnd.StdGen -> (Levels -> Level) -> World
-bootWorld conn screenSize std getLevel =
+bootWorld :: Host.Connection -> (Int, Int) -> Rnd.StdGen -> (Levels -> Level) -> Levels -> World
+bootWorld conn screenSize std getLevel startLevel =
let
config = mkConfig
- level = getLevel Levels01
+ level = getLevel startLevel
w1 = World { _wdPlayer = mkPlayer
, _wdConfig = config
@@ -97,6 +96,7 @@
, _wdEnergyIncrements = 20
, _wdUtilBrainAnnotations = []
, _wdGetLevel = getLevel
+ , _wdLevel = level
}
w2 = level ^. lvlBoot $ w1
@@ -432,6 +431,26 @@
ActTogglePlayerProp prop valEnabled ->
world & (wdPlayer . plActor . acProps) %~ Map.alter (toggleMapProp valEnabled) prop
+
+ ActMoveActor actor worldPos ->
+ let
+ movedActor = actor & acWorldPos .~ worldPos
+ w2 = updatePlayerViewport $ updateActor world movedActor
+ pa = w2 ^. wdPlayer ^. plActor
+ in
+ updateActor w2 (updateActorFov w2 pa)
+
+
+
+ ActGotoLevel l ->
+ bootWorld
+ (world ^. wdPlayer ^. plConn)
+ (world ^. wdPlayer ^. plScreenSize)
+ (world ^. wdPlayer ^. plActor ^. acStdGen)
+ (world ^. wdGetLevel)
+ l
+
+
where
toggleMapProp v Nothing = Just v
toggleMapProp _ (Just _) = Nothing
@@ -461,23 +480,13 @@
destEntityType = _enType <$> destEntity
-- Actors at destination
destActors = filter (\a -> a ^. acWorldPos == tryWorldTo') (getAllActors world)
- -- Is the move allowed
- canMove = case (destActors, destEntityType) of
- ([], Just E.Blank) -> True
- ([], Just E.Door) -> True
- ([], Nothing) -> True
- _ -> False
- in
- if canMove
- then
- let
- movedActor = actor & acWorldPos .~ tryWorldTo'
- w2 = updatePlayerViewport $ updateActor world movedActor
- pa = w2 ^. wdPlayer ^. plActor
+
+ -- Get actions
+ actions = (world ^. wdLevel ^. lvlTryMove) destActors destEntityType world tryWorldTo' actor
in
- Just $ updateActor w2 (updateActorFov w2 pa)
- else
- Nothing
+ Just $ runActions world actions
+
+
updateActorFov :: World -> Actor -> Actor
updateActorFov w a =
src/Levels/Level01.hs
diff -w -B -a -d -u -b -r --new-file 17_levels/src/Levels/Level01.hs 18_multi_level/src/Levels/Level01.hs
--- 17_levels/src/Levels/Level01.hs
+++ 18_multi_level/src/Levels/Level01.hs
@@ -21,6 +20,7 @@
mkLevel mapData = Level { _lvlName = "L01"
, _lvlBoot = bootLevel
, _lvlMapText = mapData
+ , _lvlTryMove = tryMove
}
bootLevel :: World -> World
@@ -65,3 +65,14 @@
, _acProps = Map.empty
}
+
+tryMove :: [Actor] -> Maybe E.EntityType -> World -> WorldPos -> Actor -> [RogueAction]
+tryMove destActors destEntityType _ posTo movingActor =
+ -- Is the move allowed
+ case (destActors, destEntityType) of
+ ([], Just E.Blank) -> [ActMoveActor movingActor posTo]
+ ([], Just E.Door) -> [ActMoveActor movingActor posTo]
+ ([], Nothing) -> [ActMoveActor movingActor posTo]
+ (_, Just E.Stairs) -> [ActGotoLevel Levels02]
+ _ -> []
+
src/Levels/Level02.hs
diff -w -B -a -d -u -b -r --new-file 17_levels/src/Levels/Level02.hs 18_multi_level/src/Levels/Level02.hs
--- 17_levels/src/Levels/Level02.hs
+++ 18_multi_level/src/Levels/Level02.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Levels.Level02 where
+
+import Protolude
+
+import GameCore
+import qualified EntityType as E
+
+
+mkLevel :: Text -> Level
+mkLevel mapData = Level { _lvlName = "L02"
+ , _lvlBoot = bootLevel
+ , _lvlMapText = mapData
+ , _lvlTryMove = tryMove
+ }
+
+bootLevel :: World -> World
+bootLevel w = w
+
+
+tryMove :: [Actor] -> Maybe E.EntityType -> World -> WorldPos -> Actor -> [RogueAction]
+tryMove destActors destEntityType _ posTo movingActor =
+ -- Is the move allowed
+ case (destActors, destEntityType) of
+ ([], Just E.Blank) -> [ActMoveActor movingActor posTo]
+ ([], Just E.Door) -> [ActMoveActor movingActor posTo]
+ ([], Nothing) -> [ActMoveActor movingActor posTo]
+ _ -> []
+
app/Main.hs
diff -w -B -a -d -u -b -r --new-file 17_levels/app/Main.hs 18_multi_level/app/Main.hs
--- 17_levels/app/Main.hs
+++ 18_multi_level/app/Main.hs
@@ -9,14 +9,16 @@
import qualified GameCore as GC
import qualified GameEngine as GE
import qualified Levels.Level01 as L01
+import qualified Levels.Level02 as L02
main :: IO ()
main = do
map01 <- Txt.readFile "worlds/simple.csv"
- GE.runGame (getLevel map01)
-
-getLevel :: Text -> GC.Levels -> GC.Level
-getLevel map01 GC.Levels01 = L01.mkLevel map01
+ map02 <- Txt.readFile "worlds/level02.csv"
+ GE.runGame (getLevel map01 map02)
+getLevel :: Text -> Text -> GC.Levels -> GC.Level
+getLevel map01 _ GC.Levels01 = L01.mkLevel map01
+getLevel _ map02 GC.Levels02 = L02.mkLevel map02