Haskell roguelike - Story

Posted on April 2, 2018

start prev next

Plot

So far the game is an open world with free play. Very often however you are going to want a bit more structure. This can range from the trivial “you need an x to do a y” to full blow sub-plots. In this chapter we’ll add the former, the player needs to pick up the key to unlock the door to the second level. To make things a bit more interesting lets also add two potions, one to disable darkness and one to enable it again.

19_story/src/EntityType.hs (8 to 21)
data EntityType = Blank
                | Door
                | DoorClosed
                | Wall
                | Player
                | Bug
                | Snake
                | Dark
                | Stairs
                | PotionDark
                | PotionLight
                | Key
                | Unknown
                deriving (Show, Eq, Ord)
19_story/src/Entities.hs (28 to 30)
  , (E.PotionDark , (16, 46), Just "pd")
  , (E.PotionLight, ( 8, 46), Just "pl")
  , (E.Key        , (54, 45), Just "ke")

Story handler

A story handler is the function that decides which actions to perform when an even occurs.

19_story/src/GameCore.hs (110 to 110)
type StoryHandler = World -> RogueEvent -> [RogueAction]

Events

We don’t yet have an event type so lets add one There is only one event type so far, EvtMove. It has

  1. The actors at the destination
  2. The entity type at the destination (non-actor)
  3. The world
  4. The moving actor
19_story/src/GameCore.hs (131 to 131)
data RogueEvent = EvtMove [Actor] (Maybe E.EntityType) WorldPos Actor

Level

Each level has its own story handlers to control their plot. Since the story handler is now responding to the move events, the level no longer has a lvlTryMove property.

19_story/src/GameCore.hs (97 to 101)
data Level = Level { _lvlName :: !Text
                   , _lvlBoot :: !(World -> World)
                   , _lvlMapText :: !Text
                   , _lvlStoryHandler :: !StoryHandler
                   }

Properties

As the story progresses we are going to need somewhere to store the state of the story. Fortunately back in chapter 16 we added acProps to the actor.

The story handler needs a way to set these properties. We already have ActTogglePlayerProp lets add two more actions to manipulate an actor’s properties

19_story/src/GameCore.hs (118 to 119)
  | ActClearPlayerProp Text
  | ActSetPlayerProp Text Text

The changes to runAction to handle these actions are quite simple map manipulations.

19_story/src/GameEngine.hs (435 to 439)
    ActSetPlayerProp prop valEnabled ->
      world & (wdPlayer . plActor . acProps) %~ Map.insert prop valEnabled

    ActClearPlayerProp prop ->
      world & (wdPlayer . plActor . acProps) %~ Map.delete prop

Changing entities

Picking up the key will change the closed door to an open door. We need to add one action to replace entities and one to remove them (picking up the key).

19_story/src/GameCore.hs (126 to 127)
  | ActRemoveEntity E.EntityType WorldPos
  | ActReplaceEntity E.EntityType WorldPos Entity

These two actions are also implemented as map manipulations. Both check that the entity being operated on (deleted / replaced) is the expected entity. If not, the operation is ignored.

19_story/src/GameEngine.hs (464 to 468)
    ActRemoveEntity existingType atWorldPos ->
      world & wdMap %~ Map.alter (deleteMapEntity existingType) atWorldPos

    ActReplaceEntity existingType atWorldPos newEntity ->
      world & wdMap %~ Map.alter (alterMapEntity existingType newEntity) atWorldPos
19_story/src/GameEngine.hs (476 to 482)
    alterMapEntity :: E.EntityType -> Entity -> Maybe Entity -> Maybe Entity
    alterMapEntity _ new Nothing = Just new
    alterMapEntity oldType new (Just oldEntity) = if oldType == (oldEntity ^. enType) then Just new else Just oldEntity

    deleteMapEntity :: E.EntityType -> Maybe Entity -> Maybe Entity
    deleteMapEntity _ Nothing = Nothing
    deleteMapEntity oldType (Just oldEntity) = if oldType == (oldEntity ^. enType) then Nothing else Just oldEntity

Running a story

Back in the utility AI chapter I explained why I decided again using a state machine for the AI. For a simple plot however a state machine is perfect. This is because there are a limited number of simple transitions.

Originally I started with a state machine module but that turned out to be overkill. What I ended up with was that each level has a current story handler (the current state its at) and each of these handlers can change the level’s story handler, i.e. perform a transitions

You already saw the level’s lvlStoryHandler above: _lvlStoryHandler :: !StoryHandler

Change story handler action

Lets add the action to change the current story handler

19_story/src/GameCore.hs (123 to 123)
  | ActSetStoryHandler StoryHandler

runAction simply changes the current level’s story handler in response to this action.

19_story/src/GameEngine.hs (459 to 460)
  ActSetStoryHandler h ->
    world & (wdLevel . lvlStoryHandler) .~ h

Sending events to the story handler

GameEngine’s tryMoveActor must now create a RogueEvent and send it to the level’s story handler. This is not very different from the old code but means that new events can easily be added.

19_story/src/GameEngine.hs (511 to 516)
     -- Create move event
     evt = EvtMove destActors destEntityType tryWorldTo' actor
     -- Run even to get actions
     actions = (world ^. wdLevel ^. lvlStoryHandler) world evt 
  in
  Just $ runActions world actions

Level’s story handler

When a level is created the default story handler must be set. For level one the story starts waiting for the player to pickup the key.

19_story/src/Levels/Level01.hs (20 to 26)
mkLevel :: Text -> Level
mkLevel mapText =
  Level { _lvlName = "L01"
        , _lvlBoot = bootLevel 
        , _lvlMapText = mapText
        , _lvlStoryHandler = storyWaitingForKey
        }

Shared logic

Once you start designing your story logic (state machine) you will quickly realise that most of the story handlers have to deal with the same event the same way. E.g. stepping on a blank tile is the same for all the handlers. I’m managing this by having a shared handler (storyCommon) that each of the other handlers can call if they are not handling the event. This means that story handlers can override whatever default behavior they need to.

storyCommon

storyCommon handles basic collisions. It also handles the logic of the player stepping on one of the two potions.

19_story/src/Levels/Level01.hs (73 to 94)
storyCommon :: World -> RogueEvent -> [RogueAction]
storyCommon world evt =
  case evt of
    EvtMove destActors destEntityType posTo movingActor ->
      let isPlayer = isPlayerMoving world movingActor in
      case (isPlayer, destActors, destEntityType) of
        (_, [], Just E.Blank) -> [ActMoveActor movingActor posTo]
        (_, [], Just E.Door) -> [ActMoveActor movingActor posTo]
        (_, [], Nothing) -> [ActMoveActor movingActor posTo]

        -- Only the player can pickup potions. Set lights on
        (True, [], Just E.PotionLight) -> [ ActMoveActor movingActor posTo
                                          , ActSetPlayerProp "debug:light" "on"
                                          , ActRemoveEntity E.PotionLight posTo
                                          ]

        -- Only the player can pickup potions. Set lights off
        (True, [], Just E.PotionDark) -> [ ActMoveActor movingActor posTo
                                         , ActClearPlayerProp "debug:light"
                                         , ActRemoveEntity E.PotionDark posTo
                                         ]
        _ -> []
19_story/src/Levels/Level01.hs (141 to 143)
isPlayerMoving :: World -> Actor -> Bool
isPlayerMoving w a =
  w ^. wdPlayer ^. plActor ^. acId == a ^. acId

storyWaitingForKey

19_story/src/Levels/Level01.hs (99 to 124)
storyWaitingForKey :: World -> RogueEvent -> [RogueAction]
storyWaitingForKey world evt =
  case evt of
    EvtMove destActors destEntityType posTo movingActor ->
      let isPlayer = isPlayerMoving world movingActor in

      case (isPlayer, destActors, destEntityType) of
        -- Player picked up the key
        (True, [], Just E.Key) ->
          [ ActMoveActor movingActor posTo
          , ActSetStoryHandler storyDoorOpen
          , ActRemoveEntity E.Key posTo
          ] <>
          -- Replace all closed doors with open ones
          ((\closedDoorAt -> ActReplaceEntity E.DoorClosed closedDoorAt $ E.getEntity E.Door) <$> findPos E.DoorClosed)
                 
        _ -> storyCommon world evt

  where
    findPos :: E.EntityType -> [WorldPos]
    findPos et =
      let
        es = Map.toList $ world ^. wdMap
        found = filter (\(_, e) -> e ^. enType == et) es
      in
      fst <$> found

storyDoorOpen

19_story/src/Levels/Level01.hs (129 to 136)
storyDoorOpen :: World -> RogueEvent -> [RogueAction]
storyDoorOpen world evt =
  case evt of
    EvtMove destActors destEntityType posTo movingActor ->
      case (destActors, destEntityType) of
        ([], Just E.Key) -> [ActMoveActor movingActor posTo]
        (_, Just E.Stairs) -> [ActGotoLevel Levels02]
        _ -> storyCommon world evt

Multiple levels with plot

With these changes the game now supports different levels each with a different plot. Not bad at all

Chapters

start prev next

Changes

src/Entities.hs 

diff -w -B -a -d -u -b -r --new-file 18_multi_level/src/Entities.hs 19_story/src/Entities.hs
--- 18_multi_level/src/Entities.hs
+++ 19_story/src/Entities.hs
@@ -23,9 +23,12 @@
            , (E.Bug       , (25,  3), Nothing)
            , (E.Snake     , (38,  4), Nothing)
            , (E.Dark      , (43, 11), Nothing)
-
            , (E.Stairs    , (56, 44), Just "s")
 
+           , (E.PotionDark , (16, 46), Just "pd")
+           , (E.PotionLight, ( 8, 46), Just "pl")
+           , (E.Key        , (54, 45), Just "ke")
+
            ]
   in
   let mkData (typ, pos@(x, y), l) (tiles', entities', loads') =

src/EntityType.hs 

diff -w -B -a -d -u -b -r --new-file 18_multi_level/src/EntityType.hs 19_story/src/EntityType.hs
--- 18_multi_level/src/EntityType.hs
+++ 19_story/src/EntityType.hs
@@ -14,6 +14,9 @@
                 | Snake
                 | Dark
                 | Stairs
+                | PotionDark
+                | PotionLight
+                | Key
                 | Unknown
                 deriving (Show, Eq, Ord)

src/GameCore.hs 

diff -w -B -a -d -u -b -r --new-file 18_multi_level/src/GameCore.hs 19_story/src/GameCore.hs
--- 18_multi_level/src/GameCore.hs
+++ 19_story/src/GameCore.hs
@@ -99,7 +97,7 @@
 data Level = Level { _lvlName :: !Text
                    , _lvlBoot :: !(World -> World)
                    , _lvlMapText :: !Text
-                   , _lvlTryMove :: !([Actor] -> Maybe E.EntityType -> World -> WorldPos -> Actor -> [RogueAction])
+                   , _lvlStoryHandler :: !StoryHandler
                    }
 
 
@@ -107,17 +104,32 @@
 data Levels = Levels01
             | Levels02
 
-
 newtype WorldPos = WorldPos (Int, Int) deriving (Show, Eq, Ord)
 newtype PlayerPos = PlayerPos (Int, Int) deriving (Show, Eq, Ord)
 
+type StoryHandler = World -> RogueEvent -> [RogueAction]
+
 
 data RogueAction = ActMovePlayer (Int, Int)
                  | ActMoveActor Actor WorldPos
                  | ActSetPlayerViewPortStyle ViewPortStyle
                  | ActTogglePlayerProp Text Text
+
+                 | ActClearPlayerProp Text
+                 | ActSetPlayerProp Text Text
+
                  | ActGotoLevel Levels
 
+                 | ActSetStoryHandler StoryHandler
+
+
+                 | ActRemoveEntity E.EntityType WorldPos
+                 | ActReplaceEntity E.EntityType WorldPos Entity
+
+
+
+data RogueEvent = EvtMove [Actor] (Maybe E.EntityType) WorldPos Actor
+
 
 data ViewPortStyle = ViewPortCentre
                    | ViewPortLock PlayerPos

src/GameEngine.hs 

diff -w -B -a -d -u -b -r --new-file 18_multi_level/src/GameEngine.hs 19_story/src/GameEngine.hs
--- 18_multi_level/src/GameEngine.hs
+++ 19_story/src/GameEngine.hs
@@ -432,6 +432,13 @@
       world & (wdPlayer . plActor . acProps) %~ Map.alter (toggleMapProp valEnabled) prop
 
 
+    ActSetPlayerProp prop valEnabled ->
+      world & (wdPlayer . plActor . acProps) %~ Map.insert prop valEnabled
+
+    ActClearPlayerProp prop ->
+      world & (wdPlayer . plActor . acProps) %~ Map.delete prop
+
+
     ActMoveActor actor worldPos ->
       let
         movedActor = actor & acWorldPos .~ worldPos
@@ -451,11 +456,33 @@
         l
 
 
+    ActSetStoryHandler h ->
+      world & (wdLevel . lvlStoryHandler) .~ h
+
+
+
+    ActRemoveEntity existingType atWorldPos ->
+      world & wdMap %~ Map.alter (deleteMapEntity existingType) atWorldPos
+
+    ActReplaceEntity existingType atWorldPos newEntity ->
+      world & wdMap %~ Map.alter (alterMapEntity existingType newEntity) atWorldPos
+
+
   where
     toggleMapProp v Nothing = Just v
     toggleMapProp _ (Just _) = Nothing
 
 
+    alterMapEntity :: E.EntityType -> Entity -> Maybe Entity -> Maybe Entity
+    alterMapEntity _ new Nothing = Just new
+    alterMapEntity oldType new (Just oldEntity) = if oldType == (oldEntity ^. enType) then Just new else Just oldEntity
+
+    deleteMapEntity :: E.EntityType -> Maybe Entity -> Maybe Entity
+    deleteMapEntity _ Nothing = Nothing
+    deleteMapEntity oldType (Just oldEntity) = if oldType == (oldEntity ^. enType) then Nothing else Just oldEntity
+
+
+
 tryMoveActor :: World -> Actor -> (Int, Int) -> Maybe World
 tryMoveActor world actor (dx, dy) =
   let
@@ -481,8 +508,10 @@
       -- Actors at destination
       destActors = filter (\a -> a ^. acWorldPos == tryWorldTo') (getAllActors world)
 
-      -- Get actions
-      actions = (world ^. wdLevel ^. lvlTryMove) destActors destEntityType world tryWorldTo' actor
+      -- Create move event
+      evt = EvtMove destActors destEntityType tryWorldTo' actor
+      -- Run even to get actions
+      actions = (world ^. wdLevel ^. lvlStoryHandler) world evt 
    in
    Just $ runActions world actions

src/Levels/Level01.hs 

diff -w -B -a -d -u -b -r --new-file 18_multi_level/src/Levels/Level01.hs 19_story/src/Levels/Level01.hs
--- 18_multi_level/src/Levels/Level01.hs
+++ 19_story/src/Levels/Level01.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module Levels.Level01 where
+module Levels.Level01 (mkLevel) where
 
 import Protolude hiding (Map)
 import qualified Data.Set as Set
@@ -16,13 +16,16 @@
 import qualified BoundedInt as B
 import qualified UtilityBrain as UB
 
+
 mkLevel :: Text -> Level
-mkLevel mapData = Level { _lvlName = "L01"
+mkLevel mapText =
+  Level { _lvlName = "L01"
                         , _lvlBoot = bootLevel 
-                        , _lvlMapText = mapData
-                        , _lvlTryMove = tryMove
+        , _lvlMapText = mapText
+        , _lvlStoryHandler = storyWaitingForKey
                         }
 
+
 bootLevel :: World -> World
 bootLevel w1 =
   let
@@ -66,13 +69,76 @@
             }
 
 
-tryMove :: [Actor] -> Maybe E.EntityType -> World -> WorldPos -> Actor -> [RogueAction]
-tryMove destActors destEntityType _ posTo movingActor =
-  -- Is the move allowed
+
+storyCommon :: World -> RogueEvent -> [RogueAction]
+storyCommon world evt =
+  case evt of
+    EvtMove destActors destEntityType posTo movingActor ->
+      let isPlayer = isPlayerMoving world movingActor in
+      case (isPlayer, destActors, destEntityType) of
+        (_, [], Just E.Blank) -> [ActMoveActor movingActor posTo]
+        (_, [], Just E.Door) -> [ActMoveActor movingActor posTo]
+        (_, [], Nothing) -> [ActMoveActor movingActor posTo]
+
+        -- Only the player can pickup potions. Set lights on
+        (True, [], Just E.PotionLight) -> [ ActMoveActor movingActor posTo
+                                          , ActSetPlayerProp "debug:light" "on"
+                                          , ActRemoveEntity E.PotionLight posTo
+                                          ]
+
+        -- Only the player can pickup potions. Set lights off
+        (True, [], Just E.PotionDark) -> [ ActMoveActor movingActor posTo
+                                         , ActClearPlayerProp "debug:light"
+                                         , ActRemoveEntity E.PotionDark posTo
+                                         ]
+        _ -> []
+
+
+
+
+storyWaitingForKey :: World -> RogueEvent -> [RogueAction]
+storyWaitingForKey world evt =
+  case evt of
+    EvtMove destActors destEntityType posTo movingActor ->
+      let isPlayer = isPlayerMoving world movingActor in
+
+      case (isPlayer, destActors, destEntityType) of
+        -- Player picked up the key
+        (True, [], Just E.Key) ->
+          [ ActMoveActor movingActor posTo
+          , ActSetStoryHandler storyDoorOpen
+          , ActRemoveEntity E.Key posTo
+          ] <>
+          -- Replace all closed doors with open ones
+          ((\closedDoorAt -> ActReplaceEntity E.DoorClosed closedDoorAt $ E.getEntity E.Door) <$> findPos E.DoorClosed)
+                 
+        _ -> storyCommon world evt
+
+  where
+    findPos :: E.EntityType -> [WorldPos]
+    findPos et =
+      let
+        es = Map.toList $ world ^. wdMap
+        found = filter (\(_, e) -> e ^. enType == et) es
+      in
+      fst <$> found
+
+
+  
+
+storyDoorOpen :: World -> RogueEvent -> [RogueAction]
+storyDoorOpen world evt =
+  case evt of
+    EvtMove destActors destEntityType posTo movingActor ->
   case (destActors, destEntityType) of
-    ([], Just E.Blank) -> [ActMoveActor movingActor posTo]
-    ([], Just E.Door) -> [ActMoveActor movingActor posTo]
-    ([], Nothing) -> [ActMoveActor movingActor posTo]
+        ([], Just E.Key) -> [ActMoveActor movingActor posTo]
     (_, Just E.Stairs) -> [ActGotoLevel Levels02]
-    _ -> []
+        _ -> storyCommon world evt
+
+
+
+
+isPlayerMoving :: World -> Actor -> Bool
+isPlayerMoving w a =
+  w ^. wdPlayer ^. plActor ^. acId == a ^. acId

src/Levels/Level02.hs 

diff -w -B -a -d -u -b -r --new-file 18_multi_level/src/Levels/Level02.hs 19_story/src/Levels/Level02.hs
--- 18_multi_level/src/Levels/Level02.hs
+++ 19_story/src/Levels/Level02.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module Levels.Level02 where
+module Levels.Level02 (mkLevel)  where
 
 import           Protolude
 
@@ -10,19 +10,22 @@
 
 
 mkLevel :: Text -> Level
-mkLevel mapData = Level { _lvlName = "L02"
+mkLevel mapText =
+  Level { _lvlName = "L02"
                         , _lvlBoot = bootLevel 
-                        , _lvlMapText = mapData
-                        , _lvlTryMove = tryMove
+        , _lvlMapText = mapText
+        , _lvlStoryHandler = storySimple
                         }
 
+
 bootLevel :: World -> World
 bootLevel w = w
 
 
-tryMove :: [Actor] -> Maybe E.EntityType -> World -> WorldPos -> Actor -> [RogueAction]
-tryMove destActors destEntityType _ posTo movingActor =
-  -- Is the move allowed
+storySimple :: World -> RogueEvent -> [RogueAction]
+storySimple _ evt =
+  case evt of
+    EvtMove destActors destEntityType posTo movingActor ->
   case (destActors, destEntityType) of
     ([], Just E.Blank) -> [ActMoveActor movingActor posTo]
     ([], Just E.Door) -> [ActMoveActor movingActor posTo]

Chapters

start prev next