Haskell roguelike - Levels
Posted on April 2, 2018
Levels
Most roguelikes will need to support levels of some sort. This could be traditional levels for progression, levels entered by going “up” or “down” stairs, easy starting / training levels etc.
The code to implement levels should be roughly the same for all of these scenarios. Lets start by supporting a single level in this chapter.
What is a level
For now all a level needs to do is
- Contain the world map
- Create the actors
Here is Level01, the bootLevel code was moved out of bootWorld from GameEngine.hs
17_levels/src/Levels/Level01.hs (2 to 66)
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Levels.Level01 where
import Protolude hiding (Map)
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified System.Random as Rnd
import Control.Lens ((^.), (.~))
import qualified Memory as M
import GameCore
import qualified Entities as E
import qualified EntityType as E
import qualified BoundedInt as B
import qualified UtilityBrain as UB
mkLevel :: Text -> Level
mkLevel mapData = Level { _lvlName = "L01"
, _lvlBoot = bootLevel
, _lvlMapText = mapData
}
bootLevel :: World -> World
bootLevel w1 =
let
bug = mkEnemyActor "bug1" E.Bug (6, -2) & acUtilities .~ [UB.utilityOfInfatuation, UB.utilityOfWander, UB.utilityOfWanderToExit]
& acDisposition .~ Disposition { _dsSmitten = 0.8
, _dsWanderlust = 0.35
, _dsWanderlustToExits = 0.4
, _dsSmittenWith = [E.Player]
}
snake = mkEnemyActor "snake1" E.Snake (8, -4) & acUtilities .~ [UB.utilityOfWander, UB.utilityOfWanderToExit]
& acDisposition .~ Disposition { _dsSmitten = 0
, _dsWanderlust = 0.35
, _dsWanderlustToExits = 0.4
, _dsSmittenWith = []
}
w2 = w1 & wdActors .~ Map.fromList [ (bug ^. acId, bug)
, (snake ^. acId, snake)
]
in
w2
where
mkEnemyActor aid e (x, y) =
Actor { _acId = Aid aid
, _acClass = ClassEnemy
, _acEntity = E.getEntity e
, _acWorldPos = WorldPos (x, y)
, _acStdGen = snd $ Rnd.split (w1 ^. wdPlayer ^. plActor ^. acStdGen)
, _acFovDistance = 2
, _acFov = Nothing
, _acFovHistory = Set.empty
, _acSkipMove = False
, _acMoveEnergyCost = 150
, _acEnergy = B.new 180 100
, _acUtilities = []
, _acDisposition = UB.emptyDisposition
, _acPosMemory = M.empty
, _acProps = Map.empty
}The Level type stores the basic level details
17_levels/src/GameCore.hs (98 to 101)
Levels are all the possible levels, only the one so far.
17_levels/src/GameCore.hs (105 to 105)
Then the World needs a way to get a Level from a Levels
17_levels/src/GameCore.hs (78 to 78)
Separating the engine and the levels
There is no need for the engine to directly reference the level’s code. This separation will help as the code base gets more complicated. One easy fix is to have main load the maps from disk and supply the Levels -> Level function. Then the GameEngine never needs to reference the Level.
17_levels/app/Main.hs (14 to 20)
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 map01bootWorld is now much simpler and only has to deal with the global configuration. The level configuration is done by the level = getLevel Levels01 and level ^. lvlBoot $ w1 calls, which delegate the work to the level code.
17_levels/src/GameEngine.hs (86 to 102)
bootWorld :: Host.Connection -> (Int, Int) -> Rnd.StdGen -> (Levels -> Level) -> World
bootWorld conn screenSize std getLevel =
let
config = mkConfig
level = getLevel Levels01
w1 = World { _wdPlayer = mkPlayer
, _wdConfig = config
, _wdMap = loadWorld E.loadTexts $ level ^. lvlMapText
, _wdActors = Map.fromList []
, _wdMinMoveEnergy = 100
, _wdEnergyIncrements = 20
, _wdUtilBrainAnnotations = []
, _wdGetLevel = getLevel
}
w2 = level ^. lvlBoot $ w1Chapters
Changes
src/GameCore.hs
diff -w -B -a -d -u -b -r --new-file 16_debug/src/GameCore.hs 17_levels/src/GameCore.hs
--- 16_debug/src/GameCore.hs
+++ 17_levels/src/GameCore.hs
@@ -76,6 +74,9 @@
, _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)
+
}
data Config = Config { _cfgKeys :: !(Map Text Text)
@@ -93,6 +94,17 @@
, _enProps :: !(Map Text Text)
} deriving (Show, Eq, Ord)
+
+data Level = Level { _lvlName :: !Text
+ , _lvlBoot :: !(World -> World)
+ , _lvlMapText :: !Text
+ }
+
+
+
+data Levels = Levels01
+
+
newtype WorldPos = WorldPos (Int, Int) deriving (Show, Eq, Ord)
newtype PlayerPos = PlayerPos (Int, Int) deriving (Show, Eq, Ord)
@@ -207,3 +217,4 @@
makeLenses ''Tile
makeLenses ''Actor
makeLenses ''Disposition
+makeLenses ''Level
src/GameEngine.hs
diff -w -B -a -d -u -b -r --new-file 16_debug/src/GameEngine.hs 17_levels/src/GameEngine.hs
--- 16_debug/src/GameEngine.hs
+++ 17_levels/src/GameEngine.hs
@@ -13,7 +13,6 @@
import qualified Data.List.Index as Lst
import qualified Data.DList as DLst
import qualified Data.Text as Txt
-import qualified Data.Text.IO as Txt
import qualified Data.Text.Encoding as TxtE
import qualified Data.Aeson.Text.Extended as Ae
import qualified Data.ByteString.Lazy as BSL
@@ -34,20 +33,19 @@
import qualified UtilityBrain as UB
-runGame :: IO ()
-runGame = Host.runHost manageConnection
+runGame :: (Levels -> Level) -> IO ()
+runGame getLevel = Host.runHost (manageConnection getLevel)
-manageConnection :: Host.Connection -> IO ()
-manageConnection conn = do
+manageConnection :: (Levels -> Level) -> Host.Connection -> IO ()
+manageConnection getLevel conn = do
initCmd <- conn ^. conReceiveText
case parseCommand initCmd of
Just ("init", cmdData) -> do
- mapData <- Txt.readFile "worlds/simple.csv"
std <- Rnd.getStdGen
- case initialiseConnection conn cmdData mapData std of
+ case initialiseConnection conn cmdData std getLevel of
Right world -> do
worldV <- atomically $ newTVar world
sendConfig conn $ world ^. wdConfig
@@ -74,47 +72,38 @@
_ -> Nothing
-initialiseConnection :: Host.Connection -> [Text] -> Text -> Rnd.StdGen -> Either Text World
-initialiseConnection conn cmdData mapData std =
+initialiseConnection :: Host.Connection -> [Text] -> Rnd.StdGen -> (Levels -> Level) -> Either Text World
+initialiseConnection conn cmdData std getLevel =
case parseScreenSize cmdData of
Nothing ->
Left "missing / invalid screen size"
Just (width, height) ->
- Right $ bootWorld conn (width, height) mapData std
+ Right $ bootWorld conn (width, height) std getLevel
-bootWorld :: Host.Connection -> (Int, Int) -> Text -> Rnd.StdGen -> World
-bootWorld conn screenSize mapData std =
+
+bootWorld :: Host.Connection -> (Int, Int) -> Rnd.StdGen -> (Levels -> Level) -> World
+bootWorld conn screenSize std getLevel =
let
config = mkConfig
- bug = mkEnemyActor "bug1" E.Bug (6, -2) & acUtilities .~ [UB.utilityOfInfatuation, UB.utilityOfWander, UB.utilityOfWanderToExit]
- & acDisposition .~ Disposition { _dsSmitten = 0.8
- , _dsWanderlust = 0.35
- , _dsWanderlustToExits = 0.4
- , _dsSmittenWith = [E.Player]
- }
-
- snake = mkEnemyActor "snake1" E.Snake (8, -4) & acUtilities .~ [UB.utilityOfWander, UB.utilityOfWanderToExit]
- & acDisposition .~ Disposition { _dsSmitten = 0
- , _dsWanderlust = 0.35
- , _dsWanderlustToExits = 0.4
- , _dsSmittenWith = []
- }
+ level = getLevel Levels01
w1 = World { _wdPlayer = mkPlayer
, _wdConfig = config
- , _wdMap = loadWorld E.loadTexts mapData
- , _wdActors = Map.fromList [ (bug ^. acId, bug)
- , (snake ^. acId, snake)
- ]
+ , _wdMap = loadWorld E.loadTexts $ level ^. lvlMapText
+ , _wdActors = Map.fromList []
, _wdMinMoveEnergy = 100
, _wdEnergyIncrements = 20
, _wdUtilBrainAnnotations = []
+ , _wdGetLevel = getLevel
}
+
+ w2 = level ^. lvlBoot $ w1
+
in
-- Calculate the actors fov
- updateAllActors w1 updateActorFov
+ updateAllActors w2 updateActorFov
where
mkConfig =
@@ -175,24 +162,6 @@
, _acProps = Map.empty
}
- mkEnemyActor aid e (x, y) =
- Actor { _acId = Aid aid
- , _acClass = ClassEnemy
- , _acEntity = E.getEntity e
- , _acWorldPos = WorldPos (x, y)
- , _acStdGen = std
- , _acFovDistance = 2
- , _acFov = Nothing
- , _acFovHistory = Set.empty
- , _acSkipMove = False
- , _acMoveEnergyCost = 150
- , _acEnergy = B.new 180 100
- , _acUtilities = []
- , _acDisposition = UB.emptyDisposition
- , _acPosMemory = M.empty
- , _acProps = Map.empty
- }
-
runCmd :: Host.Connection -> TVar World -> Text -> [Text] -> IO ()
runCmd conn worldV cmd cmdData =
src/Levels/Level01.hs
diff -w -B -a -d -u -b -r --new-file 16_debug/src/Levels/Level01.hs 17_levels/src/Levels/Level01.hs
--- 16_debug/src/Levels/Level01.hs
+++ 17_levels/src/Levels/Level01.hs
@@ -0,0 +1,67 @@
+
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Levels.Level01 where
+
+import Protolude hiding (Map)
+import qualified Data.Set as Set
+import qualified Data.Map.Strict as Map
+import qualified System.Random as Rnd
+import Control.Lens ((^.), (.~))
+
+import qualified Memory as M
+import GameCore
+import qualified Entities as E
+import qualified EntityType as E
+import qualified BoundedInt as B
+import qualified UtilityBrain as UB
+
+mkLevel :: Text -> Level
+mkLevel mapData = Level { _lvlName = "L01"
+ , _lvlBoot = bootLevel
+ , _lvlMapText = mapData
+ }
+
+bootLevel :: World -> World
+bootLevel w1 =
+ let
+ bug = mkEnemyActor "bug1" E.Bug (6, -2) & acUtilities .~ [UB.utilityOfInfatuation, UB.utilityOfWander, UB.utilityOfWanderToExit]
+ & acDisposition .~ Disposition { _dsSmitten = 0.8
+ , _dsWanderlust = 0.35
+ , _dsWanderlustToExits = 0.4
+ , _dsSmittenWith = [E.Player]
+ }
+
+ snake = mkEnemyActor "snake1" E.Snake (8, -4) & acUtilities .~ [UB.utilityOfWander, UB.utilityOfWanderToExit]
+ & acDisposition .~ Disposition { _dsSmitten = 0
+ , _dsWanderlust = 0.35
+ , _dsWanderlustToExits = 0.4
+ , _dsSmittenWith = []
+ }
+
+ w2 = w1 & wdActors .~ Map.fromList [ (bug ^. acId, bug)
+ , (snake ^. acId, snake)
+ ]
+ in
+ w2
+
+ where
+ mkEnemyActor aid e (x, y) =
+ Actor { _acId = Aid aid
+ , _acClass = ClassEnemy
+ , _acEntity = E.getEntity e
+ , _acWorldPos = WorldPos (x, y)
+ , _acStdGen = snd $ Rnd.split (w1 ^. wdPlayer ^. plActor ^. acStdGen)
+ , _acFovDistance = 2
+ , _acFov = Nothing
+ , _acFovHistory = Set.empty
+ , _acSkipMove = False
+ , _acMoveEnergyCost = 150
+ , _acEnergy = B.new 180 100
+ , _acUtilities = []
+ , _acDisposition = UB.emptyDisposition
+ , _acPosMemory = M.empty
+ , _acProps = Map.empty
+ }
+
app/Main.hs
diff -w -B -a -d -u -b -r --new-file 16_debug/app/Main.hs 17_levels/app/Main.hs
--- 16_debug/app/Main.hs
+++ 17_levels/app/Main.hs
@@ -1,12 +1,22 @@
{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
module Main where
import Protolude
+import qualified Data.Text.IO as Txt
+import qualified GameCore as GC
import qualified GameEngine as GE
+import qualified Levels.Level01 as L01
+
main :: IO ()
-main = GE.runGame
+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