board games , functional programming , games , gtk , gtk2hs , haskell

Creating board games in Haskell in 100 lines of code

While code written in Haskell is very declarative and mathematical, as soon as we try to create a user interface, we’ll be slapped on the cheek by a wave of IO that will turn our code procedural in no time. One of the main ideas behind this gaming (ad)venture called Keera Studios is to write more mathematical, robust games. We want these games to be easy to understand and expand, and we want them to look good too.

The current trend in this respect is based mostly on FRP. However, FRP is still on its way, and no Haskell implementation (AFAWK) performs really well. (We recently tried all of them, and found that there’s still a lot to be done to be able to fully rely on FRP for interactive applications).

In this post we’ll see that, through an ad-hoc layer that will hide most of the controller and separate the UI from the mathematical model, we can implement nice-looking games in Haskell that have declarative, pure definitions and use graphics efficiently for the implementation.

The post will go as follows: First, how to get ready: install the deps, hug your teddy bear, pack your lunch, kiss your mama… Second: the implementation, which includes 2.1) An overview of the elements that define a game, 2.2) A definition of our sample game following that interface, 2.3) A 10-line mapping from mathematics to pictures (so that we can see something on the screen), and 2.4) A main program in Gtk2hs that embeds all our hard, hard work. In the third section, you’ll see how to compile it and how awesome it looks (ok maybe not so awesome but better than a matrix of Gtk buttons anyway).

Note: there are a couple of functions whose name will be changed in the future, but the library is tiny so adapting your game will be a matter of minutes.

Getting ready

Our code will be based on gtk-helpers, a library available at http://github.com/keera-studios/gtk-helpers. The following instructions install a copy in a local cabal-dev build:

$ mkdir game-sample
$ cd game-sample
$ cabal sandbox init
$ cabal update
$ cabal install gtk-helpers

Creating a board game

In this example we are going to create a very simple game. It’s called Peg Solitaire and, odds are, you’ve seen it before (http://en.wikipedia.org/wiki/Peg_solitaire). We’ll need several things for our game, namely a background, pictures for the pegs and the holes (empty position, or tile), and pictures for positions that cannot be occupied. We’ll divide our game in three parts: a mathematical model with a definition of the game’s rules, a function that will assign graphics to different game elements, and a main gtk program that will put everything together. Our main work will go into the mathematical definition, and the other two modules will be just adaptations to make this run on Gtk in an efficient way.

A Board Game definition

These kind of board games are all very similar, and we can create a parametric defition that can be used for many different kinds of games. Initially, we have to consider how many players there are, the pieces that they have, the size and shape of the board and the initial placement of the pieces. We also need to consider how players move (by dragging elements on the board, or by adding/removing elements to it), and which moves are allowed and when.

In Game.Board.BasicTurnGame you’ll see a class that defines some of the functions we’ll need. The class assumes that your definition may be parametrisable, and that the Index type, the Player, the Piece and the Tile are not necessarily fixed.

class PlayableGame a index tile player piece | a -> index, a -> tile, a -> player, a -> piece where
  curPlayer :: a -> player
  allPieces :: a -> [(index, index, player, piece)]
  allPos :: a -> [(index, index, tile)]

  moveEnabled :: a -> Bool
  moveEnabled _ = False

  canMove :: a -> player -> (index, index) -> Bool
  canMove _ _ _ = False

  canMoveTo :: a -> player -> (index, index) -> (index, index) -> Bool
  canMoveTo _ _ _ _ = False

  move :: a -> player -> (index, index) -> (index, index) -> [GameChange index player piece]
  move _ _ _ _ = []

  activateEnabled :: a -> Bool
  activateEnabled _ = False

  canActivate :: a -> player -> (index, index) -> Bool
  canActivate _ _ _ = False

  activate :: a -> player -> (index, index) -> [GameChange index player piece]
  activate _ _ _ = []

  applyChange :: a -> GameChange index player piece -> a
  applyChange g _ = g

  applyChanges :: a -> [GameChange index player piece] -> a
  applyChanges a ls = foldl applyChange a ls

We’ll break it down in the following blocks:

  • Functions that determine whether and how players can move pieces. Here we have: moveEnabled :: a -> Bool (can players move pieces at all?), canMove :: a -> player -> (index, index) -> Bool (can this player move this piece?), canMoveTo :: a -> player -> (index, index) -> (index, index) -> Bool (can this player move this piece to this location?), move :: a -> player -> (index, index) -> (index, index) -> [GameChange index player piece] (which changes would the board have to undergo if this move took place?).

  • A similar approach takes place for activation (for lack of a better name), or the process of just selecting a position on the board. The functions are activateEnabled :: a -> Bool (can we ‘activate’ board positions at all?), canActivate :: a -> player -> (index, index) -> Bool (can we activate a specific position?), and activate :: a -> player -> (index, index) -> [GameChange index player piece] (which changes would the board have to undergo if the player activates this position?).

  • The remaining functions are curPlayer :: a -> player (who should play now?), allPieces :: a -> [(index, index, player, piece)] (where are the pieces located?) and allPos :: a -> [(index, index, tile)] (which positions have which kinds of tiles?).

  • applyChange will perform the actual change and give us a new game value.

Creating a game just needs us to provide a type that implements those functions: determine how to move, determine how to activate a position, determine the location of the pieces, the size and shape of our board, and who plays next.

Since we will need to store the pieces’ positions on the board, the following type is provided for your convenience:

data GameState index tile player piece = GameState
  { curPlayer' :: player
  , boardPos :: [(index, index, tile)]
  , boardPieces' :: [(index, index, player, piece)]
  }

Peg Solitaire

In this game, the board has a cross-like shape with a hole in the middle, there’s only one player, and the goal is to remove pegs until we have only one left. A sample image (taken from Wikipedia and attributed to user Annielogue, shared with licence CC-SA Unported 3.0):

European solitaire
European solitaire or, as the French call it, “French solitaire, sacrebleu!”

We remove pegs by taking one peg, “jumping” over exactly one other peg (up/down/left/right), landing our peg on an empty position, and removing the peg we jumped over. If you don’t get it, watch the first 10 seconds of this video (https://www.youtube.com/watch?v=-U7c_y5ks30).

There are several variants of the game, we’ll use the European variant (with 4 “extra” holes at angles 45, 135, 215 and 315; the English version is a plain cross.)

The expression that defines our board is:

allTiles = [(x,y) | x > 4 || x < 2) && (y == 0 || y == 6)) || ((y > 4 || y < 2) &amp;&amp; (x == 0 || x == 6))

Which just means: positions go from (0,0) to (6,6), as long as they do not refer to a corner; and a position is in a corner if one coordinate is on the border of the board (0 or 6) and the other is in the 2 positions closest to the corner (less than 2 or greater than 4).

Our initial game definition will then be:

data Peg = Peg -- Only one kind of peg
data Tile = Tile -- Only one kind of tile
data Player = Player -- Only one player
newtype PegSolitaireGame = PegSolitaireGame (GameState Int Tile Player Peg)

-- Basic game definition
defaultPegSolitaireGame :: PegSolitaireGame
defaultPegSolitaireGame = PegSolitaireGame $ GameState
    { curPlayer' = Player
    , boardPos = allTiles
    , boardPieces' = pieces
    }
  where
    allTiles = [(x,y,Tile) | x 4 || x < 2) && (y == 0 || y == 6)) || ((y > 4 || y < 2) && (x == 0 || x == 6))
    pieces   = [(x,y,Player,Peg) | (x,y,_)

Note that, in this definition, allTiles is the same as above but with a third value in the tuple that’s constantly Tile (our game class expects that), and that pieces is just the same list, but with a hole in the middle and player’s pegs instead of empty tiles.

Ok, now how do we define the game rules? The most basic functions are the ones that map to fields in the previous record:

instance PlayableGame PegSolitaireGame Int Tile Player Peg where

  -- "Static" game view
  curPlayer (PegSolitaireGame game) = curPlayer' game
  allPieces (PegSolitaireGame game) = boardPieces' game
  allPos (PegSolitaireGame game) = boardPos game

These are very straightforward and need no explanation at this point.

Movement functions are also very easy. We are going to simplify our life by allowing players to always move, and then applying the changes only if the move is correct:

  -- Kind of moves that are allowed
  moveEnabled _ = True
  canMove _ _ _ = True
  canMoveTo _ _ _ _ = True

  -- Convert a "move" to a sequence of changes
  move (PegSolitaireGame game) _player posO posD
      | hasPiece game posO && hasPiece game posI && not (hasPiece game posD) && correctDiff
      = [ MovePiece posO posD, RemovePiece posI ]
      | otherwise
      = []
    where
      diffX       = abs (fst posO - fst posD)
      diffY       = abs (snd posD - snd posO)
      correctDiff = (diffX == 0 && diffY == 2) || (diffX == 2 && diffY == 0)
      posI        = ((fst posO + fst posD) `div` 2, (snd posO + snd posD) `div` 2)

This will make users be able to drag any piece, but if the move is not correct, the piece will be placed back in the original position. The only function that needs explanation is move, which goes as follows. We can move a piece from posO to posD if: we have a piece on posO, there’s a piece in an intermediate position called posI, there’s no piece in posD, and the distance from posO to posD is “the correct one”. The correct distance is 2 in either the vertical (Y) or the horizontal (X), and posI is the position in the middle between posO and posD (calculated for each coordinate independently).

Finally, we are going to determine how game changes (which are defined in Game.Board.TurnBasedGame) can be applied to our game state. We’ll go through each one independently:

  -- Apply a change to the game
  applyChange psg@(PegSolitaireGame game) (MovePiece posO posD)
    | Just (player, piece) = applyChanges psg [RemovePiece posO, RemovePiece posD, AddPiece posD player piece]
    | otherwise = psg

If we need to move posO to posD, get the piece in posO, remove it, remove the one in posD (if any), and add the piece we got to posD. If there’s no piece in posO, nothing changes.

  applyChange (PegSolitaireGame game) (AddPiece (x,y) player piece )
    = PegSolitaireGame (game { boardPieces' = (x,y,player,piece) : boardPieces' game })

To add a piece to a position, just add a new tuple to the pieces on the board.

  applyChange (PegSolitaireGame game) (RemovePiece (x,y))
    = PegSolitaireGame (game { boardPieces' = [ (x',y',player,piece)
    | (x',y',player,piece)

To remove a piece from a position, filter it out of the list (using list comprehensions to keep only those with at least one coordinate different).

That’s about it. That’s all we need to define our game.

Note: you may be wondering why we have not removed the piece directly when applying the move. The problem is that, if we do that, the whole board has to be refreshed on the screen because the UI has not way of knowing what may have changed. By using this approach, we can apply only the minimal number of changes to the board on the screen and refresh a small part of it.

Graphics

The graphics are already included for you together with this sample’s code:

$ cd gtk-helpers/examples/peg-solitaire
$ ls *.{jpg,png}
Free-Background-3.jpg
player-piece-black.png
player-piece-white.png
woodciircle.1.png

To create our Gtk-based visual version of the game, we need will define the following function that loads the images and returns the initial game and its visual layer:

gtkGame :: IO (Game PegSolitaireGame Int Tile Player Peg)
gtkGame = do
  -- The images used for tiles and pegs
  tile  <- pixbufNewFromFile "player-piece-white.png"
  pegPb <- pixbufNewFromFile "player-piece-black.png"
  pb    <- pixbufNewFromFile "woodciircle.1.png"

  let game = Game visualAspects defaultPegSolitaireGame
  visualAspects = VisualGameAspects { tileF   = \_ -> tile
                                    , pieceF  = \_ -> pegPb
                                    , bgColor = (65000, 50000, 50000)
                                    , bg      = Just (pb, SizeAdjustment)
                                    }
  return game

Note that this just a value with two arguments: a mathematical definition of the game (defaultPegSolitaireGame) and a record with colours and images (visualAspects). The structure visualAspects is defined in Graphics.UI.Gtk.Board.BoardLink, and it includes four fields: a function that assigns a pixbuf to each tile, a function that assigns a pixbuf to each piece (that function receives a tuple (player, piece) as argument), the background colour, and the background image used for the board (the Gtk Board widget does not support transparency, so unused board positions must have a background). The underlying implementation uses a Gtk Board widget, defined in Graphics.UI.Gtk.Board.TiledBoard.

 

The main program

The main program is actually very simple, since we have already defined a Gtk board widget in gtk-helpers/Graphics.UI.Gtk.Board.TiledBoard, and a function that links our visual game definition to such kind of widget in Graphics.UI.Gtk.Board.BoardLink. The final code looks a lot like a simple hello world in Gtk, only that it’s more like a “Hello Board”

import Control.Monad.Trans (liftIO)
import Graphics.UI.Gtk
import Graphics.UI.Gtk.Layout.BackgroundContainer
import Graphics.UI.Gtk.Board.BoardLink
import GtkPegSolitaire

main :: IO ()
main = do
  -- View

  -- Initialise Gtk
  _ <- initGUI

  -- Create interface
  window  <- windowNew
  bgBin   <- backgroundContainerNewWithPicture "Free-Background-3.jpg"
  align   <- alignmentNew 0.5 0.5 0 0

  -- Create game and board
  game    <- gtkGame
  board   <- attachGameRules game

  -- Add hierarchy of widgets to window
  containerAdd align board
  containerAdd bgBin align
  containerAdd window bgBin

  -- Set window size
  widgetSetSizeRequest window 400 300

  -- Close program if window is closed
  _ <- window `on` deleteEvent $ liftIO mainQuit >> return False

  -- Launch program with the main window
  widgetShowAll window
  mainGUI

Note that, to make our program look better, we have created a container (bgBin) that draws an image on the background and we have centered the board on it using an alignment container).

Final result

You can compile the final program with:

$ cabal exec -- ghc --make BoardMain.hs

The first line, which you only need to run once, will tell cabal, the default haskell package installer, where to install packages. The second one, will install a dependency we need, and the last one will actually compile our example.

You can see the program working in Haskell in the following screenshots and short video. All in all, our code has only 94 lines of code, and that goes down to 80 if you do not count the imports. So it’s a fairly playable example, and we’ve only needed two screens for the whole game.

screenshot of peg solitaire written in Haskell

http://www.youtube.com/watch?v=34sZmUKFec0

EDIT (2017/04/22): Updated compilation instructions to use cabal sandboxes instead of cabal-dev. Thanks to @duplex143 for reporting this and other problems with these examples: https://github.com/keera-studios/gtk-helpers/issues/2.