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 = PlayableGame a index tile player pieceindex, atile, aplayer, apiececurPlayerplayerallPiecesindex, index, player, pieceallPosindex, index, tilemoveEnabledmoveEnabled _FalsecanMoveplayerindex, indexcanMove _ _ _FalsecanMoveToplayerindex, indexindex, indexcanMoveTo _ _ _ _Falsemoveplayerindex, indexindex, indexGameChange index player piecemove _ _ _ _activateEnabledactivateEnabled _FalsecanActivateplayerindex, indexcanActivate _ _ _Falseactivateplayerindex, indexGameChange index player pieceactivate _ _ _applyChangeGameChange index player pieceapplyChange g _applyChangesGameChange index player pieceapplyChanges 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?).

(can players move pieces at all?), (can this player move this piece?), (can this player move this piece to this location?), (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?).

(can we ‘activate’ board positions at all?), (can we activate a specific position?), and (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?).

(who should play now?), (where are the pieces located?) and (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):

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) && (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 )



-- 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,_ ) PegPegTileTilePlayerPlayerPegSolitaireGamePegSolitaireGameGameState Int Tile Player PegdefaultPegSolitaireGamePegSolitaireGamedefaultPegSolitaireGamePegSolitaireGameGameStatecurPlayer'Player, boardPosallTiles, boardPieces'piecesallTilesx,y,Tilepiecesx,y,Player,Pegx,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 where



-- "Static" game view

curPlayer ( PegSolitaireGame game ) = curPlayer' game

allPieces ( PegSolitaireGame game ) = boardPieces' game

allPos ( PegSolitaireGame game ) = boardPos game PlayableGame PegSolitaireGame Int Tile Player PegcurPlayerPegSolitaireGame gamecurPlayer' gameallPiecesPegSolitaireGame gameboardPieces' gameallPosPegSolitaireGame gameboardPos 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 ( posO - )

diffY = abs ( posD - )

correctDiff = ( diffX == 0 && diffY == 2 ) || ( diffX == 2 && diffY == 0 )

posI = ( ( posO + ) ` div ` 2 , ( posO + ) ` div ` 2 ) moveEnabled _TruecanMove _ _ _TruecanMoveTo _ _ _ _TruemovePegSolitaireGame game_player posO posDhasPiece game posOhasPiece game posIhasPiece game posDcorrectDiffMovePiece posO posD, RemovePiece posIdiffX fst posO fst posDdiffY snd posD snd posOcorrectDiffdiffXdiffYdiffXdiffYposI fst posO fst posD snd posO snd posD

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 applyChange psgPegSolitaireGame gameMovePiece posO posDJustplayer, pieceapplyChanges psgRemovePiece posO, RemovePiece posD, AddPiece posD player piecepsg

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:

:: IO ( Game PegSolitaireGame )

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 )

}



gtkGameGame PegSolitaireGame Int Tile Player PeggtkGametilepixbufNewFromFilepegPbpixbufNewFromFilepbpixbufNewFromFilegameGame visualAspects defaultPegSolitaireGamevisualAspectsVisualGameAspectstileFtile, pieceFpegPb, bgColor, bgJustpb, 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.





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.