Games

Analyzing Our Parameters

analysis.jpg

Our last couple articles have focused on developing an AI for the player character in our game. It isn't perfect, but it's a decent approximation of how a human would try to play the game. This means we can now play iterations of the game without any human involvement. And by changing the parameters of our world, we can play a lot of different versions of the game.

Our goal for this week will be to write some simple analysis functions. These will play through the game without needing to display anything on the screen. Then we'll be able to play different versions in quick succession and compare results.

As always, the code for this project is on a Github Repository. For this article, take a look at the analyze-game branch.

If you're completely new to Haskell, a simple game like this is a great way to get started! But you should start with our Beginners Checklist! It'll help you get everything set up with the language on your local machine! Then you can move onto our Liftoff Series to learn more about Haskell's mechanics.

Generating a Result

The first thing we need is a function that takes a world state and generates a result for it. Our game does have a degree of randomness. But once we fix the starting random generator for a everything is deterministic. This means we need a function like:

runGameToResult :: World -> GameResult

We'll want to use our updateFunc from the main game runner. This is our "evolution" function. It's job is to go from one World state to another. It evolves the game over the course of one timestep by allowing each of the agents to make a decision (or wait). (Note we don't use the Float parameter in our game. It's just needed by Gloss).

updateFunc :: Float -> World -> World

Since we want to track an ever evolving stateful variable, we'll use the State monad. For each iteration, we'll change the world using this update step. Then we'll check its result and see if it's finished. If not, we'll continue to run the game.

runGameToResult :: World -> GameResult
runGameToResult = evalState runGameState
  where
    runGameState :: State World GameResult
    runGameState = do
      modify (updateFunc 1.0)
      currentResult <- gets worldResult
      if currentResult /= GameInProgress
        then return currentResult
        else runGameState

Analysis: Generating World Iterations

Now that we can run a given world to its conclusion, let's add another step to the process. We'll run several different iterations with any given set of parameters on a world. Each of these will have a different set of starting enemy locations and drill power-ups. Let's make a function that will take a random generator and a "base world". It will derive a new world with random initial enemy positions and drill locations.

generateWorldIteration :: World -> StdGen -> World

We'll use a helper function from our game that generates random locations in our maze. It's stateful over the random generator.

generateRandomLocation :: (Int, Int) -> State StdGen Location

So first let's get all our locations:

generateWorldIteration :: World -> StdGen -> World
generateWorldIteration w gen1 = ...
  where
    params = worldParameters w
    rowCount = numRows params
    columnCount = numColumns params
    enemyCount = numEnemies params
    drillCount = numDrillPowerups params

    (enemyLocations, gen2) = runState
      (sequence
        (map
          (const (generateRandomLocation (rowCount, columnCount)))
          [1..enemyCount])
        )
      gen1
    (drillLocations, gen3) = runState
      (sequence
        (map
          (const (generateRandomLocation (rowCount, columnCount)))
          [1..drillCount])
        )
      gen2
    ...

Then we have to use the locations to generate our different enemies. Last, we'll plug all these new elements into our base world and return it!

generateWorldIteration :: World -> StdGen -> World
generateWorldIteration w gen1 = w
  { worldEnemies = enemies
  , worldDrillPowerUpLocations = drillLocations
  , worldRandomGenerator = gen3
  , worldTime = 0
  }
where
    ...
    (enemyLocations, gen2) = ...
    (drillLocations, gen3) = …
    enemies = mkNewEnemy (enemyGameParameters params) <$> enemyLocations

Analysis: Making Parameter Sets

For our next order of business, we want to make what we'll call a parameter set. We want to run the game with different parameters each time. For instance, we can take a base set of parameters, and then change the number of enemies present in each one:

varyNumEnemies :: GameParameters -> [GameParameters]
varyNumEnemies baseParams = newParams <$> allEnemyNumbers
  where
    baseNumEnemies = numEnemies baseParams
    allEnemyNumbers = [baseNumEnemies..(baseNumEnemies + 9)]
    newParams i = baseParams { numEnemies = i }

We can do the same for the number of drill pickups:

varyNumDrillPickups :: GameParameters -> [GameParameters]
varyNumDrillPickups baseParams = newParams <$> allDrillNumbers
  where
    baseNumDrills = numDrillPowerups baseParams
    allDrillNumbers = [baseNumDrills..(baseNumDrills + 9)]
    newParams i = baseParams { numDrillPowerups = i }

Finally, we can have a different cooldown time for our player's stun ability.

varyPlayerStunCooldown :: GameParameters -> [GameParameters]
varyPlayerStunCooldown baseParams = newParams <$> allCooldowns
  where
    basePlayerParams = playerGameParameters baseParams
    baseCooldown = initialStunTimer basePlayerParams
    allCooldowns = [(baseCooldown - 4)..(baseCooldown + 5)]
    newParams i = baseParams
      { playerGameParameters = basePlayerParams { initialStunTimer = i }}

If you fork our code, you can try altering some other parameters. You can even try combining certain parameters to see what the results are!

Tying It Together

We've done most of the hard work now. We'll have a function that takes a number of iterations per parameter set, the base world, and a generator for those sets. It'll match up each parameter set to the number of wins the player gets over the course of the iterations.

runAllIterations
  :: Int
  -> World
  -> (GameParameters -> [GameParameters])
  -> [(GameParameters, Int)]
runAllIterations numIterations w paramGenerator =
  map countWins results
  where
    aiParams = (worldParameters w) { usePlayerAI = True }
    paramSets = paramGenerator aiParams

    runParamSet :: GameParameters -> [GameResult]
    runParamSet ps = map
      (runGame w {worldParameters = ps })
      [1..numIterations]

    runGame :: World -> Int -> GameResult
    runGame baseWorld seed = runGameToResult
      (generateWorldIteration baseWorld (mkStdGen seed))

    results :: [(GameParameters, [GameResult])]
    results = zip paramSets (map runParamSet paramSets)

    countWins :: (GameParameters, [GameResult]) -> (GameParameters, Int)
    countWins (gp, gameResults) =
      (gp, length (filter (== GameWon) gameResults))

We need one more function. It will read an input file and apply our steps over a particular parameter group. Here's an example with varying the number of enemies:

analyzeNumEnemies :: FilePath -> IO ()
analyzeNumEnemies fp = do
  world <- loadWorldFromFile fp
  let numIterations = 10
  putStrLn "Analyzing Different Numbers of Enemies"
  let results = runAllIterations numIterations world varyNumEnemies
  forM_ results $ \(gp, numWins) -> putStrLn $
    "With " ++ (show (numEnemies gp)) ++ " Enemies: " ++ (show numWins)
      ++ " wins out of " ++ (show numIterations) ++ " iterations."

Now we're done! In the appendix, you can find some basic results of our investigation!

Conclusion

Soon, we'll take our analysis steps and apply them in a more systematic way. We'll try to gauge the difficulty of a particular game level. Then we can make levels that get more and more challenging!

But first, we'll start exploring a few ways we can improve the player and enemy AI abilities. We'll start by implementing some basic caching mechanisms in our breadth first search. Then we'll consider some other AI patterns besides simple BFS.

For a review of the code in this article, take a look at our Github Repository. You'll want to explore the analyze-game branch!

We'll soon be exploring machine learning a bit more as we try to improve the game. Make sure to read our series on Haskell and AI to learn more! Download our Haskell Tensorflow Guide to see how we can use tensor flow with Haskell!

Appendix

With 4 drills and 10 cooldown time:

Analyzing Different Numbers of Enemies
With 4 Enemies: 10 wins out of 10 iterations.
With 5 Enemies: 9 wins out of 10 iterations.
With 6 Enemies: 9 wins out of 10 iterations.
With 7 Enemies: 10 wins out of 10 iterations.
With 8 Enemies: 9 wins out of 10 iterations.
With 9 Enemies: 9 wins out of 10 iterations.
With 10 Enemies: 9 wins out of 10 iterations.
With 11 Enemies: 9 wins out of 10 iterations.
With 12 Enemies: 8 wins out of 10 iterations.
With 13 Enemies: 7 wins out of 10 iterations.

With 13 enemies and 10 cooldown time:

With 2 Drills: 5 wins out of 10 iterations.
With 3 Drills: 7 wins out of 10 iterations.
With 4 Drills: 8 wins out of 10 iterations.
With 5 Drills: 8 wins out of 10 iterations.
With 6 Drills: 8 wins out of 10 iterations.
With 7 Drills: 7 wins out of 10 iterations.
With 8 Drills: 8 wins out of 10 iterations.
With 9 Drills: 8 wins out of 10 iterations.
With 10 Drills: 8 wins out of 10 iterations.
With 11 Drills: 8 wins out of 10 iterations.

Advanced Search with Drilling!

drill_2.png

In last week's article we explored how we can make an AI for our main player character. This meant we could play the game without input from a user. The game can now "play itself", and churn out a lot of iterations and results. This, in turn, will let us test combinations of parameters so we can make levels that are challenging.

Our AI is still a little too simplistic. The version we made last week doesn't incorporate the drill feature at all. So this week, let's see if we can devise a way to use that. We'll start with some of the search algorithm ideas we're already using for BFS, and expand from there.

For this article, you'll want to look at the player-ai-drill branch on our Github Repository. It has the full implementation, and you can check the newest commits to see what has changed.

This article will depend a lot on our knowledge of monads, particularly the state monad. If you're newer to Haskell development, you should check out our series on Functional Data Structures. It'll help you understand this tricky concept better.

Updating Our Types

Once again, there are a few quick updates we'll want to make before we start writing our AI. Last week we wrote our main function using this type:

data MoveChoice =
  MoveUp |
  MoveRight |
  MoveDown |
  MoveLeft |
  StandStill

data PlayerMove = PlayerMove
  { playerMoveChoice :: MoveChoice
  , activateStun :: Bool
  }

makePlayerMove :: World -> PlayerMove
...

First we'll change the original type to be MoveDirection. Then to account for the drill powerup, we'll add another field using this type:

data MoveDirection =
  DirectionUp |
  DirectionRight |
  DirectionDown |
  DirectionLeft |
  DirectionNone

data PlayerMove = PlayerMove
  { playerMoveDirection :: MoveDirection
  , activateStun :: Bool
  , drillDirection :: MoveDirection
  }

So we can start out by using DirectionNone for the drill every time, and ensure our game works.

Modifying the World

With the new potential to use the drill to change our world, we'll want another modifier function. This will reuse a lot of old code from our player input section.

modifyWorldForDrill :: World -> MoveDirection -> World

To start, we'll refactor our drillLocation function to be a top level function. Nothing much has to change with its implementation. Let's recall its type signature:

drillLocation
  :: (CellBoundaries -> BoundaryType)
  -> (CellBoundaries -> CellBoundaries)
  -> (CellBoundaries -> CellBoundaries)
  -> World
  -> World

Now our player modifier is pretty straightforward. We'll do a case analysis of the desired direction, as we do with the input keys. This gives us all the necessary inputs to drillLocation:

modifyWorldForPlayerDrill :: World -> MoveDirection -> World
modifyWorldForPlayerDrill w drillDirection = case drillDirection of
  DirectionUp ->
      drillLocation upBoundary breakUpWall breakDownWall w
  DirectionRight ->
      drillLocation rightBoundary breakRightWall breakLeftWall w
  DirectionDown ->
      drillLocation downBoundary breakDownWall breakUpWall w
  DirectionLeft ->
      drillLocation leftBoundary breakLeftWall breakRightWall w
  DirectionNone -> w

And now working this into our update function is easy. It's just another function we have to compose with the other options. We'll apply the drill as the first step, even before the stun:

updateWorldForPlayerMove :: World -> World
updateWorldForPlayerMove w = if shouldMovePlayer
  then worldAfterMove
  else w
  where
    ...
    move = makePlayerMove w

    worldAfterDrill =
        modifyWorldForPlayerDrill w (drillDirection move)

    worldAfterStun = if activateStun move
      then modifyWorldForStun worldAfterDrill
      else worldAfterDrill

    … -- Apply move

Changing the AI

Now let's get cracking on a better algorithm! The good news is that we can still stick to breadth first search. But what needs to change is the items in our search queue. There's a certain amount of state involved in each path we take. Before, we know that if a path backtracks onto a previous location, it will be slower. But now, we can have a faster path coming over a previous square IF we do so with more drills. But each time we take a drill, we need to remove it from the map (from the point of view of this path). Otherwise we could keep picking up the same drill! Thus a "search item", as we'll call it, must also contain the number of drills we have as well as the set of drill power-ups existing on the map. This item has all the important world state for our player moving around the map.

type DrillSearchItem = (Location, Word, Set.Set Location)

Then the other obvious change is that we can go to more adjacent squares. As long as the drill count is at least one, we can go to any adjacent tile. We'll see how this factors into our algorithm below.

Re-Doing BFS

We're going to mimic our original BFS algorithm for the most part when it comes to the drilling version. First, let's reconsider our notion of "adjacent" cells. Remember this function from BFS?

getAdjacentLocations :: Maze -> Location -> [Location]

We now want to re-write it using our DrillSearchItem alias.

getDrillAdjacentItems :: Maze -> DrillSearchItem -> [DrillSearchItem]

In the previous version, we had a section dedicated to checking the bounds around the given location. Then we could see which locations are adjacent. We'll want a similar section for drilling, but we want to use walls as well, as long as we have at least one drill. So let's pattern match on our current item, and gather the locations we can use. We'll also use a boolean to denote if we used a drill to get to that location.

getDrillAdjacentItems :: Maze -> DrillSearchItem -> [DrillSearchItem]
getDrillAdjacentItems maze (location, drillsRemaining, drillLocs) =
  …
  where
    canDrill = drillsRemaining > 0

    maybeUpLoc = case upBoundary bounds of
      (AdjacentCell loc) -> Just (loc, False)
      (Wall loc) -> if canDrill then Just (loc, True) else Nothing
      _ -> Nothing
    maybeRightLoc = case rightBoundary bounds of
      (AdjacentCell loc) -> Just (loc, False)
      (Wall loc) -> if canDrill then Just (loc, True) else Nothing
      _ -> Nothing
    maybeDownLoc = case downBoundary bounds of
      (AdjacentCell loc) -> Just (loc, False)
      (Wall loc) -> if canDrill then Just (loc, True) else Nothing
      _ -> Nothing
    maybeLeftLoc = case leftBoundary bounds of
      (AdjacentCell loc) -> Just (loc, False)
      (Wall loc) -> if canDrill then Just (loc, True) else Nothing
      _ -> Nothing

Now we want a helper function to convert each of these results into a new DrillSearchItem. If we applied the drill, we'll want to subtract one from the remaining drills count. But then if we go over a drill powerup, we'll increment the count and remove this location from our set:

getDrillAdjacentItems :: Maze -> DrillSearchItem -> [DrillSearchItem]
getDrillAdjacentItems maze (location, drillsRemaining, drillLocs) =
  ...
  where
    ...
    mkItemFromResult :: (Location, Bool) -> DrillSearchItem
    mkItemFromResult (loc, usedDrill) =
      let drillsAfterMove =
        if usedDrill
          then drillsRemaining - 1
          else drillsRemaining

      let (drillsAfterPickup, newDrillLocs) =
        if Set.member loc drillLocs
          then (drillsAfterMove + 1, Set.delete loc drillLocs)
          else (drillsAfterMove, drillLocs)
      in  (loc, drillsAfterPickup, newDrillLocs)

And then finally we apply this function over every Just result in our adjacent items!

getDrillAdjacentItems :: Maze -> DrillSearchItem -> [DrillSearchItem]
getDrillAdjacentItems maze (location, drillsRemaining, drillLocs) =
  mkItemFromResult <$>
   (catMaybes [maybeUpLoc, maybeRightLoc, maybeDownLoc, maybeLeftLoc])
  where
  ...

When we rewrite the other BFS functions, the changes are quite trivial. We'll write a new function for the BFS search, since it will apply the different helper, along with other surface level tweaks. The state stays the same except for using DrillSearchItems:

data DrillBFSState = DrillBFSState
  (Seq.Seq DrillSearchItem)
  (Set.Set DrillSearchItem)
  (Map.Map DrillSearchItem DrillSearchItem)

drillBFS :: Maze -> Location -> State DrillBFSState [Location]

Note that we're still only returning a list of locations. We'll let other functions handle the logic of determining if we used the drill or not. So our final call to this function is pretty clean. It just takes a couple extra arguments for our initial state:

getShortestPathWithDrills
  :: Maze
  -> Word
  -> Set.Set Location
  -> Location
  -> Location
  -> [Location]
getShortestPathWithDrills
  maze numDrills drillLocs initialLocation targetLocation = 
      evalState
          (drillBFS maze targetLocation)
          (DrillBFSState
          (Seq.singleton initialItem)
          (Set.singleton initialItem)
          Map.empty)
  where
    initialItem =
      (initialLocation, numDrills, drillLocs)

Last Touches

Once we've changed our algorithm, we have to make one more change to the makePlayerMove function. We'll examine the shortestPathMoveDirection. This will tell us the location we're supposed to go to next. If this is behind a wall, we know we also have to apply the drill in that direction. If it's an AdjacentCell, the drill is not necessary, so use DirectionNone.

makePlayerMove :: World -> PlayerMove
makePlayerMove w =
  PlayerMove finalMoveDirection useStun drillDirection
  where
    ...
    shortestPath = getShortestPathWithDrills
      maze
      (playerDrillsRemaining currentPlayer)
      (Set.fromList $ worldDrillPowerUpLocations w)
      playerLoc
      (endLocation w)
    shortestPathMoveLocation = if null shortestPath
      then playerLoc
      else (head shortestPath)
    shortestPathMoveDirection =
      getMoveDirection playerLoc shortestPathMoveLocation

    locationBounds = maze Array.! playerLoc


    -- Apply the drill if there's a wall!
    drillDirection = case shortestPathMoveDirection of
      DirectionUp -> case upBoundary locationBounds of
        Wall _ -> DirectionUp
        _ -> DirectionNone
      DirectionRight -> case rightBoundary locationBounds of
        Wall _ -> DirectionRight
        _ -> DirectionNone
      DirectionDown -> case downBoundary locationBounds of
        Wall _ -> DirectionDown
        _ -> DirectionNone
      DirectionLeft -> case leftBoundary locationBounds of
        Wall _ -> DirectionLeft
        _ -> DirectionNone
      DirectionNone -> DirectionNone

      ...

Note that we don't need to perform any checks on whether drilling is viable here. If, for some reason, our AI tells us to use the drill and it's invalid, drillLocation will stop this. Then our function for getting the next location will keep the player stationary.

Now we can go ahead and play the game with the AI enabled. We can see that it uses the drill effectively and makes intelligent choices about where and when to do so. It will sometimes go out of its way to pick up an extra drill if this allows it to make a strategic hole. It's not 100% optimal. For instance, we won't use a drill to break a wall to pick up three hidden drills. But it covers most of the important cases for us.

There is a drawback with our algorithm. The game can actually appear a little choppy, especially at the start of the maze. Because we modified the search state to contain a lot more information, the search space is many times bigger. So it is slower to arrive at solutions, especially when we're far from the end.

There are ways we can make this basic algorithm more efficient. Caching is a good place to start. We recompute a lot of information about distances within the maze every time. But there are also other search approaches we can make that will generally be faster. In the coming weeks, we'll explore some of these options.

Conclusion

But first, we'll take a look next week at how we can now run the game separately from the UI. This will allow us to perform many iterations. We'll measure the AI's success rate under different parameters. We'll see how the size of the maze, the number of enemies, and the number of drills affects that rate. This will give us information we can use to make a better use experience for players.

If you want to learn more about Haskell, you should subscribe to our mailing list! You'll get our monthly newsletter, as well as access to our subscriber resouces! This includes, for instance, our Beginners Checklist, to help you get started!

And last, don't forget to take a look at our Github Repository to see all the code in its final state! For this article, look for the player-ai-drill branch!

Preparing for Simulation: Player AI

two_brains.jpg

Our goal for the next couple of weeks will be to run our game as a simulation, without any kind of player input. This means we'll be able to run through rapid iterations of the game and see the results. We can tune parameters and see what makes the game more competitive. But if we don't have player input, we have to move the main character somehow!

This means writing an AI for our player like we have for the enemies. The "player" has more possible actions and inputs, so it will be a little more complicated. We'll restructure our code a bit to make this easier. As with previous parts, take a look at our Github repository for more details. Refer to the player-ai branch for this article.

If you've never programmed in Haskell before, take a look at our Beginners Checklist and read our Liftoff Series! They'll help you get going so you can understand some of the concepts in these articles!

Basic Rules

For the first iteration of our AI, we won't use the drill power up at all. Each "move" will consist of two things. First, we'll pick a direction to move (or stand still). Second, we'll return a boolean for whether to activate the stun power-up.

data MoveChoice =
  MoveUp |
  MoveRight |
  MoveDown |
  MoveLeft |
  StandStill

data PlayerMove = PlayerMove
  {  moveChoice :: MoveChoice
  , activateStun :: Bool
  }

The choice depends on the state of the world. So our final goal is a function like:

makePlayerMove :: World -> PlayerMove
...

Once we have the player's move, we'll leave it up to the main update function to determine the result. We could also return a Location instead of a MoveChoice. This might seem more natural at times. But there are a couple reasons we want to stick with this approach.

One long-term goal is to machine-learn this function. So it will help a lot to limit the scope of the output space as much as possible. This means we're much more likely to come up with legal moves. We also want to leave it up to the game engine to determine that our move can't corrupt the game state. So we'll make our "choice" and devise other functions to manipulate the world.

Now that we know our basic types, let's come up with some simple rules to dictate our behavior.

  1. Determine the shortest path to the destination
  2. If there is an enemy on that path within the stun radius, activate the stun, if we can.
  3. If we don't have our stun, choose any move away from the enemy.

So we can see some specific elements we'll need to code up. Step 1 is the simplest. We've already written out a function for finding the shortest path to our destination. Determining if there's an enemy on that path will be simple as well. The last part will be a little trickier, but manageable. Before we write this function though, we want to update our game infrastructure a bit to support to AI. We'll try to keep this section somewhat light on details.

Game Infrastructure

First, we'll need a couple new parameters for our game. Our player now needs a lagTime parameter like what the Enemy type has. We also need a boolean on our parameter object indicating whether we're using the AI or human input. As always, we'll update JSON instances to reflect these new fields:

data GameParameters = GameParameters
  { …
  , usePlayerAI :: Bool
  }

data PlayerGameParameters = PlayerGameParameters
  { …
  , lagTime :: Word
  }

For a default lag time, we'll use 5. This gives the player 4 moves for ever enemy move. We'll add an extra command line parser that will look for the argument --use-player-ai. We'll use this to fill in the parameter value.

usePlayerAIInfo :: Parser Bool
usePlayerAIInfo = switch
  (long "use-player-ai" <>
    help "Whether to use the AI version of the player")

There are also some structural changes we want to make in the game. Both the player and enemies can now move on the same update cycle, so we have to decide how they interact.

We'll now have a series of discrete update functions for each part of the game. Each of these functions changes the world in some particular way. So they all have the same type signature. We'll structure our update function by composing these different functions. Here's what it might look like:

updateFunc :: Float -> World -> World
updateFunc _ w
  | … -- Win/Lose Conditions
  | otherwise = newWorld -- Normal Game Tick
  where
    afterPlayerMoveWorld = if usePlayerAI . worldParameters $ w
      then
        updateWorldForPlayerMove .
        clearStunCells .
        incrementWorldTime $ w
      else clearStunCells . incrementWorldTime $ w

    newWorld :: World
    newWorld =
      updateWorldForEnemyTicks .
      updateWorldForPlayerTick .
      updateWorldForEnemyMoves .
      updateWorldForPlayerMove .
      clearStunCells .
      incrementWorldTime $
      w

-- Reduce Stun Timers, etc.
updateWorldForEnemyTicks :: World -> World
updateWorldForPlayerTick :: World -> World

-- Update Locations
updateWorldForEnemyMoves :: World -> World

-- Update Location, Pickup Drills, Activate Stun if necessary
updateWorldForPlayerMove :: World -> World

incrementWorldTime :: World -> World

clearStunCells :: World -> World

Note though that we do want to account for the case where the player isn't AI controlled. So the final product actually looks like this:

updateFunc :: Float -> World -> World
updateFunc _ w
  ...
  | otherwise = newWorld
  where
    afterPlayerMoveWorld = if usePlayerAI . worldParameters $ w
      then
        updateWorldForPlayerMove .
        clearStunCells .
        incrementWorldTime $ w
      else clearStunCells . incrementWorldTime $ w

    newWorld :: World
    newWorld =
      updateWorldForEnemyTicks .
      updateWorldForPlayerTick .
      updateWorldForEnemyMoves $
      afterPlayerMoveWorld

We won't go over most of these changes in depth right here, as they're purely refactoring. In future articles we'll definitely look a bit more at how the enemy movement code changed. We'll want it to look as much as possible like the player AI code so we can machine . In the next section, we'll look at the player move function in a little more detail before writing our AI. Before that though, it's worth noting that we should also disable our input handler when using the AI:

inputHandler :: Event -> World -> World
inputHandler event w
  ...
  | usePlayerAI . worldParameters $ w = w -- No updates when AI is on!

Wrapping the Player Move

Above, we can see a mutator function updateWorldForPlayerMove. This will mainly be a wrapper around our primary AI function, makePlayerMove. But we'll establish a general pattern with it. This wrapper will first handle the game logic of determining whether we should move or not.

updateWorldForPlayerMove :: World -> World
updateWorldForPlayerMove w = if shouldMovePlayer
  then worldAfterMove
  else w
  where
    shouldMovePlayer =
      (worldTime w)
      `mod`
      (lagTime . playerGameParameters . worldParameters $ w) == 0
    worldAfterMove = ...

Then it will call the AI function. It will use the results to figure out what world changes are necessary and apply them. The object is to separate the "brain" from the game logic as much as possible. Note that we update the world for the stun first, and then the player's move.

updateWorldForPlayerMove :: World -> World
updateWorldForPlayerMove w = if shouldMovePlayer
  then worldAfterMove
  else w
  where
    shouldMovePlayer =
      (worldTime w) `mod`
      (lagTime . playerGameParameters . worldParameters $ w) == 0
    move = makePlayerMove w
    player = worldPlayer w
    currentLoc = playerLocation player

    worldAfterStun = if activateStun move
      then modifyWorldForStun w
      else w

    newLocation = nextLocationForMove
      (worldBoundaries w Array.! currentLoc)
      currentLoc   
      (playerMoveChoice move)
    worldAfterMove = modifyWorldForPlayerMove
      worldAfterStun newLocation

-- Stun enemies and change parameters as needed
modifyWorldForStun :: World -> World
...

-- Changes the player's location, track drill pickups
modifyWorldForPlayerMove :: World -> Location -> World
…

-- Take a move direction and give the location
nextLocationForMove ::
  CellBoundaries -> Location -> MoveChoice -> Location

Note we can apply more game logic and rules in our World modifier functions. Suppose, for some reason, the AI function returns True to stun enemies when our stun is on cooldown. It's the job of modifyWorldForStun to ensure nothing actually happens.

Shortest Path

Now that that's done, we can start writing our AI function at last! Let's start simple, and find the shortest path to the end.

makePlayerMove w = …
  where
    currentPlayer = worldPlayer w
    playerLoc = playerLocation currentPlayer
    maze = worldBoundaries w

    shortestPath = getShortestPath maze playerLoc (endLocation w)

Now we'll derive a PlayerMoveChoice based on that path. As mentioned above, it's tempting to return the location on the path. But remember, we want to limit the output scope as much as we can. Let's make a function for getting the direction out of two locations.

getMoveChoice :: Location -> Location -> MoveChoice
getMoveChoice (x1, y1) (x2, y2)
  | y2 == y1 + 1 = MoveUp
  | x2 == x1 + 1 = MoveRight
  | y2 == y1 - 1 = MoveDown
  | x2 == x1 - 1 = MoveLeft
  | otherwise = StandStill

So now we could, if we were naive, simply get out our move choice from the path:

makePlayerMove w = PlayerMove moveChoice False
  where
    …
    shortestPath = getShortestPath maze playerLoc (endLocation w)
    moveChoice = if null shortestPath then StandStill else getMoveChoice playerLoc (head shortestPath)

At this point, we should be able to run our game! The player will boldly walk towards the destination square through the maze. But if we have any enemies in our path, we're toast! Let's determine how we can use our stun!

Stunning Enemies

To determine when to use our stun, let's first get a set of the active enemy locations.

makePlayerMove w =
  where
    …
    shortestPath = …
    activeEnemyLocs = Set.fromList
      (enemyLocation <$>
        (filter (\e -> enemyCurrentStunTimer e == 0)
          (worldEnemies w)))

Now let's truncate the path to only include spots that might be in our stun radius. Then we can find if an enemy is there:

makePlayerMove w = (moveChoice, useStun)
  where
    …
    shortestPath = …
    enemyLocs = Set.fromList (enemyLocation <$> (worldEnemies w))
    radius = stunRadius . playerGameParameters . worldParameters $ w
    enemyClose = any
      (\l -> Set.member l activeEnemyLocs)
      (take radius shortestPath)
    canStun = playerCurrentStunDelay currentPlayer == 0
    useStun = enemyClose && canStun

We're getting closer now! We'll find that our player can stun enemies as long as it's ready. But if the stun isn't ready, we'll run straight into them! We don't want that! So let's figure out how to make a good retreat in case we don't have our stun ready.

Retreating

This leaves us with our last bit of logic. If an enemy stands between us and our shortest path, is close by, and we don't have our stun ready, we should run away. We'll make this as simple as possible by picking the first adjacent location that isn't on our shortest path. This doesn't always work that well. But it'll do for now. We need a list of adjacent locations, and then we select one that isn't on our shortest path. Here's how that logic pans out:

makePlayerMove :: World -> PlayerMove
makePlayerMove w = PlayerMove finalMoveChoice useStun
  where
    ...
    shortestPath = getShortestPath maze playerLoc (endLocation w)
    shortestPathMoveLocation = if null shortestPath
      then playerLoc
      else (head shortestPath)
    shortestPathMoveChoice = getMoveChoice
      playerLoc shortestPathMoveLocation

    activeEnemyLocs = ...
    radius = ...
    enemyClose = ...

    canStun = playerCurrentStunDelay currentPlayer == 0

    possibleMoves = getAdjacentLocations maze playerLoc

    (finalMoveChoice, useStun) = if not enemyClose
      then (shortestPathMoveChoice, False)
      else if canStun
        then (shortestPathMoveChoice, True)
        else case find (/= shortestPathMoveLocation) possibleMoves of
          Nothing -> (StandStill, False)
          Just l -> (getMoveChoice playerLoc l, False)

And now our AI actually works quite well! It can navigate the maze and stun enemies when it needs to. When it has to wait for its stun to re-charge, it'll back away from enemies as needed until the stun is ready.

Conclusion

Next week, we'll use some more advanced tactics to navigate the maze. Specifically, we'll look into how we can use our drill powerup. We'll need to re-think how we calculate the shortest path. We won't be using pure maze distance any more, since we can change the maze! So that will be an interesting problem. After we wrap that up, we'll look into separating the game from the GUI component so we can run simulations.

As always, check out our Github repository for full implementation details. This article uses the player-ai branch, so make sure you select that one!

And for more tips on getting better at Haskell, you should subscribe to our mailing list! You'll get access to all our subscriber resources. This includes our Beginners Checklist and our Production Checklist!

Gloss Review!

For the last few months, we've been constructing a simple game using the Gloss library. This library provides a neat and tidy interface for us to construct game components and put them together. The game is available to build and fork on our Github Repository. Here's a quick review of everything we've done:

Part 1: Overview of the Gloss library, constructing basic simulations and games

Part 2: Creating our maze type

Part 3: Generating random mazes using Depth-First-Search

Part 4: Victory Status Screen

Part 5: Serializing and parsing a maze

Part 6: Refactoring using Compile Driven Development

Part 7: Using Mutable Arrays for maze construction

Part 8: Adding enemies to the maze

Part 9: Making enemies more intelligent with Breadth-First-Search

Part 10: Adding a stun power to fight back against enemies

Part 11: Parameterizing the application and saving the world state

Part 12: Re-loading the world state, adding command line parameters

Part 13: Adding a drill power-up to take shortcuts through the maze

In this series, we explored some cool algorithmic concepts. We saw how to use the state monad for breadth first search and depth first search. We also explored mutable arrays, which aren't used that often in Haskell. If you're new to Haskell, it's good to get familiar with how some of these algorithms work.

We also emphasized using a methodical development approach. The Gloss architecture enables us to have a simple process for adding new features to the game. Combining this with compile driven development is powerful combination for rapid iteration.

We're probably not going to add any more core features to this game. But that doesn't mean we're done working with it! We're going to continue using the game as a platform for learning about interesting concepts and algorithms. Expect to see some articles related to search algorithms, AI development, and game architecture coming soon!

Until then, don't forget that you can subscribe to Monday Morning Haskell! You'll hear about our upcoming articles through our monthly newsletter. You'll also get access to our subscriber resources! There's plenty to learn both for beginners and more advanced Haskellers!

Loading Games and Changing Colors!

floppy_disk.png

Last week we added functionality for serializing our world state. This allowed us to save our game with the press of a button. We also parameterized our application so that we could customize many aspects of it. We didn't explore all the possibilities though! This week, we'll see how we can load a previous game-state by using command line options. We'll also use options to specify how the game appears!

As always, take a look at our Github repository to see the full code. This article corresponds to the part-9 branch.

All this is part of our effort to make our game more "mature". But you should also consider some libraries that will be more useful in industry! Take a look at our Production Checklist!. Whether it's web servers or databases, you'll learn how Haskell interacts with more advanced concepts!

Command Line Options

Everything we do this week will happen through command line options. For a quick refresher on these, take a look at this article! We'll have a couple main concerns. First, we want to take an optional filename argument to load the initial world state. If we get this, we'll throw the player right back into their game! If we don't get this argument, we'll generate a new, random state for them to work with.

Second, we'll make command line parameters for all our different render parameters. This will allow anyone invoking the game to customize the appearance! We'll also allow them to specify a whole file for these as well. This will involve quite a bit of work with the Options.Applicative library.

Our main goal is this function:

parseOptions :: IO (Maybe FilePath, RenderParameters)

This will return us a possible file path to load our world state from, as well as a set of render parameters. Let's start with some basic framework code.

Parser Setup

The first item we want is a generic parser that will give us Maybe values. As far as I could tell the options library doesn't have this built-in. But it's not too hard to write. We want to use the option function to start with. It will attempt the given parser. If it succeeds, we want to wrap it with Just. Then we'll append a default value of Nothing to the options in case it fails.

maybeParser ::
  ReadM a -> Mod OptionFields (Maybe a) -> Parser (Maybe a)
maybeParser reader opts =
  option (Just <$> reader) (opts <> value Nothing)

We can now use this to build a parser for the maze file:

mazeFileParser :: Parser (Maybe FilePath)
mazeFileParser = maybeParser str
 (long "load-file" <> short 'f'
   <> help "A file to use to load the world state")

And now we just apply execParser on this, supplying some simple Info for our parser:

parseOptions :: IO (Maybe FilePath)
parseOptions = execParser $ info mazeFileParser commandInfo

commandInfo :: InfoMod (Maybe FilePath)
commandInfo = fullDesc <> progDesc "Haskell Maze Game"

Runner Updates

The next step is a short function for loading our world from the file. Since we have our JSON instance on the World type, we'll rely on decodeFileStrict'. There's one caveat. If the game parameters don't have a random seed value, we'll use a new one. Otherwise we'll use mkStdGen on the seed:

loadWorldFromFile :: FilePath -> IO World
loadWorldFromFile fp = do
 parseResult <- Data.Aeson.decodeFileStrict' fp
 case parseResult of
   Just w -> do
     gen <- case randomGeneratorSeed (worldParameters w) of
       Nothing -> getStdGen
       Just i -> return $ mkStdGen i
     return $ w { worldRandomGenerator = gen }
   Nothing -> error $ "Couldn't parse world from file " ++ fp ++ "!"

Now we want to make some changes to our main running function. We'll run our argument parser first. If we get a file from the options, we'll load the initial World from that file. Otherwise, we'll use our previous flow with generating a random maze.

main :: IO ()
main = do
 maybeLoadFile <- parseOptions
 initialWorld <- case maybeLoadFile of
   Just loadFile -> loadWorldFromFile loadFile
   Nothing -> …
 play ...

Parsing a Render File

This is good enough to load the world, so we can re-start from a saved (or derived) position. But suppose we wanted to go a step further. Suppose we wanted to also load our render parameters. We could use another file if we liked. We could start with another parser for a file path:

renderFileParser :: Parser (Maybe FilePath)
renderFileParser = maybeParser str
 (long "render-param-file" <> short 'r'
   <> help "A file to use to load render parameters")

Then we'll combine our two parsers together like so:

parser :: Parser (Maybe FilePath, Maybe FilePath)
parser = (,) <$>
 mazeFileParser <*>
 renderFileParser

Now we'll add a bit more logic to the wrapper function. If we have a file, we should use it to load the RenderParameters object:

parseOptions :: IO (Maybe FilePath, RenderParameters)
parseOptions = do
 (mazeFile, renderFile) <- execParser $ info parser commandInfo
 case renderFile of
   Nothing -> return (mazeFile, defaultRenderParameters)
   Just fp -> do
     parseResult <- decodeFileStrict' fp
     case parseResult of
       Nothing -> return (mazeFile, defaultRenderParameters)
       Just fileRenderParams -> return (mazeFile, fileRenderParams)

Note that the type of our commandInfo will also need to change as a result of this. But then we just have the simple task of getting other these items out in our main function:

main :: IO ()
main = do
 (maybeLoadFile, renderParams) <- parseOptions
 ...

Individual Render Parameters

We have one last trick though! Suppose we want to change one thing about the game's appearance and we don't want to use a JSON file. We can add individual options on render elements. We've got a lot of possible elements. We'll wrap them all in a basic type, matching the fields we have in the different sub-components. Each of these fields is optional. We'll "merge" them with a complete set of render parameters to get a final result.

data RenderParamInfo = RenderParamInfo
 -- Screen/Text Parameters
 (Maybe Int)
 (Maybe Int)
 (Maybe Int)
 (Maybe Float)
 (Maybe Float)
 (Maybe Float)
 (Maybe Float)
 -- Player Parameters
 (Maybe Float)
 (Maybe Color)
 (Maybe Float)
 (Maybe Color)
 -- Enemy Parameters
 (Maybe Float)
 (Maybe Color)
 (Maybe Color)
 -- Cell Parameters
 (Maybe Color)
 (Maybe Color)
 (Maybe Float)

Each field will have it's own parser. These will all be variations on our maybeParser:

maybeIntParser :: Mod OptionFields (Maybe Int) -> Parser (Maybe Int)
maybeIntParser = maybeParser auto

maybeFloatParser ::
  Mod OptionFields (Maybe Float) -> Parser (Maybe Float)
maybeFloatParser = maybeParser auto

maybeColorParser ::
  Mod OptionFields (Maybe Color) -> Parser (Maybe Color)
maybeColorParser = maybeParser (maybeReader colorReader)
 where
   colorReader "blue" = Just blue
   … -- other colors

Then we can combine them using applicative syntax, and providing some help information:

parseRenderInfo :: Parser RenderParamInfo
parseRenderInfo = RenderParamInfo <$>
 maybeIntParser (long "screen-dimen"
   <> help "The screen width/height") <*>
 maybeIntParser (long "screen-offset-x"
   <> help "The screen width/height") <*>
 ...

Next we'll write a "merge" function. This will take a RenderParameters item with default values, and apply the Just values.

mergeOptions ::
  RenderParameters -> RenderParamInfo -> RenderParameters
mergeOptions rp (RenderParamInfo sd_ sox_ ...)
 = RenderParameters
   (fromMaybe (screenDimen rp) sd_)
   (fromMaybe (screenOffsetX rp) sox_)
   ...

Then we add this new parser to our set:

parser :: Parser (Maybe FilePath, Maybe FilePath, RenderParamInfo)
parser = (,,) <$>
 mazeFileParser <*>
 renderFileParser <*>
 parseRenderInfo

And our original function should now reflect the need to merge parameters.

parseOptions :: IO (Maybe FilePath, RenderParameters)
parseOptions = do
 (mazeFile, renderFile, renderInfo) <- execParser $
                                         info parser commandInfo
 case renderFile of
   Nothing -> return
     (mazeFile, mergeOptions defaultRenderParameters renderInfo)
   Just fp -> do
     parseResult <- decodeFileStrict' fp
     case parseResult of
       Nothing -> return
         (mazeFile, mergeOptions defaultRenderParameters renderInfo)
       Just fileRenderParams -> return
         (mazeFile, mergeOptions fileRenderParams renderInfo)

Wrapping Up

Now we've got a lot of interesting possibilities. We can save our game from a particular state:

maze_game_1.png

Then we can load it back up with different colors. For example, we can make some obnoxious green walls:

stack exec -- maze-game --load-file=maze_game_save_1557121650\
  --cell-wall-color=green --enemy-base-color=red
maze_game_2.png

Conclusion

Now that our game is customizable and re-loadable we'll be able to do a lot more interesting things with it. We'll be able to run many simulations that test the difficulty. Some day, we'll be able to make the AI much better! For the time being though, there are still some more features we can add. So the next couple parts of this series will explore some other exciting twists in the game-play. This will lead us to a point where other types of refactors will be necessary.

Making a project like this requires a good knowledge of the Stack tool. To learn more, take our free mini-course on Using Stack!.

Spring Cleaning: Parameters and Saving!

broom.jpg

Our game is a lot more interesting after the changes we made last week. But there's still lots of room for improvement. There are many things that could make the game more or less interesting, depending how we tune things. For instance, how many enemies is too many? What's a good stun duration? How quickly does the game get harder if we tweak these parameters?

Right now, it would be hard for us to answer these questions in a systematic way. We've baked many of these parameters directly into the code. So we would have to recompile everything if we wanted to test out another version of the game. This is a bad sign. We should be able to run the same binary with different sets of parameters.

Another issue with our game is that the only real "flow" is to start off with a random arrangement. We don't know what the map will be or where the enemies start. But if we want to test how well certain concepts work, we'll want true re-playability. In other words, we'll want to be able to start the game from a certain state we've established.

This week, we'll start to clean these things up. The first job will be to move a lot of our magic numbers into the World type. Then we'll devise a way to serialize the complete world state. We've already done the hard work of ensuring we can serialize the map. The rest will be pretty straightforward using JSON instances. We'll wrap up this week by adding the option to save the game in the middle of the action. Then next week, we'll add some options to our game so we can load a particular starting state from a file.

As with each of the different phases of this projects, you can take a look at our Github repository to see how we do everything. For this article, you should be following the part-8 branch. We'll also provide a couple commit links for so you can follow along step-by-step.

As you get better at using Haskell, you'll be able to use it for more and more types of projects. Download our Production Checklist for some ideas!

Parameterizing the App

There are a lot of "magic numbers" floating around our app right now. Some of these have to do with game-play logic. How many enemies are there? What's their cool-down time? How long is our player's stun timer? Then there are other parameters that have to do with how we draw the game. For instance, what colors do we use? How big are the cells?

We make this distinction because we should be able to run our game without any render information. At some point, we'll run simulations of this game that don't get drawn at all. So it would be useless to have drawing information around. Thus we'll have GameParameters types that will live in the World. Then we'll have RenderParameters types for drawing everything.

With that said, let's starting devising what information these types contain. We'll start out with types describing the player and enemy parameters:

data PlayerGameParameters = PlayerGameParameters
  { initialStunTimer :: Word
  , stunTimerIncrease :: Word
  , stunTimerMax :: Word
  , stunRadius :: Int
  }

data EnemyGameParameters = EnemyGameParameters
  { initialStunTime :: Word
  , stunTimeDecrease :: Word
  , minStunTime :: Word
  , enemyRandomMoveChance :: Word
  , initialLagTime :: Word
  , minLagTime :: Word
  }

Now we can use these to populate a bigger type with more generic game parameters:

data GameParameters = GameParameters
  { numRows :: Int
  , numColumns :: Int
  , numEnemies :: Int
  , tickRate :: Int
  , playerGameParameters :: PlayerGameParameters
  , enemyGameParameters :: EnemyGameParameters
  , randomGeneratorSeed :: Maybe Int
  }

Notice the random seed is a Maybe value. In the normal circumstances of running the program, we don't want to fix the random generator. But there are cases where we'll want to load from a specific stored state. If we fix the generator seed value, gameplay will be deterministic. This could be a desirable property in some circumstances. In most cases though, this will be Nothing.

With all these types in place, we'll now add the game parameters to our World:

data World = World
  { …
  , worldParameters :: GameParameters
  }

We'll go through a similar process with RenderParameters. The main difference will be that we will not attach the type to the World. There will also be a CellRenderParameters type as well as types for the Player and Enemy. This gives us information about how individual cells get displayed on our screen. Here's a quick sample of this code. You can see the other types at the bottom as an appendix.

data RenderParameters = RenderParameters
  { screenWidth :: Float
  , screenHeight :: Float
  , screenOffsetX :: Float
  , screenOffsetY :: Float
  , textOffset :: (Float, Float)
  , textScale :: (Float, Float)
  , playerRenderParameters :: PlayerRenderParameters
  , enemyRenderParameters :: EnemyRenderParameters
  , cellRenderParameters :: CellRenderParameters
  }

data CellRenderParameters = CellRenderParameters
  { cellWallColor :: Color
  , cellStunColor :: Color
  , cellWallWidth :: Float
  }

No More Magic

Once we have these types in place, our next step is to replace the magic numbers (and colors) in our application. We'll need to add the parameters as arguments in a few places. Most of all, the drawingFunc will need the RenderParameters argument.

drawingFunc :: RenderParameters -> World -> Picture
...

This process isn't too much of a challenge, as all our important functions take the World as an input. Then for now, we'll pass our default parameter packs as arguments when running the program. Here's a quick look at changes to our main function:

main :: IO ()
main = do
  gen <- getStdGen
  let gameParams = defaultGameParameters
      renderParams = defaultRenderParameters
      (maze, gen') = generateRandomMaze
        gen (numRows gameParams, numColumns gameParams)
      (randomLocations, gen'') = runState
        (replicateM
          (numEnemies gameParams)
          (generateRandomLocation
            (numRows gameParams, numColumns gameParams)))
            gen'
      enemies = (mkNewEnemy
        (enemyGameParameters gameParams)) <$> randomLocations
      endCell = (numColumns gameParams - 1, numRows gameParams - 1)
      initialWorld = World
        (newPlayer (playerGameParameters gameParams))
        (0,0) endCell maze GameInProgress gen'' enemies [] 0 
        gameParams
  play
    (windowDisplay renderParams)
    white
    (tickRate gameParams)
    initialWorld
    (drawingFunc renderParams)
    inputHandler
    updateFunc

Take a look at this commit for a longer look at all our parameter changes.

Serializing Our World

Now that we've updated our World type, we'll want to determine how we can serialize it. For simplicity's sake we'll use JSON serialization. This is mostly a matter of creating (or, if you wish, deriving), a bunch of ToJSON and FromJSON instances. Check out this article for a refresher on the Data.Aeson library.

Most of this code is pretty simple. With game parameters, a lot of the instances are a simple matter of creating and parsing pairs. Here's an example with Player:

instance FromJSON Player where
  parseJSON = withObject "Player" $ \o -> do
    location <- o .: "location"
    currentStunDelay <- o .: "currentStunDelay"
    nextStunDelay <- o .: "nextStunDelay"
    return $ Player location currentStunDelay nextStunDelay

instance ToJSON Player where
  toJSON p = object
    [ "location" .= playerLocation p
    , "currentStunDelay" .= playerCurrentStunDelay p
    , "nextStunDelay" .= playerNextStunDelay p
    ]

But there are a few caveats. To start, we need to make a separate file for these instances. We'll need our maze parsing code for the World type, and this depends on the Types module. We have to avoid the resulting dependency cycle.

It's generally a bad practice to separate instances from the type declarations. We call these "orphan" instances and you'll get a compiler warning about them in other projects. A way around this is to create wrapper types. This is a little tedious, so we won't do it for all the types. But we will show the concept for the Color type from Graphics.Gloss. Let's start with a wrapper type:

newtype ColorWrapper = ColorWrapper { unColor :: Color }

Now we can create instances on this wrapper, and they're considered valid. To cover all cases of color, we'd use RGB arrays. But we'll color cover the 9 or so colors we care about and parse them as strings. Here's what the instances look like. Notice how we wrap and unwrap the actually library functions for the colors:

instance ToJSON ColorWrapper where
  toJSON (ColorWrapper c) = Ae.String colorStr
    where
      colorStr
        | c == blue = "blue"
        | c == red = "red"
        | c == yellow = "yellow"
        | c == green = "green"
        | c == cyan = "cyan"
        | c == orange = "orange"
        | c == magenta = "magenta"
        | c == rose = "rose"
        | c == black = "black"

instance FromJSON ColorWrapper where
  parseJSON = withText "ColorWrapper" parseText
    where
      parseText "blue" = return (ColorWrapper blue)
      parseText "red" = return (ColorWrapper red)
      parseText "yellow" = return (ColorWrapper yellow)
      parseText "green" = return (ColorWrapper green)
      parseText "cyan" = return (ColorWrapper cyan)
      parseText "orange" = return (ColorWrapper orange)
      parseText "magenta" = return (ColorWrapper magenta)
      parseText "rose" = return (ColorWrapper rose)
      parseText "black" = return (ColorWrapper black)
      parseText _ = error "Couldn't parse color!"

Then we can use these instances within other parsers for render parameters. The other caveat now is to parse out our World in two stages. We'll get all the basic fields and parameters first:

instance FromJSON World where
  parseJSON = withObject "World" $ \o -> do
    player <- o .: "player"
    startLoc <- o .: "startLocation"
    endLoc <- o .: "endLocation"
    result <- o .: "result"
    enemies <- o .: "enemies"
    stunCells <- o .: "stunCells"
    time <- o .: "time"
    params <- o .: "gameParameters"
  ...

Now we'll get the boundaries as a Text item. We'll parse the maze boundaries out using our parser as well as the number of rows and columns.

instance FromJSON World where
  parseJSON = withObject "World" $ \o -> do
    ...
    (boundaryString :: Text) <- o .: "boundaries"
    let (rs, cs) = (numRows params, numColumns params)
    let boundaries =
      case runParser (mazeParser (rs, cs)) "" boundaryString of
          Right result -> result
          _ -> error "Map parse failed!"

As a last trick, we'll check what the random seed is within our parameters. If it's Nothing, we'll fix the generator with a seed of 1 and rely on other code to change it:

instance FromJSON World where
  parseJSON = withObject "World" $ \o -> do
    ...
    let gen = case randomGeneratorSeed params of
          Just i -> mkStdGen i
          _ -> mkStdGen 1
    return $ World player startLoc endLoc boundaries
      result gen enemies stunCells time params

Take a look at this commit to see the full code for these instances. Now let's see how we use them!

Saving Our World

We'd like to make it so that our user can save their game-state by hitting the s key at any point in the game. This idea starts out simple enough. We add a handler for the key in our inputHandler.

inputHandler :: Event -> World -> World
inputHandler event w
  | worldResult w == GameWon = ...
  | worldResult w == GameLost = ...
  | otherwise = case event of
      ...
      (EventKey (Char 's') Down _ _) -> ...

But now we're a little stuck! We want to write out to a file, but our handler is a pure function! There miiight be a way to do this without breaking functional purity. Perhaps we could keep a list of saved world states and add a handler to save them at the end of our program. But Gloss wasn't made for that. So we're going to break the rules a bit and resort to unsafePerformIO. This allows us to run an IO computation from a seemingly pure context. Here's the basic layout:

inputHandler :: Event -> World -> World
inputHandler event w
      ...
      (EventKey (Char 's') Down _ _) -> unsafeSaveWorldToFile w

unsafeSaveWorldToFile :: World -> World
unsafeSaveWorldToFile w = unsafePerformIO $ do
  …
  return w

Since we have a JSON instance for our World, we'll lean on the encodeFile function. The rest of the work here comes from generating a filename using the current time, for uniqueness:

unsafeSaveWorldToFile :: World -> World
unsafeSaveWorldToFile w = unsafePerformIO $ do
  timeAsString <- show . floor <$> getPOSIXTime
  currentDir <- getCurrentDirectory
  let filename = currentDir ++ "/maze_game_save_" ++ timeAsString
  encodeFile filename w
  return w

And that's all it takes for us to save some game files! Perhaps you've heard the phrase "don't try this at home." When it comes to unsafePerformIO, feel free to try it at home, but don't try it at work! Take a look at this commit for details on saving the state.

Conclusion

In spite of unsafePerformIO, our game feel like a much more "grown-up" program now. The code quality is much better with our parameters. We now have a lot more options of what to do when it comes to improving it. Saving the world state is the first step towards solving some interesting problems. Next week, we'll explore how we can load the saved game states we've created.

As we move forward, we'll keep trying to turn this game into a more mature program. Eventually though, you should think about using Haskell for more common production use cases. To learn about different libraries you can use, download our Production Checklist!

Appendix: Render Parameter Types

data RenderParameters = RenderParameters
  { screenDimen :: Int
  , screenOffsetX :: Int
  , screenOffsetY :: Int
  , textOffset :: (Float, Float)
  , textScale :: (Float, Float)
  , playerRenderParameters :: PlayerRenderParameters
  , enemyRenderParameters :: EnemyRenderParameters
  , cellRenderParameters :: CellRenderParameters
  }

data PlayerRenderParameters = PlayerRenderParameters
  { playerIndicatorSize :: Float
  , playerIndicatorColor :: Color
  , playerStunIndicatorSize :: Float
  , playerStunIndicatorColor :: Color
  }

data EnemyRenderParameters = EnemyRenderParameters
  { enemySize :: Float
  , enemyBaseColor :: Color
  , enemyStunnedColor :: Color
  }

data CellRenderParameters = CellRenderParameters
  { cellWallColor :: Color
  , cellStunColor :: Color
  , cellWallWidth :: Float
  }

defaultRenderParameters :: RenderParameters
defaultRenderParameters = RenderParameters
  625 10 10 (-275, 0) (0.12, 0.25) playerParams enemyParams cellParams
  where
    playerParams = PlayerRenderParameters 10 black 5 red
    enemyParams = EnemyRenderParameters 10 orange yellow
    cellParams = CellRenderParameters blue cyan 2

Fighting Back!

stunned_ghost.png

In last week's article, we made our enemies a lot smarter. We gave them a breadth-first-search algorithm so they could find the shortest path to find us. This made it much harder to avoid them. This week, we fight back! We'll develop a mechanism so that our player can stun nearby enemies and bypass them.

None of the elements we're going to implement are particularly challenging in isolation. The focus this week is on maintaining a methodical development process. To that end, it'll help a lot to take a look at the Github Repository for this project when reading this article. The code for this part is on the part-7 branch.

We won't go over every detail in this article. Instead, each section will describe one discrete stage in developing these features. We'll examine the important parts, and give some high level guidelines for the rest. Then there will be a single commit, in case you want to examine anything else that changed.

Haskell is a great language for following a methodical process. This is especially true if you use the idea of compile driven development (CDD). If you've never written any Haskell before, you should try it out! Download our Beginners Checklist and get started! You can also read about CDD and other topics in our Haskell Brain series!

Feature Overview

To start, let's formalize the definition of our new feature.

  1. The player can stun all enemies within a 5x5 tile radius (ignoring walls) around them.
  2. This will stun enemies for a set duration of time. However, the stun duration will go down each time an enemy gets stunned.
  3. The player can only use the stun functionality once every few seconds. This delay should increase each time they use the stun.
  4. Enemies will move faster each time they recover from getting stunned.
  5. Stunned enemies appear as a different color
  6. Affected tiles briefly appear as a different color.
  7. When the player's stun is ready, their avatar should have an indicator.

It seems like there are a lot of different criteria here. But no need to worry! We'll follow our development process and it'll be fine! We'll need more state in our game for a lot of these changes. So, as we have in the past, let's start by modifying our World and related types.

World State Modifications

The first big change is that we're going to add a Player type to carry more information about our character. This will replace the playerLocation field in our World. It will have current location, as well as timer values related to our stun weapon. The first value will be the time remaining until we can use it again. The second value will be the next delay after we use it. This second value is the one that will increase each time we use the stun. We'll use Word (unsigned int) values for all our timers.

data Player = Player
  { playerLocation :: Location
  , playerCurrentStunDelay :: Word
  , playerNextStunDelay :: Word
  }


data World = World
  { worldPlayer :: Player
  ...

We'll add some similar new fields to the enemy. The first of these is a lagTime. That is, the number of ticks an enemy will wait before moving. The more times we stun them, the lower this will go, and the faster they'll get. Then, just as we keep track of a stun delay for the player, each enemy will have a stun remaining time. (If the enemy is active, this will be 0). We'll also store the "next stun duration", like we did with the Player. For the enemy, this delay will decrease each time the enemy gets stunned, so the game gets harder.

data Enemy = Enemy
  { enemyLocation :: Location
  , enemyLagTime :: Word
  , enemyNextStunDuration :: Word
  , enemyCurrentStunTimer :: Word
  }

Finally, we'll add a couple fields to our world. First, a list of locations affected by the stun. These will briefly highlight when we use the stun and then go away. Second, we need a worldTime. This will help us keep track of when enemies should move.

data World = World
  { worldPlayer :: Player
  , startLocation :: Location
  , endLocation :: Location
  , worldBoundaries :: Maze
  , worldResult :: GameResult
  , worldRandomGenerator :: StdGen
  , worldEnemies :: [Enemy]
  , stunCells :: [Location]
  , worldTime :: Word
  }

At this point, we should stop thinking about our new features for a second and get the rest of our code to compile. Here are the broad steps we need to take.

  1. Every instance of playerLocation w should change to access playerLocation (worldPlayer w).
  2. We should make a newPlayer expression and use it whenever we re-initialize the world.
  3. We should make a similar function mkNewEnemy. This should take a location and initialize an Enemy.
  4. Any instances of Enemy constructors in pattern matches need the new arguments. Use wildcards for now.
  5. Other places where we initialize the World should add extra arguments as well. Use the empty list for the stunCells and 0 the world timer.

Take a look at this commit for details!

A Matter of Time

For the next step, we want to ensure all our time updates occur. Our game entities now have several fields that should be changing each tick. Our world timer should go up, our stun delay timers should go down. Let's start with a simple function that will increment the world timer:

incrementWorldTime :: World -> World
incrementWorldTime w = w { worldTime = worldTime w + 1 }

In our normal case of the update function, we want to apply this increment:

updateFunc :: Float -> World -> World
updateFunc _ w
  ...
  | otherwise = incrementWorldTime (w 
    { worldRandomGenerator = newGen
    , worldEnemies = newEnemies
    })

Now there are some timers we'll want to decrement. Let's make a quick helper function:

decrementIfPositive :: Word -> Word
decrementIfPositive 0 = 0
decrementIfPositive x = x - 1

We can use this to create a function to update our player each tick. All we need to do is reduce the stun delay. We'll apply this function within our update function for the world.

updatePlayerOnTick :: Player -> Player
updatePlayerOnTick p = p
  { playerCurrentStunDelay =
      decrementIfPositive (playerCurrentStunDelay p)
  }

updateFunc :: Float -> World -> World
updateFunc _ w
  ...
  | otherwise = incrementWorldTime (w
    { worldPlayer = newPlayer
    , ...
    })
  where
    player = worldPlayer w
    newPlayer = updatePlayerOnTick player
    ...

Now we need to change how we update enemies:

  1. The function needs the world time. Enemies should only move when the world time is a multiple of their lag time.
  2. Enemies should also only move if they aren't stunned.
  3. Reduce the stun timer if it exists.
updateEnemy
  :: Word
  -> Maze
  -> Location
  -> Enemy
  -> State StdGen Enemy
updateEnemy time maze playerLocation
  e@(Enemy location lagTime nextStun currentStun) =
    if not shouldUpdate
      then return e
      else do
        … -- Make the new move!
        return (Enemy newLocation lagTime nextStun 
                 (decrementIfPositive currentStun))
      where
        isUpdateTick = time `mod` lagTime == 0
        shouldUpdate = isUpdateTick && 
                         currentStun == 0 && 
                         not (null potentialLocs)
        potentialLocs = …
      ...

There are also a couple minor modifications elsewhere.

  1. The time step argument for the play function should now be 20 steps per second, not 1.
  2. Enemies should start with 20 for their lag time.

We haven't affected the game yet, since we can't use the stun! This is the next step. But this is important groundwork for making everything work. Take a look at this commit for how this part went down.

Activating the Stun

Let's make that stun work! We'll do this with the space-bar key. Most of this logic will go into the event handler. Let's set up the point where we enter this command:

inputHandler :: Event -> World -> World
inputHandler event w
  ...
  | otherwise = case event of
      … -- (movement keys)
      (EventKey (SpecialKey KeySpace) Down _ _) -> ...

What are all the different things that need to happen?

  1. Enemies within range should get stunned. This means they receive their "next stun timer" value for their current stun timer.
  2. Their "next stun timers" should decrease (let's say by 5 to a minimum of 20).
  3. Our player stun delay timer should get the "next" value as well. Then we'll increase the "next" value by 10.
  4. Our "stun cells" list should include all cells within range.

None of these things are challenging on their own. But combining them all is a bit tricky. Let's start with some mutation functions:

activatePlayerStun :: Player -> Player
activatePlayerStun (Player loc _ nextStunTimer) =
  Player loc nextStunTimer (nextStunTimer + 10)

stunEnemy :: Enemy -> Enemy
stunEnemy (Enemy loc lag nextStun _) =
  Enemy loc newLag newNextStun nextStun
  where
    newNextStun = max 20 (nextStun - 5)
    newLag = max 10 (lag - 1)

Now we want to apply these mutators within our input handler. To start, let's remember that we should only be able to trigger any of this logic if the player's stun timer is already 0!

inputHandler :: Event -> World -> World
inputHandler event w
  ...
  | otherwise = case event of
      … -- (movement keys)
      (EventKey (SpecialKey KeySpace) Down _ _) ->
        if playerCurrentStunDelay currentPlayer /= 0 then w
          else ...

Now let's add a helper that will give us all the locations affected by the stun. We want everything in a 5x5 grid around our player, but we also want bounds checking. Luckily, we can do all this with a neat list comprehension!

where
    ...
    stunAffectedCells :: [Location]
    stunAffectedCells =
      let (cx, cy) = playerLocation currentPlayer
      in  [(x,y) | x <- [(cx-2)..(cx+2)], y <- [(cy-2)..(cy+2)], 
            x >= 0 && x <= 24, y >= 0 && y <= 24]

Now we'll make a wrapper around our enemy mutation to determine which enemies get stunned:

where
    ...
    stunEnemyIfClose :: Enemy -> Enemy
    stunEnemyIfClose e = if enemyLocation e `elem` stunAffectedCells
      then stunEnemy e
      else e

Now we can incorporate all our functions into a final update!

inputHandler :: Event -> World -> World
inputHandler event w
  ...
  | otherwise = case event of
      … -- (movement keys)
      (EventKey (SpecialKey KeySpace) Down _ _) ->
        if playerCurrentStunDelay currentPlayer /= 0 
          then w
          else w
            { worldPlayer = activatePlayerStun currentPlayer
            , worldEnemies = stunEnemyIfClose <$> worldEnemies w
            , stunCells = stunAffectedCells
            }

Other small updates:

  1. When initializing game objects, they should get default values for their "next" timers. For the player, we give 200 (10 seconds). For the enemies, we stun them for 60 ticks (3 seconds) initially.
  2. When updating the world, clear out the "stun cells". Use another mutator function to achieve this:
clearStunCells :: World -> World
clearStunCells w = w { stunCells = []}

Take a look at this commit for a review on this part!

Drawing the Changes

Our game works as expected now! But as our last update, let's make sure we represent these changes on the screen. This will make the game a much better experience. Here are some changes:

  1. Enemies will turn yellow when stunned
  2. Affected squares will flash teal
  3. Our player will have red inner circle when the stun is ready

Each of these is pretty simple! For our enemies, we'll add a little extra logic around what color to use, depending on the stun timer:

enemyPic :: Enemy -> Picture
enemyPic (Enemy loc _ _ currentStun) =
  let enemyColor = if currentStun == 0 then orange else yellow
      ...
  in  Color enemyColor (Polygon [tl, tr, br, bl])

For the player, we'll add some similar logic. The indicator will be a smaller red circle inside of the normal black circle:

stunReadyCircle = if playerCurrentStunDelay (worldPlayer world) == 0
  then Color red (Circle 5)
  else Blank
playerMarker = translate px py (Pictures [stunReadyCircle, Circle 10])

Finally, for the walls, we need to check if a location is among the stunCells. If so, we'll add a teal (cyan) background.

makeWallPictures :: (Location, CellBoundaries) -> [Picture]
makeWallPictures ((x,y), CellBoundaries up right down left) =
  let coords = conversion (x,y)
      tl = cellTopLeft coords
      tr = cellTopRight coords
      bl = cellBottomLeft coords
      br = cellBottomRight coords
      stunBackground = if (x, y) `elem` stunCells world
        then Color cyan (Polygon [tl, tr, br, bl])
        else Blank
  in  [ stunBackground
      … (wall edges)
      ]

And that's all! We can now tell what is happening in our game, so we're done with these features! You can take a look at this commit for all the changes we made to the drawing!

Conclusion

Now our game is a lot more interesting. There's a lot of tuning we can do with various parameters to make our levels more and more competitive. For instance, how many enemies is appropriate per level? What's a good stun delay timer? If we're going to experiment with all these, we'll want to be able to load full game states from the file system. We've got a good start with serializing mazes. But now we want to include information about the player, enemies, and timers.

So next week, we'll go further and serialize our complete game state. We'll also look at how we parameterize the application and fix all the "magic numbers". This will add new options for customization and flexibility. It will also enable us to build a full game that gets harder as it goes on, and allow saving and loading of your progress.

Throughout this article (and series), we've tried to use a clean, precise development process. Read our Haskell Brain series to learn more about this! You can also download our Beginners Checklist if you are less familiar with the language!

Smarter Enemies with BFS!

brain.png

Last week we added enemies to our maze. These little squares will rove around the maze, and if they touch our character, we have to restart the maze. We made it so that these enemies moved around at random. Thus they're not particularly efficient at getting to us.

This week, we're going to make them much more dangerous! They'll use the breadth first search algorithm to find the shortest path towards our player. We'll use three kinds of data structures from the containers package. So if you want to get a little more familiar with that, this article is a great start! Take a look at our Github Repository to see the full code! Look at the part-6 branch for this article!

We'll also make use of the state monad throughout. If you're still a little uncomfortable with monads, make sure to read our series on them! It'll help you with the basics. By the end you'll know about the state monad and how to use it in conjunction with other monads! If you're new to Haskell, you should also take a look at our Beginners Checklist!

BFS Overview

The goal of our breadth first search will be to return the fastest path from one location to another. We'll be writing this function:

getShortestPath :: Maze -> Location -> Location -> [Location]

It will return all the locations on the path from the initial location to the target location. If there's no possible path, we'll return the empty list. In practice, we'll usually only want to take the first element of this list. But there are use cases for having the whole path that we'll explore later. Here's a basic outline of our algorithm:

  1. Keep a queue of locations that we'll visit in the future. At the start, this should contain our starting location.
  2. Dequeue the first location (if the queue is empty, return the empty list). Mark this location as visited. If it is our target location, skip to step 5.
  3. Find all adjacent locations that we haven't visited/enqueued yet. Put them into the search queue. Mark the dequeued location as the "parent" location for each of these new locations.
  4. Continue dequeuing elements and inserting their unvisited neighbors. Stop when we dequeue the target location.
  5. Once we have the target location, use the "parents" map to create the full path from start to finish.

Data Structures Galore

Now let's start getting into the details. As we'll see, there are several different data structures we'll need for this! We'll do some of the same things we did for depth first search (the first time around). We'll make a type to represent our current algorithm state. Then we'll make a recursive, stateful function over that type. In this case, we'll want three items in our search state.

  1. A set of "visited" cells
  2. A queue for cells we are waiting to visit
  3. A mapping of cells to their "parent"

And for all three of these, we'll want different structures. Data.Set will suffice for our visited cells. Then we'll want Data.Map for the parent map. For the search queue though, we'll use something that we haven't used on this blog before: Data.Sequence. This structure allows us to add to the back and remove from the front quickly. Here's our search state type:

data BFSState = BFSState
  { bfsSearchQueue :: Seq.Seq Location
  , bfsVisistedLocations :: Set.Set Location
  , bfsParents :: Map.Map Location Location
  }

Before we get carried away with our search function, let's fill in our wrapper function. This will initialize the state with the starting location. Then it will call evalState to get the result:

getShortestPath :: Maze -> Location -> Location -> [Location]
getShortestPath maze initialLocation targetLocation = evalState
  (bfs maze initialLocation targetLocation)
  (BFSState 
    (Seq.singleton initialLocation) 
    (Set.singleton initialLocation) 
    Map.empty)

bfs :: Maze -> Location -> Location -> State BFSState [Location]
bfs = ...

As with depth first search, we'll start by retrieving the current state. Then we'll ask if the search queue is empty. If it is, this means we've exhausted all possibilities, and should return the empty list. This indicates no path is possible:

bfs :: Maze -> Location -> Location -> State BFSState [Location]
bfs maze initialLocation targetLocation = do
  BFSState searchQueue visitedSet parentsMap <- get
  if Seq.null searchQueue
    then return []
    else do
      ...

Now let's consider the first element in our queue. If it's our target location, we're done. We'll write the exact helper for this part later. But first let's get into the meat of the algorithm:

bfs maze initialLocation targetLocation = do
  BFSState searchQueue visitedSet parentsMap <- get
  if Seq.null searchQueue
    then return []
    else do
      let nextLoc = Seq.index searchQueue 0
      if nextLoc == targetLocation
        then … -- Get results
        else do
          ...

Now our code will actually look imperative, to match the algorithm description above:

  1. Get adjacent cells and filter based on those we haven't visited
  2. Insert the current cell into the visited set
  3. Insert the new cells at the end of the search queue, but drop the current (first) element from the queue as well.
  4. Mark the current cell as the "parent" for each of these new cells. The new cell should be the "key", the current should be the value.

There's a couple tricky folds involved here, but nothing too bad. Here's what it looks like:

bfs :: Maze -> Location -> Location -> State BFSState [Location]
bfs maze initialLocation targetLocation = do
  BFSState searchQueue visitedSet parentsMap <- get
  ...
      if nextLoc == targetLocation
        then ...
        else do
              -- Step 1 (Find next locations)
          let adjacentCells = getAdjacentLocations maze nextLoc
              unvisitedNextCells = filter 
                (\loc -> not (Set.member loc visitedSet)) 
                adjacentCells

              -- Step 2 (Mark as visited)
              newVisitedSet = Set.insert nextLoc visitedSet

              -- Step 3 (Enqueue new elements)
              newSearchQueue = foldr
                (flip (Seq.|>))
                -- (Notice we remove the first element!)
                (Seq.drop 1 searchQueue)
                unvisitedNextCells

              -- Step 4
              newParentsMap = foldr
                (\loc -> Map.insert loc nextLoc)
                parentsMap
                unvisitedNextCells

Then once we're done, we'll insert these new elements into our search state. Then we'll make a recursive call to bfs to continue the process!

bfs :: Maze -> Location -> Location -> State BFSState [Location]
bfs maze initialLocation targetLocation = do
  BFSState searchQueue visitedSet parentsMap <- get
  ...
      if nextLoc == targetLocation
        then ...
        else do
              -- Step 1
          let adjacentCells = getAdjacentLocations maze nextLoc
              unvisitedNextCells = filter 
                (\loc -> not (Set.member loc visitedSet)) 
                adjacentCells
              -- Step 2
              newVisitedSet = Set.insert nextLoc visitedSet
              -- Step 3
              newSearchQueue = foldr
                (flip (Seq.|>))
                -- (Notice we remove the first element!)
                (Seq.drop 1 searchQueue)
                unvisitedNextCells
              -- Step 4
              newParentsMap = foldr
                (\loc -> Map.insert loc nextLoc)
                parentsMap
                unvisitedNextCells

          -- Replace the state and make recursive call!
          put (BFSState newSearchQueue newVisitedSet newParentsMap)
          bfs maze initialLocation targetLocation

For the last part of this, we need to consider what happens when we hit our target. In this case, we'll "unwind" the path using the parents map. We'll start with the target location in our path list. Then we'll look up its parent, and append it to the list. Then we'll look up the parent's parent. And so on. We do this recursion (of course).

bfs :: Maze -> Location -> Location -> State BFSState [Location]
bfs maze initialLocation targetLocation = do
  BFSState searchQueue visitedSet parentsMap <- get
  if Seq.null searchQueue
    then return []
    else do
      let nextLoc = Seq.index searchQueue 0
      if nextLoc == targetLocation
        then return (unwindPath parentsMap [targetLocation])
        ...
  where
    unwindPath parentsMap currentPath =
      case Map.lookup (head currentPath) parentsMap of
        Nothing -> tail currentPath
        Just parent -> unwindPath parentsMap (parent : currentPath)

The only cell we should find without a parent is the initial cell. So when we hit this case, we return the trail of the current path (so removing the current cell from it). And that's all!

Modifying the Game

All we have to do to wrap things up is call this function instead of our random function for the enemy movements. We'll keep things a little fresh by having them make a random move about 20% of the time. (We'll make this a tunable parameter in the future). Here's the bit where we keep some randomness, like what we have now:

updateEnemy :: Maze -> Location -> Enemy -> State StdGen Enemy
updateEnemy maze playerLocation e@(Enemy location) =
  if (null potentialLocs)
    then return e
    else do
      gen <- get
      let (randomMoveRoll, gen') = randomR (1 :: Int, 5) gen
      let (newLocation, newGen) = if randomMoveRoll == 1
            then
              let (randomIndex, newGen) =
                randomR (0, (length potentialLocs) - 1) gen'
              in  (potentialLocs !! randomIndex, newGen)
          ...
  where
    potentialLocs = getAdjacentLocations maze location

And in the rest of the cases, we'll call our getShortestPath function!

updateEnemy :: Maze -> Location -> Enemy -> State StdGen Enemy
updateEnemy maze playerLocation e@(Enemy location) =
  if (null potentialLocs)
    then return e
    else do
      gen <- get
      let (randomMoveRoll, gen') = randomR (1 :: Int, 5) gen
      let (newLocation, newGen) = if randomMoveRoll == 1
            then
              let (randomIndex, newGen) =
                randomR (0, (length potentialLocs) - 1) gen'
              in  (potentialLocs !! randomIndex, newGen)
            else
              let shortestPath =
                getShortestPath maze location playerLocation
              in  (if null shortestPath then location 
                     else head shortestPath, gen')
      put newGen
      return (Enemy newLocation)
    where
      potentialLocs = getAdjacentLocations maze location

And now the enemies will chase us around! They're hard to avoid!

Conclusion

With our enemies now being more intelligent, we'll want to allow our player to fight back against them! Next week, we'll create a mechanism to stun the ghosts to give ourselves a better chance! After, we'll look a some other ways to power up our player!

If you've never programmed in Haskell, hopefully this series is giving you some good ideas of the possibilities! We have a lot of resources for beginners! Check out our Beginners Checklist as well as our Liftoff Series!

Running From Enemies!

ghosts.jpg

We've spent a few weeks now refactoring a few things in our game. We made it more performant and examined some related concepts. This week, we're going to get back to adding new features to the game! We'll add some enemies, represented by little squares, to rove around our maze! If they touch our player, we'll have to re-start the level!

In the next couple weeks, we'll make these enemies smarter by giving them a better search strategy. Then later, we'll give ourselves the ability to fight back against the enemies. So there will be interesting trade-offs in features.

Remember we have a Github Repository for this project! You can find all the code for this part can in the part-5 branch! For some other interesting Haskell project ideas, download our Production Checklist!

Organizing

Let's remind ourselves of our process for adding new features. Remember that at the code level, our game has a few main elements:

  1. The World state type
  2. The update function
  3. The drawing function
  4. The event handler

So to change our game, we should update each of these in turn. Let's start with the changes to our world type. First, it's now possible for us to "lose" the game. So we'll need to expand our GameResult type:

data GameResult = GameInProgress | GameWon | GameLost

Now we need to store the enemies. We'll add more data about our enemies as the game develops. So let's make a formal data type and store a list of them in our World. But for right now, all we need to know about them is their current location:

data Enemy = Enemy
  { enemyLocation :: Location
  }

data World = World
  { …
  , worldEnemies :: [Enemy]
  }

Updating The Game

Now that our game contains information about the enemies, let's determine what they do! Enemies won't respond to any input events from the player. Instead, they'll update at a regular interval via our updateFunc. Our first concern will be the game end condition. If the player's current location is one of the enemies locations, we've "lost".

updateFunc :: Float -> World -> World
updateFunc _ w =
  -- Game Win Condition
  | playerLocation w == endLocation w = w { worldResult = GameWon }
  -- Game Loss Condition
  | playerLocation w `elem` (enemyLocation <$> worldEnemies w) = 
      w { worldResult = GameLost }
  | otherwise = ...

Now we'll need a function that updates the location for an individual enemy. We'll have the enemies move at random. This means we'll need to manipulate the random generator in our world. Let's make this function stateful over the random generator.

updateEnemy :: Maze -> Enemy -> State StdGen Enemy
...

We'll want to examine the enemy's location, and find all the possible locations it can move to. Then we'll select from them at random. This will look a lot like the logic we used when generating our random mazes. It would also be a great spot to use prisms if we were generating them for our types! We might explore this possibility later on in this series.

updateEnemy :: Maze -> Enemy -> State StdGen Enemy
updateEnemy maze e@(Enemy location) = if (null potentialLocs)
  then return e
  else do
    gen <- get
    let (randomIndex, newGen) = randomR
                                  (0, (length potentialLocs) - 1) 
                                  gen
        newLocation = potentialLocs !! randomIndex
    put newGen
    return (Enemy newLocation)
  where
    bounds = maze Array.! location
    maybeUpLoc = case upBoundary bounds of
      (AdjacentCell loc) -> Just loc
      _ -> Nothing
    maybeRightLoc = case rightBoundary bounds of
      (AdjacentCell loc) -> Just loc
      _ -> Nothing
    maybeDownLoc = case downBoundary bounds of
      (AdjacentCell loc) -> Just loc
      _ -> Nothing
    maybeLeftLoc = case leftBoundary bounds of
      (AdjacentCell loc) -> Just loc
      _ -> Nothing
    potentialLocs = catMaybes
      [maybeUpLoc, maybeRightLoc, maybeDownLoc, maybeLeftLoc]

Now that we have this function, we can incorporate it into our main update function. It's a little tricky though. We have to use the sequence function to combine all these stateful actions together. This will also give us our final list of enemies. Then we can insert the new generator and the new enemies into our state!

updateFunc _ w =
  ...
  | otherwise = 
      w { worldRandomGenerator = newGen, worldEnemies = newEnemies} 
  where
    (newEnemies, newGen) = runState
      (sequence (updateEnemy (worldBoundaries w) <$> worldEnemies w))
      (worldRandomGenerator w)

Drawing our Enemies

Now we need to draw our enemies on the board. Most of the information is already there. We have a conversion function to get the drawing coordinates. Then we'll derive the corner points of the square within that cell, and draw an orange square.

drawingFunc =
  …
  | otherwise = Pictures
      [..., Pictures (enemyPic <$> worldEnemies world)]
  where
    ...
    enemyPic :: Enemy -> Picture
    enemyPic (Enemy loc) =
      let (centerX, centerY) = cellCenter $ conversion loc
          tl = (centerX - 5, centerY + 5)
          tr = (centerX + 5, centerY + 5)
          br = (centerX + 5, centerY - 5)
          bl = (centerX - 5, centerY - 5)
      in  Color orange (Polygon [tl, tr, br, bl])

One extra part of updating the drawing function is that we'll have to draw a "losing" message. This will be a lot like the winning message.

drawingFunc :: (Float, Float) -> Float -> World -> Picture
drawingFunc (xOffset, yOffset) cellSize world
 ...
 | worldResult world == GameLost =
     Translate (-275) 0 $ Scale 0.12 0.25
       (Text "Oh no! You've lost! Press enter to restart this maze!")
...

Odds and Ends

Two little things remain. First, we want a function to randomize the locations of the enemies. We'll use this to decide their positions at the beginning and when we restart. In the future we may add a power-up that allows the player to run this randomizer. As with other random functions, we'll make this function stateful over the StdGen element.

generateRandomLocation :: (Int, Int) -> State StdGen Location
generateRandomLocation (numCols, numRows) = do
  gen <- get
  let (randomCol, gen') = randomR (0, numCols - 1) gen
      (randomRow, gen'') = randomR (0, numRows - 1) gen'
  put gen''
  return (randomCol, randomRow)

As before, we can sequence these stateful actions together. In the case of initializing the board, we'll use replicateM and the number of enemies. Then we can use the locations to make our enemies, and then place the final generator back into our world.

main = do
  gen <- getStdGen
  let (maze, gen') = generateRandomMaze gen (25, 25)
      numEnemies = 4
      (randomLocations, gen'') = runState
        (replicateM numEnemies (generateRandomLocation (25,25)))
        gen'
      enemies = Enemy <$> randomLocations
      initialWorld = World (0, 0) (0,0) (24,24)
                       maze GameInProgress gen'' enemies
  play ...

The second thing we'll want to do is update the event handler so that it restarts the game when we lose. We'll have similar code to when we win. However, we'll stick with the original maze rather than re-randomizing.

inputHandler :: Event -> World -> World
inputHandler event w
  ...
  | worldResult w == GameLost = case event of
      (EventKey (SpecialKey KeyEnter) Down _ _) ->
        let (newLocations, gen') = runState
              (replicateM (length (worldEnemies w)) 
                (generateRandomLocation (25, 25)))
                (worldRandomGenerator w)
        in  World (0,0) (0,0) (24, 24)
             (worldBoundaries w) GameInProgress gen'
             (Enemy <$> newLocations)
      _ -> w
  ...

(Note we also have to update the game winning code!) And now we have enemies roving around our maze. Awesome!

maze_with_ghosts.png

Conclusion

Next week we'll step up the difficulty of our game! We'll make the enemies much smarter so that they'll move towards us! This will give us an opportunity to learn about the breadth first search algorithm. There are a few nuances to writing this in Haskell. So don't miss it! The week after, we'll develop a way to stun the enemies. Remember you can follow this project on our Github! The code for this article is on the part-5 branch.

We've used monads, particularly the State monad, quite a bit in this series. Hopefully you can see now how important they are! But they don't have to be difficult to learn! Check out our series on Functional Structures to learn more! It starts with simpler structures like functors. But it will ultimately teach you all the common monads!

Making Arrays Mutable!

sorting_array.jpg

Last week we walked through the process of refactoring our code to use Data.Array instead of Data.Map. But in the process, we introduced a big inefficiency! When we use the Array.// function to "update" our array, it has to create a completely new copy of the array! For various reasons, Map doesn't have to do this.

So how can we fix this problem? The answer is to use the MArray interface, for mutable arrays. With mutable arrays, we can modify them in-place, without a copy. This results in code that is much more efficient. This week, we'll explore the modifications we can make to our code to allow this. You can see a quick summary of all the changes in this Git Commit.

Refactoring code can seem like an hard process, but it's actually quite easy with Haskell! In this article, we'll use the idea of "Compile Driven Development". With this process, we update our types and then let compiler errors show us all the changes we need. To learn more about this, and other Haskell paradigms, read our Haskell Brain series!

Mutable Arrays

To start with, let's address the seeming contradiction of having mutable data in an immutable language. We'll be working with the IOArray type in this article. An item of type IOArray acts like a pointer, similar to an IORef. And this pointer is, in fact, immutable! We can't make it point to a different spot in memory. But we can change the underlying data at this memory. But to do so, we'll need a monad that allows such side effects.

In our case, with IOArray, we'll use the IO monad. This is also possible with the ST monad. But the specific interface functions we'll use (which are possible with either option) live in the MArray library. There are four in particular we're concerned with:

freeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)

thaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e)

readArray :: (MArray a e m, Ix i) => a i e -> i -> m e

writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()

The first two are conversion functions between normal, immutable arrays and mutable arrays. Freezing turns the array immutable, thawing makes it mutable. The second two are our replacements for Array.! and Array.// when reading and updating the array. There are a lot of typeclass constraints in these. So let's simplify them by substituting in the types we'll use:

freeze
  :: IOArray Location CellBoundaries 
  -> IO (Array Location CellBoundaries)

thaw 
  :: Array Location CellBoundaries 
  -> IO (IOArray Location CellBoundaries)

readArray
  :: IOArray Location CellBoundaries 
  -> Location 
  -> IO CellBoundaries

writeArray
  :: IOArray Location CellBoundaries
  -> Location
  -> CellBoundaries
  -> IO ()

Obviously, we'll need to add the IO monad into our code at some point. Let's see how this works.

Basic Changes

We won't need to change how the main World type uses the array. We'll only be changing how the SearchState stores it. So let's go ahead and change that type:

type MMaze = IA.IOArray Location CellBoundaries

data SearchState = SearchState
  { randomGen :: StdGen
  , locationStack :: [Location]
  , currentBoundaries :: MMaze
  , visitedCells :: Set.Set Location
  }

The first issue is that we should now pass a mutable array to our initial search state. We'll use the same initialBounds item, except we'll thaw it first to get a mutable version. Then we'll construct the state and pass it along to our search function. At the end, we'll freeze the resulting state. All this involves making our generation function live in the IO monad:

-- This did not have IO before!
generateRandomMaze :: StdGen -> (Int, Int) -> IO Maze
generateRandomMaze gen (numRows, numColumns) = do
  initialMutableBounds <- IA.thaw initialBounds
  let initialState = SearchState 
                       g2
                       [(startX, startY)]
                       initialMutableBounds
                       Set.empty
  let finalBounds = currentBoundaries
                      (execState dfsSearch initialState)
  IA.freeze finalBounds
  where
    (startX, g1) = …
    (startY, g2) = …

    initialBounds :: Maze
    initialBounds = …

This seems to "solve" our issues in this function and push all our errors into dfsSearch. But it should be obvious that we need a fundamental change there. We'll need the IO monad to make array updates. So the type signatures of all our search functions need to change. In particular, we want to combine monads with StateT SearchState IO. Then we'll make any "pure" functions use IO instead.

dfsSearch :: StateT SearchState IO ()

findCandidates :: Location -> Maze -> Set.Set Location
  -> IO [(Location, CellBoundaries, Location, CellBoundaries)]

chooseCandidate
  :: [(Location, CellBoundaries, Location, CellBoundaries)]
  -> StateT SearchState IO ()

This will lead us to update our generation function.

generateRandomMaze :: StdGen -> (Int, Int) -> IO Maze
generateRandomMaze gen (numRows, numColumns) = do
  initialMutableBounds <- IA.thaw initialBounds
  let initialState = SearchState
                       g2
                       [(startX, startY)]
                       initialMutableBounds
                       Set.empty
  finalBounds <- currentBoundaries <$>
                  (execStateT dfsSearch initialState)
  IA.freeze finalBounds
  where
  …

The original dfsSearch definition is almost fine. But findCandidates is now a monadic function. So we'll have to extract its result instead of using let:

-- Previously
let candidateLocs = findCandidates currentLoc bounds visited

-- Now
candidateLocs <- lift $ findCandidates currentLoc bounds visited

The findCandidates function though will need a bit more re-tooling. The main this is that we need readArray instead of Array.!. The first swap is easy:

findCandidates currentLocation@(x, y) bounds visited = do
  currentLocBounds <- IA.readArray bounds currentLocation
  ...

It's tempting to go ahead and read all the other values for upLoc, rightLoc, etc. right now:

findCandidates currentLocation@(x, y) bounds visited = do
  currentLocBounds <- IA.readArray bounds currentLocation
  let upLoc = (x, y + 1)
  upBounds <- IA.readArray bounds upLoc
  ...

We can't do that though, because this will access them in a strict way. We don't want to access upLoc until we know the location is valid. So we need to do this within the case statement:

findCandidates currentLocation@(x, y) bounds visited = do
  currentLocBounds <- IA.readArray bounds currentLocation
  let upLoc = (x, y + 1)
  maybeUpCell <- case (upBoundary currentLocBounds,
                       Set.member upLoc visited) of
    (Wall, False) -> do
      upBounds <- IA.readArray bounds upLoc
      return $ Just
        ( upLoc
        , upBounds {downBoundary = AdjacentCell currentLocation}
        , currentLocation
        , currentLocBounds {upBoundary = AdjacentCell upLoc}
        )
    _ -> return Nothing

And then we'll do the same for the other directions and that's all for this function!

Choosing Candidates

We don't have to change too much about our chooseCandidates function! The primary change is to eliminate the line where we use Array.// to update the array. We'll replace this with two monadic lines using writeArray instead. Here's all that happens!

chooseCandidate candidates = do
  (SearchState gen currentLocs boundsMap visited) <- get
  ...
  lift $ IA.writeArray boundsMap chosenLocation newChosenBounds
  lift $ IA.writeArray boundsMap prevLocation newPrevBounds
  put (SearchState newGen (chosenLocation : currentLocs) boundsMap newVisited)

Aside from that, there's one small change in our runner to use the IO monad for generateRandomMaze. But after that, we're done!

Conclusion

As mentioned above, you can see all these changes in this commit on our github repository. The last two articles have illustrated how it's not hard to refactor our Haskell code much of the time. As long as we are methodical, we can pick the one thing that needs to change. Then we let the compiler errors direct us to everything we need to update as a result. I find refactoring other languages (particularly Python/Javascript) to be much more stressful. I'm often left wondering...have I actually covered everything? But in Haskell, there's a much better chance of getting everything right the first time!

To learn more about Compile Driven Development, read our Haskell Brain Series. If you're new to Haskell you can also read our Liftoff Series and download our Beginners Checklist!

Compile Driven Development In Action: Refactoring to Arrays!

big_matrix.jpg

In the last couple weeks, we've been slowly building up our maze game. For instance, last week, we added the ability to serialize our mazes. But software development is never a perfect process! So it's not uncommon to revisit some past decisions and come up with better approaches. This week we're going to address a particular code wart in the random maze generation code.

Right now, we store our Maze as a mapping from Locations to CellBoundaries items. We do this using Data.Map. The Map.lookup function returns a Maybe result, since it might not exist. But most of the time we accessed a location, we had good reason to believe that it would exist in the map. This led to several instances of the following idiom:

fromJust $ Map.lookup location boundsMap

Using a function like fromJust is a code smell, a sign that we could be doing something better. This week, we're going to change this structure so that it uses the Array type instead from Data.Array. It captures our idiomatic definitions better. We'll use "Compile Driven Development" to make this change. We won't need to hunt around our code to figure out what's wrong. We'll just make type changes and follow the compiler errors!

To learn more about compile driven development and the mental part of Haskell, read our Haskell Brain series. It will help you think about the language in a different way. So it's a great tool for beginners!

Another good resource for this article is to look at the Github repository for this project. The complete code for this part is on the part-3 branch. You can consult this commit to see all the changes we make in migrating to arrays.

Initial Changes

To start with, we should make sure our code uses the following type synonym for our maze type:

type Maze = Map.Map Location CellBoundaries

Now we can observe the power of type synonyms! We'll make a change in this one type, and that'll update all the instances in our code!

import qualified Data.Array as Array

type Maze = Array.Array Location CellBoundaries

Of course, this will cause a host of compiler issues! But most of these will be pretty simple to fix. But we should be methodical and start at the top. The errors begin in our parsing code. In our mazeParser, we use Map.fromList to construct the final map. This requires the pairs of Location and CellBoundaries.

mazeParser :: (Int, Int) -> Parsec Void Text Maze
mazeParser (numRows, numColumns) = do
  …
  return $ Map.fromList (cellSpecToBounds <$> (concat rows))

The Array library has a similar function, Array.array. However, it also requires us to provides the bounds for the Array. That is, we need the "min" and "max" locations in a tuple. But these are easy, since we have the dimensions as an input!

mazeParser :: (Int, Int) -> Parsec Void Text Maze
mazeParser (numRows, numColumns) = do
  …
  return $ Array.array 
    ((0,0), (numColumns - 1, numRows - 1))
    (cellSpecToBounds <$> (concat rows))

Our next issue comes up in the dumpMaze function. We use Map.mapKeys to transpose the keys of our map. Then we use Map.toList to get the association list back out. Again, all we need to do is find the comparable functions for arrays to update these.

To change the keys, we want the ixmap function. It does the same thing as mapKeys. As with Array.array, we need to provide an extra argument for the min and max bounds. We'll provide the bounds of our original maze.

transposedMap = Array.ixmap (Array.bounds maze) (\(x, y) -> (y, x)) maze

A few lines below, we can see the usage of Map.toList when grouping our pairs. All we need instead is Array.assocs

cellsByRow :: [[(Location, CellBoundaries)]]
cellsByRow = groupBy
  (\((r1, _), _) ((r2, _), _) -> r1 == r2)
  (Array.assocs transposedMap)

Updating Map Generation

That's all the changes for the basic parsing code. Now let's move on to the random generation code. This is where we have a lot of those yucky fromJust $ Map.lookup calls. We can now instead use the "bang" operator, Array.! to access those elements!

findCandidates currentLocation@(x, y) bounds visited =
  let currentLocBounds = bounds Array.! currentLocation
  ...

Of course, it's possible for an "index out of bounds" error to occur if we aren't careful! But our code should reflect the fact that we expect all these calls to work. After fixing the initial call, we need to change each directional component. Here's what the first update looks like:

findCandidates currentLocation@(x, y) bounds visited =
      let currentLocBounds = bounds Array.! currentLocation
          upLoc = (x, y + 1)
          maybeUpCell = case (upBoundary currentLocBounds,
                              Set.member upLoc visited) of
                          (Wall, False) -> Just
                            ( upLoc
                            , (bounds Array.! upLoc) {downBoundary = 
                                AdjacentCell currentLocation}
                            , currentLocation
                            , currentLocBounds {upBoundary =
                                AdjacentCell upLoc}
                            )
                          _ -> Nothing

We've replaced Map.lookup with Array.! in the second part of the resulting tuple. The other three directions need the same fix.

Then there's one last change in the random generation section! When we choose a new candidate, we currently need two calls to Map.insert. But arrays let us do this with one function call. The function is Array.//, and it takes a list of association updates. Here's what it looks like:

chooseCandidate candidates = do
      (SearchState gen currentLocs boundsMap visited) <- get
      ...
      -- Previously used Map.insert twice!!!
      let newBounds = boundsMap Array.//
            [(chosenLocation, newChosenBounds),
             (prevLocation, newPrevBounds)]
      let newVisited = Set.insert chosenLocation visited
      put (SearchState
             newGen
             (chosenLocation : currentLocs) 
             newBounds 
             newVisited)

Final Touch Ups

Now our final remaining issues are within the Runner code. But they're all similar fixes to what we saw in the parsing code.

In our sample boundariesMap, we once again replace Map.fromList with Array.array. Again, we add a parameter with the bounds of the array. Then, when drawing the pictures for our cells, we need to use Array.assocs instead of Map.toList.

For the final change, we need to update our input handler so that it accesses the array properly. This is our final instance of fromJust $ Map.lookup! We can replace it like so:

inputHandler :: Event -> World -> World
inputHandler event w = case event of
  ...
  where
    cellBounds = (worldBoundaries w) Array.! (playerLocation w)

And that's it! Now our code will compile and work as it did before!

Conclusion

There's a pretty big inefficiency with our new approach. Whereas Map.insert can give us an updated map in log(n) time, the Array.// function isn't so nice. It has to create a complete copy of the array, and we run that function many times! How can we fix this? Next week, we'll find out! We'll use the Mutable Array interface to make it so that we can update our array in-place! This is super efficient, but it requires our code to be more monadic!

For some more ideas of cool projects you can do in Haskell, download our Production Checklist! It goes through a whole bunch of libraries on topics from database management to web servers!

Serializing Mazes!

transformation_funnel.jpg

Last week we improved our game so that we could solve additional random mazes after the first. This week, we'll step away from the randomness and look at how we can serialize our mazes. This will allow us to have a consistent and repeatable game. It will also enable us to save the game state later.

We'll be using the Megaparsec library as part of this article. If you aren't familiar with that (or parsing in Haskell more generally), check out our Parsing Series!

A Serialized Representation

The serialized representation of our maze doesn't need to be human readable. We aren't trying to create an ASCII art style representation. That said, it would be nice if it bore some semblance to the actual layout. There are a couple properties we'll aim for.

First, it would be good to have one character represent one cell in our maze. This dramatically simplifies any logic we'll use for serializing back and forth. Second, we should layout the cell characters in a way that matches the maze's appearance. So for instance, the top left cell should be the first character in the first row of our string. Then, each row should appear on a separate line. This will make it easier to avoid silly errors when coming up with test cases.

So how can we serialize a single cell? We could observe that for each cell, we have sixteen possible states. There are 4 sides, and each side is either a wall or it is open. This suggests a hexadecimal representation.

Let's think of the four directions as being 4 bits, where if there is a wall, the bit is set to 1, and if it is open, the bit is set to 0. We'll order the bits as up-right-down-left, as we have in a couple other areas of our code. So we have the following example configurations:

  1. An open cell with no walls around it is 0.
  2. A totally surrounded cell is 1111 = F.
  3. A cell with walls on its top and bottom would be 1010 = A.
  4. A cell with walls on its left and right would be 0101 = 5.

With that in mind, we can create a small 5x5 test maze with the following representation:

98CDF
1041C
34775
90AA4
32EB6

And this ought to look like so:

small_maze.png

This serialization pattern lends itself to a couple helper functions we'll use later. The first, charToBoundsSet, will take a character and give us four booleans. These represent the presence of a wall in each direction. First, we convert the character to the hex integer. Then we use patterns about hex numbers and where the bits lie. For instance, the first bit is only set if the number is at least 8. The last bit is only set for odd numbers. This gives us the following:

charToBoundsSet :: Char -> (Bool, Bool, Bool, Bool)
charToBoundsSet c =
  ( num > 7,
  , num `mod` 8 > 3
  , num `mod` 4 > 1
  , num `mod` 2 > 0
  )

Then, we also want to go backwards. We want to take a CellBoundaries item and convert it to the proper character. We'll look at each direction. If it's an AdjacentCell, it contributes nothing to the final Int value. But otherwise, it contributes the hex digit value for its place. We add these up and convert to a char with intToDigit:

cellToChar :: CellBoundaries -> Char
cellToChar bounds =
  let top = case upBoundary bounds of
        (AdjacentCell _) -> 0
        _ -> 8
  let right = case rightBoundary bounds of
        (AdjacentCell _) -> 0
        _ -> 4
  let down = case downBoundary bounds of
        (AdjacentCell _) -> 0
        _ -> 2
  let left = case leftBoundary bounds of
        (AdjacentCell _) -> 0
        _ -> 1
  in toUpper $ intToDigit (top + right + down + bottom)

We'll use both of these functions in the next couple parts.

Serializing a Maze

Let's move on now to determining how we can take a maze and represent it as Text. For this part, let's first apply a type synonym on our maze type:

type Maze = Map.Map Location CellBoundaries

dumpMaze :: Maze -> Text
dumpMaze = ...

First, let's imagine we have a single row worth of locations. We can convert that row to a string easily using our helper function from above:

dumpMaze = …
  where
    rowToString :: [(Location, CellBoundaries)] -> String
    rowToString = map (cellToChar . snd)

Now we'd like to take our maze map and group it into the different rows. The groupBy function seems appropriate. It groups elements of a list based on some predicate. We'd like to take a predicate that checks if the rows of two elements match. Then we'll apply that against the toList representation of our map:

rowsMatch :: (Location, CellBoundaries) -> (Location, CellBoundaries) -> Bool
rowsMatch ((_, y1), _) ((_, y2), _) = y1 == y2

We have a problem though because groupBy only works when the elements are next to each other in the list. The Map.toList function will give us a column-major ordering. We can fix this by first creating a transposed version of our map:

dumpMaze maze = …
  where
    transposedMap :: Maze
    transposedMap = Map.mapKeys (\(x, y) -> (y, x)) maze

Now we can go ahead and group our cells by row:

dumpMaze maze = …
  where
    transposedMap = …

    cellsByRow :: [[(Location, CellBoundaries)]]
    cellsByRow = groupBy (\((r1, _), _) ((r2, _), _) -> r1 == r2) 
                   (Map.toList transposedMap)

And now we can complete our serialization function! We get the string for each row, and combine them with unlines and then pack into a Text.

dumpMaze maze = pack $ (unlines . reverse) (rowToString <$> cellsByRow)
  where
    transposedMap = …

    cellsByRow = …

    rowToString = ...

As a last trick, note we reverse the order of the rows. This way, we get that the top row appears first, rather than the row corresponding to y = 0.

Parsing a Maze

Now that we can dump our maze into a string, we also want to be able to go backwards. We should be able to take a properly formatted string and turn it into our Maze type. We'll do this using the Megaparsec library, as we discussed in part 4 of our series on parsing in Haskell. So we'll create a function in the Parsec monad that will take the dimensions of the maze as an input:

import qualified Text.Megaparsec as M

mazeParser :: (Int, Int) -> M.Parsec Void Text Maze
mazeParser (numRows, numColumns) = ...

We want to parse the input into a format that will match each character up with its location in the (x,y) coordinate space of the grid. This means parsing one row at a time, and passing in a counter argument. To make the counter match with the desired row, we'll use a descending list comprehension like so:

mazeParser (numRows, numColumns = do
  rows <- forM [(numRows - 1), (numRows - 2)..0] $ \i -> do
  ...

For each row, we'll parse the individual characters using M.hexDigit and match them up with a column index:

mazeParser (numRows, numColumns = do
  rows <- forM [0..(numRows - 1)] $ \i -> do
    (columns :: [(Int, Char)]) <-
      forM [0..(numColumns - 1)] $ \j -> do
        c <- M.hexDigitChar
        return (j, c)
    ...

We conclude the parsing of a row by reading the newline character. Then we make the indices match the coordinates in discrete (x,y) space. Remember, the "column" should be the first item in our location.

mazeParser (numRows, numColumns = do
  (rows :: [[(Location, Char)]]) <-
    forM [0..(numRows - 1)] $ \i -> do
      columns <- forM [0..(numColumns - 1)] $ \j -> do
        c <- M.hexDigitChar
        return (j, c)
      M.newline
      return $ map (\(col, char) -> ((col, i), char)) columns
  ...

Now we'll need a function to convert one of these Location, Char pairs into CellBoundaries. For the most part, we just want to apply our charToBoundsSet function and get the boolean values. Remember these tell us if walls are present or not:

mazeParser (numRows, numColumns = do
  rows <- …
  where
    cellSpecToBounds :: (Location, Char) -> (Location, CellBoundaries)
    cellSpecToBounds (loc@(x, y), c) =
      let (topIsWall, rightIsWall, bottomIsWall, leftIsWall) = 
            charToBoundsSet c
      ...

Now it's a matter of applying a case by case basis in each direction. We just need a little logic to determine, in the True case, if it should be a Wall or a WorldBoundary. Here's the implementation:

cellSpecToBounds :: (Location, Char) -> (Location, CellBoundaries)
cellSpecToBounds (loc@(x, y), c) =
  let (topIsWall, rightIsWall, bottomIsWall, leftIsWall) = 
         charToBoundsSet c
      topCell = if topIsWall
        then if y + 1 == numRows
          then WorldBoundary
          else Wall
        else (AdjacentCell (x, y + 1))
      rightCell = if rightIsWall
        then if x + 1 == numColumns
          then WorldBoundary
          else Wall
        else (AdjacentCell (x + 1, y))
      bottomCell = if bottomIsWall
        then if y == 0
          then WorldBoundary
          else Wall
        else (AdjacentCell (x, y - 1))
      leftCell = if leftIsWall
        then if x == 0
          then WorldBoundary
          else Wall
        else (AdjacentCell (x - 1, y))
  in  (loc, CellBoundaries topCell rightCell bottomCell leftCell)

And now we can complete our parsing function by applying this helper over all our rows!

mazeParser (numRows, numColumns = do
  (rows :: [[(Location, Char)]]) <-
    forM [0..(numRows - 1)] $ \i -> do
      columns <- forM [0..(numColumns - 1)] $ \j -> do
        c <- M.hexDigitChar
        return (j, c)
      M.newline
      return $ map (\(col, char) -> ((col, i), char)) columns
  return $ Map.fromList (cellSpecToBounds <$> (concat rows))
  where
    cellSpecToBounds = ...

Conclusion

This wraps up our latest part on serializing maze definitions. The next couple parts will still be more code-focused. We'll look at ways to improve our data structures and an alternate way of generating random mazes. But after those, we'll get back to adding some new game features, such as wandering enemies and combat!

To learn more about serialization, you should read our series on parsing. You can also download our Production Checklist for more ideas!

Declaring Victory! (And Starting Again!)

victory.jpg

In last week's article, we used a neat little algorithm to generate random mazes for our game. This was cool, but nothing happens yet when we "finish" the maze! We'll change that this week. We'll allow the game to continue re-generating new mazes when we're finished! You can find all the code for this part on the part-2 branch on the Github repository for this project!

If you're a beginner to Haskell, hopefully this series is helping you learn simple ways to do cool things! If you're a little overwhelmed, try reading our Liftoff Series first!

Goals

Our objectives for this part are pretty simple. We want to make it so that when we reach the "end" location, we get a "victory" message and can restart the game by pressing a key. We'll get a new maze when we do this. There are a few components to this:

  1. Reaching the end should change a component of our World.
  2. When that component changes, we should display a message instead of the maze.
  3. Pressing "Enter" with the game in this state should start the game again with a new maze.

Sounds pretty simple! Let's get going!

Game Result

We'll start by adding a new type to represent the current "result" of our game. We'll add this piece of state to our World. As an extra little piece, we'll add a random generator to our state. We'll need this when we re-make the maze:

data GameResult = GameInProgress | GameWon
  deriving (Show, Eq)

data World = World
  { playerLocation :: Location
  , startLocation :: Location
  , endLocation :: Location
  , worldBoundaries :: Maze
  , worldResult :: GameResult
  , worldRandomGenerator :: StdGen
  }

Our generation step needs a couple small tweaks. The function itself should now return its final generator as an extra result:

generateRandomMaze :: StdGen -> (Int, Int) -> (Maze, StdGen)
generateRandomMaze gen (numRows, numColumns) =
  (currentBoundaries finalState, randomGen finalState)
  where
    ...
    finalState = execState dfsSearch initialState

Then in our main function, we incorporate the new generator and game result into our World:

main = do
  gen <- getStdGen
  let (maze, gen') = generateRandomMaze gen (25, 25)
  play
    windowDisplay
    white
    20
    (World (0, 0) (0, 0) (24, 24) maze GameInProgress gen')
    ...

Now let's fix our updating function so that it changes the game result if we hit the final location! We'll add a guard here to check for this condition and update accordingly:

updateFunc :: Float -> World -> World
updateFunc _ w
  | playerLocation w == endLocation w = w { worldResult = GameWon }
  | otherwise = w

We could do this in the eventHandler but it seems more idiomatic to let the update function handle it. If we use the event handler, we'll never see our token enter the final square. The game will jump straight to the victory screen. That would be a little odd. Here there's at least a tiny gap.

Displaying Victory!

Now our game will update properly. But we have to respond to this change by changing what the display looks like! This is a quick fix. We'll add a similar guard to our drawingFunc:

drawingFunc :: (Float, Float) -> Float -> World -> Picture
drawingFunc (xOffset, yOffset) cellSize world
  | worldResult world == GameWon =
      Translate (-275) 0 $ Scale 0.12 0.25
        (Text "Congratulations! You've won!\
              \Press enter to restart with a new maze!")
  | otherwise = ...

Note that Text here is the Gloss Picture constructor, not Data.Text. We also scale and translate it a bit to make the text appear on the screen. This is all we need to get the victory screen to appear on completion!

completed_maze.jpg

Restarting the Game

The last step is that we have to follow through on our process to restart the game if they hit enter! This involves changing our inputHandler to give us a brand new World. As with our other functions, we'll add a guard to handle the GameWon case:

inputHandler :: Event -> World -> World
inputHandler event w
  | worldResult w == GameWon = …
  | otherwise = case event of
    ...

We'll want to make a new case section that accounts for the user pressing the "Enter" key. All this section needs to do is call generateRandomMaze and re-initialize the world!

inputHandler event w
  | worldResult w == GameWon = case event of
      (EventKey (SpecialKey KeyEnter) Down _ _) ->
        let (newMaze, gen') = generateRandomMaze 
              (worldRandomGenerator w) (25, 25)
        in  World (0, 0) (0, 0) (24, 24) newMaze GameInProgress gen'
      _ -> w

And with that, we're done! We can restart the game and navigate random mazes to our heart's content!

Conclusion

The ability to restart the game is great! But if we want to make our game re-playable instead of random, we'll need some way of storing mazes. In the next part, we'll look at some code for dumping a maze to an output format. We'll also need a way to re-load from this stored representation. This will ultimately allow us to make a true game with saving and loading state.

In preparation for that, you can read our series on Parsing. You'll especially want to acquaint yourself with the Megaparsec library. We go over this in Part 4 of the series!