See and Believe: Visualizing with Gloss

Last week I discussed AI for the first time in a while. We learned about the Breadth-First-Search algorithm (BFS) which is so useful in a lot of simple AI applications. But of course writing abstract algorithms isn't as interesting as seeing them in action. So this week I'll re-introduce Gloss, a really neat framework I've used to make some simple games in Haskell.

This framework simplifies a lot of the graphical work one needs to do to make stuff show up on screen and it allows us to provide Haskell code to back it up and make all the logic interesting. I think Gloss also gives a nice demonstration of how we really want to structure a game and, in some sense, any kind of interactive program. We'll break down how this structure works as we make a simple display showing the BFS algorithm in practice. We'll actually have a "player" piece navigating a simple maze by itself.

To see the complete code, take a look at this GitHub repository! The Gloss code is all in the Game module.

Describing the World

In Haskell, the first order of business is usually to define our most meaningful types. Last week we did that by specifying a few simple aliases and types to use for our search function:

type Location = (Int, Int)
data Cell = Empty | Wall
  deriving (Eq)
type Grid = A.Array Location Cell

When we're making a game though, there's one type that is way more important than the rest, and this is our "World". The World describes the full state of the game at any point, including both mutable and immutable information.

In describing our simple game world, we might view three immutable elements, the fundamental constraints of the game. These are the "start" position, the "end" position, and the grid itself. However, we'll also want to describe the "current" position of our player, which can change each time it moves. This gives us a fourth field.

data World = World
  { playerLocation :: Location
  , startLocation :: Location
  , endLocation :: Location
  , worldGrid :: Grid
  }

We can then supplement this by making our "initial" elements. We'll have a base grid that just puts up a simple wall around our destination, and then make our starting World.

-- looks like:
-- S o o o
-- o x x o
-- o x F o
-- o o o o
baseGrid :: Grid
baseGrid =
  (A.listArray ((0, 0), (3, 3)) (replicate 16 Empty))
  A.//
  [((1, 1), Wall), ((1, 2), Wall), ((2, 1), Wall)]

initialWorld :: World
initialWorld = World (0, 0) (0, 0) (2, 2) baseGrid

Playing the Game

We've got our main type in place, but we still need to pull it together in a few different ways. The primary driver function of the Gloss library is play. We can see its signature here.

play :: Display -> Color -> Int
  -> world
  -> (world -> Picture)
  -> (Event -> world -> world)
  -> (Float -> world -> world)
  -> IO ()

The main pieces of this are driven by our World type. But it's worth briefly addressing the first three. The Display describes the viewport that will show up on our screen. We can give it particular dimensions and offset:

windowDisplay :: Display
windowDisplay = InWindow "Window" (200, 200) (10, 10)

The next two values just indicate the background color of the screen, and the tick rate (how many game ticks occur per second). And after those, we just have our initial world value as we made above.

main :: IO ()
main = play
  windowDisplay white 1 initialWorld
  ...

But now we have three more functions that are clearly driven by our World type. The first is a drawing function. It takes the current state of the world and create a Picture to show on screen.

The second function is an input handler, which takes a user input event as well as the current world state, and returns an updated world state, based on the event. We won't address this in this article.

The third function is an update function. This describes how the world naturally evolves without any input from tick to tick.

For now, we'll make type signatures as we prepare to implement these functions for ourselves. This allows us to complete our main function:

main :: IO ()
main = play
  windowDisplay white 20 initialWorld
  drawingFunc
  inputHandler
  updateFunc

drawingFunc :: World -> Picture

inputHandler :: Event -> World -> World

updateFunc :: Float -> World -> World

Let's move on to these different world-related functions.

Updating the World

Now let's handle updates to the world. To start, we'll make a stubbed out input-handler. This will just return the input world each tick.

inputHandler :: Event -> World -> World
inputHandler _ w = w

Now let's describe how the world will naturally evolve/update with each game tick. For this step, we'll apply our BFS algorithm. So all we really need to do is retrieve the locations and grid out of the world and run the function. If it gives us a non-empty list, we'll substitute the first square in that path for our new location. Otherwise, nothing happens!

updateFunc :: Float -> World -> World
updateFunc _ w@(World playerLoc _ endLoc grid time) =
  case path of
    (first : rest) -> w {playerLocation = first}
    _ -> w
  where
    path = bfsSearch grid playerLoc endLoc

Note that this function receives an extra "float" argument. We don't need to use this.

Drawing

Finally, we need to draw our world so we can see what is going on! To start, we need to remember the difference between the "pixel" positions on the screen, and the discrete positions in our maze. The former are floating point values up to (200.0, 200.0), while the latter are integer numbers up to (3, 3). We'll make a type to store the center and corner points of a given cell, as well as a function to generate this from a Location.

A lot of this is basic arithmetic, but it's easy to go wrong with sign errors and off-by-one errors!

data CellCoordinates = CellCoordinates
  { cellCenter :: Point
  , cellTopLeft :: Point
  , cellTopRight :: Point
  , cellBottomRight :: Point
  , cellBottomLeft :: Point
  }

-- First param: (X, Y) offset from the center of the display to center of (0, 0) cell
-- Second param: Full width of a cell
locationToCoords :: (Float, Float) -> Float -> Location -> CellCoordinates
locationToCoords (xOffset, yOffset) cellSize (x, y) = CellCoordinates
  (centerX, centerY)
  (centerX - halfCell, centerY + halfCell) -- Top Left
  (centerX + halfCell, centerY + halfCell) -- Top Right
  (centerX + halfCell, centerY - halfCell) -- Bottom Right
  (centerX - halfCell, centerY - halfCell) -- Bottom Left
  where
    (centerX, centerY) = (xOffset + (fromIntegral x) * cellSize, yOffset - (fromIntegral y) * cellSize)
    halfCell = cellSize / 2.0

Now we need to use these calculations to draw pictures based on the state of our world. First, let's write a conversion that factors in the specifics of the display, which allows us to pinpoint the center of the player marker.

drawingFunc :: World -> Picture
drawingFunc world =
  ...
  where
    conversion = locationToCoords (-75, 75) 50
    (px, py) = cellCenter (conversion (playerLocation world))

Now we can draw a circle to represent that! We start by making a Circle that is 10 pixels in diameter. Then we translate it by the coordinates. Finally, we'll color it red. We can add this to a list of Pictures we'll return.

drawingFunc :: World -> Picture
drawingFunc world = Pictures
  [ playerMarker ]
  where
    -- Player Marker
    conversion = locationToCoords (-75, 75) 50
    (px, py) = cellCenter (conversion (playerLocation world))
    playerMarker = Color red (translate px py (Circle 10))

Now we'll make Polygon elements to represent special positions on the board. Using the corner elements from CellCoordinates, we can draw a blue square for the start position and a green square for the final position.

drawingFunc :: World -> Picture
drawingFunc world = Pictures
  [startPic, endPic, playerMarker ]
  where
    -- Player Marker
    conversion = locationToCoords (-75, 75) 50
    (px, py) = cellCenter (conversion (playerLocation world))
    playerMarker = Color red (translate px py (Circle 10))

    # Start and End Pictures
    (CellCoordinates _ stl str sbr sbl) = conversion (startLocation world)
    startPic = Color blue (Polygon [stl, str, sbr, sbl])
    (CellCoordinates _ etl etr ebr ebl) = conversion (endLocation world)
    endPic = Color green (Polygon [etl, etr, ebr, ebl])

Finally, we do the same thing with our walls. First we have to filter all the elements in the grid to get the walls. Then we must make a function that will take the location and make the Polygon picture. Finally, we combine all of these into one picture by using a Pictures list, mapped over these walls. Here's the final look of our function:

drawingFunc :: World -> Picture
drawingFunc world = Pictures
  [gridPic, startPic, endPic, playerMarker ]
  where
    -- Player Marker
    conversion = locationToCoords (-75, 75) 50
    (px, py) = cellCenter (conversion (playerLocation world))
    playerMarker = Color red (translate px py (Circle 10))

    # Start and End Pictures
    (CellCoordinates _ stl str sbr sbl) = conversion (startLocation world)
    startPic = Color blue (Polygon [stl, str, sbr, sbl])
    (CellCoordinates _ etl etr ebr ebl) = conversion (endLocation world)
    endPic = Color green (Polygon [etl, etr, ebr, ebl])

    # Drawing the Pictures for the Walls
    walls = filter (\(_, w) -> w == Wall) (A.assocs $ worldGrid world)
    mapPic (loc, _) = let (CellCoordinates _ tl tr br bl) = conversion loc 
                          in Color black (Polygon [tl, tr, br, bl])
    gridPic = Pictures (map mapPic walls)

And now when we play the game, we'll see our circle navigate to the goal square!

Next time, we'll look at a more complicated version of this kind of game world!