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)
19_story/src/Entities.hs (28 to 30)

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)

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)

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)

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)

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

19_story/src/GameEngine.hs (435 to 439)

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)

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)
19_story/src/GameEngine.hs (476 to 482)

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)

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

19_story/src/GameEngine.hs (459 to 460)

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)

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)

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)
19_story/src/Levels/Level01.hs (141 to 143)

storyWaitingForKey

19_story/src/Levels/Level01.hs (99 to 124)

storyDoorOpen

19_story/src/Levels/Level01.hs (129 to 136)

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