Haskell roguelike - Multiple levels

Posted on April 2, 2018

start prev next

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)
  , (E.Stairs    , (56, 44), Just "s")

Level two

The world now needs to track which level is currently active.

18_multi_level/src/GameCore.hs (79 to 79)
  , _wdLevel :: !Level

As there are two possible levels.

18_multi_level/src/GameCore.hs (107 to 108)
data Levels = Levels01
            | Levels02

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

start prev next

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
 

Chapters

start prev next