Last Friday, Jayway had something called a K-dag, a half-day for learning new skills. I hosted (more co-hosted with other participants since we decided to just play around and learn from each other) an event on the graphics library Gloss for Haskell. This small game-ish demo, and text with annotated code, stem from this opportunity.

Making a game, even if you have no intention of making it real and finishing it, is good practice in any programming language. While attempting to learn Haskell, I’ve made a terminal game – in parallel with ‘the same’ game made with TypeScript – but I wanted to try making a small retro game with images for graphics.

Perhaps because Haskell is not commonly used for graphics programming there are only a few libraries available. Making this game I settled with Gloss. I’ve found two other tutorials that may be of interest: Andrew Gibianski’s Your First Haskell Application (with Gloss) and Making a Glossy Game! on Monday Morning Haskell.

I use Stack and begun by adding Gloss as a dependency to stack.yaml,

extra-deps:
    - gloss-1.13.1.2

and added ‘gloss’ (without a version number) to the build-depends of library and executable. Note that because of the limited scope of this project (~200 lines of code), I only used the Main file of the /app folder that is created when templating a new Stack project, stack new [your_project].

I have some assets. All graphics are free and were found at the Open Game Art. The assets are located at such,

assets/
├── food.bmp
├── left1.bmp
├── left2.bmp
├── left3.bmp
├── left4.bmp
├── left5.bmp
├── left6.bmp
├── level
├── right1.bmp
├── right2.bmp
├── right3.bmp
├── right4.bmp
├── right5.bmp
├── right6.bmp
└── tile.bmp

level is a plain text file containing the level represented by . for background, * for wall, and % for food (a carrot). This is the text representation of the level:

********************************
*..............................*
*%%%%%%%.......................*
************..............%....*
*....................***********
*..............................*
*..............................*
*....%.........*****...........*
*..............**.....%........*
*..............................*
*..............................*
*.........................%....*
*....%..**...............*******
*....*****..........************
*..............................*
*..............................*
*.............................%*
***..%.........**.............**
******.........**..........%%%**
******..................********
********......................**
********......................**
***********................%%%**
********************************

This project uses one language extensions, UnicodeSyntax, for pretty code and imports from Gloss,

{-# LANGUAGE UnicodeSyntax #-}

module Main where

import Graphics.Gloss
importGraphics.Gloss.Interface.Pure.Game

It’s reasonable to begin by modeling the type-level data structures.

data MoveDirection
 = East
 | West
 | None
 deriving (Eq)

data Heading
 = FacingWest
 | FacingEast
 deriving (Eq)

MoveDirection is concerned with the player moves West or East or doesn’t move at all. In this case, I’ve not included jumping since I was unsure if this could be described as moving in the same sense. Heading is for evaluating if the player is facing West or East. Unless you don’t move in the opposite direction you keep facing a direction (also when you jump).

data GameState =
 GameState
 { position :: Point
 , direction :: MoveDirection
 , heading :: Heading
 , currentLevel :: Level
 , spriteCount :: Int
 , speedX :: Float
 , speedY :: Float
 }

GameState is a record holding all game-related data. position holds the player position using Float and Point is imported from the Gloss library. direction is connected to MoveDirection, and heading to Heading.

currentLevel is of type Level and holds the level we viewed before in plain text, although read and normalized to fit the needs. We’ll pause in describing the GameState and describe the types for the level and the normalization of the text representation.

type CellType = Char
type Cell = (Point, CellType)
type Level= [Cell]

A singular character, Char, is the type of the cell – the tile, if you will. I call this CellType. A cell as such contains a tuple holding a Point holding the x/y position of the cell, along with the CellType. A Level is a list containing a number of Cell.

When reading the file – level – containing the text representation we will begin the normalization by passing it as a list to prepareData in which each row and the order of succession is passed to makeRow. As the type signature reveals it receives a [String] and returns a Level.

makeRow gets a String (a row from the list of [String] passed to prepareData and an Int, the row number, and returns a Level after transformation. The Level only includes ‘actual’ tiles, that is walls and carrots (we don’t need to include the ‘background’). Since Gloss centers things using Cartesian Coordinates and describes a Point using Float we transform the Int arising from the list comprehension and fixates its view position on the window display by multiplying the size of the tile minus half the width (for the x Point) and half the size of the tile. Similarly, we base y of Point on half the height of the window display (and again, half the tile size). We also inject the symbol on the second position of the tuple Cell.

This would transform a character * situated at (0,0) in the text file to ((-528.0, -384.0), '*') and so on.

prepareData :: [String] -> Level
prepareData rawData =
  concat [makeRow (rawData !! y) y | y <- [0..length rawData -1]]

makeRow :: String -> Int -> Level
makeRow row y =
 [ ( ( (fromIntegral x * tileSize) - ((1024 / 2) - (tileSize / 2))
 , (fromIntegral y * tileSize) - ((768 / 2) - (tileSize / 2)))
 , row !! x)
 | x <- [0 .. length row - 1]
 , row !! x == '*' || row !! x == '%'
 ]

tileSize defined:

tileSize :: Float
tileSize =32.0

Returning to the GameState:

 , spriteCount :: Int
 , speedX :: Float
 , speedY :: Float

spriteCount is increased by one whenever the player moves West or East. The sprite I use has 6 images for moving. When reaching 6, we later set it to 0. speedX and speedY is the moving speed of vertical and horizontal movement respectively.

I use the Display mode of play of Gloss. The Gloss documentation describes its parameters as such:

play
:: Display                   Display mode.
-> Color                     Background color.
-> Int                       Number of simulation steps to take for each second of real time.
-> world                     The initial world.
-> (world -> Picture)	     A function to convert the world a picture.
-> (Event -> world -> world) A function to handle input events.
-> (Float -> world -> world) A function to step the world one iteration. It is passed the period of time (in seconds) needing to be advanced.
-> IO ()	 

However, before initiating this game loop we fetch all need resources, sets an initial GameState and normalize the level,

main :: IO ()
main = do
 tileImg <- loadBMP "assets/tile.bmp"
 foodImg <- loadBMP "assets/food.bmp"
 left1 <- loadBMP "assets/left1.bmp"
 left2 <- loadBMP "assets/left2.bmp"
 left3 <- loadBMP "assets/left3.bmp"
 left4 <- loadBMP "assets/left4.bmp"
 left5 <- loadBMP "assets/left5.bmp"
 left6 <- loadBMP "assets/left6.bmp"
 right1 <- loadBMP "assets/right1.bmp"
 right2 <- loadBMP "assets/right2.bmp"
 right3 <- loadBMP "assets/right3.bmp"
 right4 <- loadBMP "assets/right4.bmp"
 right5 <- loadBMP "assets/right5.bmp"
 right6 <- loadBMP "assets/right6.bmp"
 rawData <- readFile "assets/level"
 let level = prepareData $ reverse $ lines rawData
 let state =
 GameState
 { position = (0.0, 0.0)
 , direction = None
 , currentLevel = level
 , spriteCount = 0
 , heading = FacingWest
 , speedX = 0
 , speedY = (-6)
 }

And this is how this transforms to in this project in the Main function,

 play
 window
 background
 fps
 state
 (`render` [ tileImg
 , foodImg
 , left1
 , left2
 , left3
 , left4
 , left5
 , left6
 , right1
 , right2
 , right3
 , right4
 , right5
 , right6
 ])
 handleKeys
 update

In which window, background and fps are defined as,

window :: Display
window = InWindow "Play w. Gloss" (1024, 768) (0, 0)

background :: Color
background = makeColor 0.2 0.1 0.1 1

fps :: Int
fps =60

As seen in Gloss documentation, we treat the first four parameters – window, background, fps, state – as immutable.

The update of the Gloss documentation takes a world and returns a Picture, an isolated side-effect. This project passes a GameState, a set of [Picture] which are rendered to a Picture accordingly.

render :: GameState -> [Picture] -> Picture
render gs imgs =
 pictures
 ([drawTile cell (head imgs) (imgs !! 1) | cell <- currentLevel gs] ++
 [ translate
 (fst (position gs))
 (snd (position gs) + 10)
 (imgs !! (spriteCount gs + 2 + isRight (heading gs)))
 ])

whatImg :: Cell -> Picture -> Picture -> Picture
whatImg (_, cellType) tile food =
 if cellType == '*'
 then tile
 else food

drawTile :: Cell -> Picture -> Picture -> Picture
drawTile cell tileImg foodImg =
 uncurry translate (fst cell) (whatImg cell tileImg foodImg)

isRight :: Heading -> Int
isRight FacingEast = 6
isRight _ =0

The first two elements of the [Picture] list are the images for the wall and the carrot. We iterate the Level of the GameState using a list comprehension passing individual cells together with two images referenced to drawTile. Depending on if the passed cells cellType, determined in whatImg, we render a wall or a carrot at the position of the Point of the cell.

After drawing the ‘background’, the level as such, the player is rendered at the position of the GameState. The spriteCount + 2 (we jump the wall and carrot in the list of images) + isRight determines what sprite is rendered. If the player is FacingWest we add 6, otherwise 0, since the list of images happens to include sprites for FacingLeft before FacingEast.

Now we continue with the next parameter of play, the parameter for user input.

handleKeys :: Event -> GameState -> GameState
handleKeys (EventKey (SpecialKey KeyLeft) Down _ _) gs =
 gs {direction = West, heading = FacingWest}
handleKeys (EventKey (SpecialKey KeyRight) Down _ _) gs =
 gs {direction = East, heading = FacingEast}
handleKeys (EventKey (SpecialKey KeySpace) Down _ _) gs =
 gs
 { speedY =
 if isCollision gs (fst (position gs), snd (position gs) + speedY gs) '*'
 then 6
 else (-6)
 }
handleKeys _ gs = gs {direction =None}

Using pattern matching we determine four possible states. If the user press the Left or Right arrow the GameState record is updated with a new MoveDirection and Heading. If the user press space, we modify the speedY, given that the player is standing on firm ground. If no key is pressed, the MoveDirection is set to None.

In the last parameter of play, we make updates not relating to side-effects (such as user input in the parameter/function before).

update :: Float -> GameState -> GameState
update _ gs =
 gs
 { speedY = checkSpeedY gs
 , speedX = checkSpeedX gs
 , position = moveY gs $ moveX (direction gs) gs
 , spriteCount = incSprite gs
 , currentLevel = checkFood gs
 }

As previously quoted the update of play is ‘A function to step the world one iteration. It is passed the period of time (in seconds) needing to be advanced.’. In this project, we excluded making use of the first parameter for matters of convenience.

Firstly, we check if speedY and speedX and needs updated and if so makes neccessary changes,

checkSpeedY :: GameState -> Float
checkSpeedY gs
 | isCollision gs (fst (position gs), snd (position gs) + speedY gs) '*' = -3
 | speedY gs >= -6 = speedY gs - 0.1
 | otherwise = -6

checkSpeedX :: GameState -> Float
checkSpeedX gs
  | direction gs == West || direction gs == East =
    if speedX gs > 5.0
      then 5.0
      else speedX gs + 0.5
  | otherwise =
    if speedX gs <= 0
      then 0
      else speedX gs - 0.5

isCollision :: GameState -> Point -> CellType -> Bool
isCollision gs pnt checkType =
 any
 (\((x, y), tileType) -> tileType == checkType && isHit pnt (x, y))
 (currentLevel gs)

isHit :: Point -> Point -> Bool
isHit (b1x, b1y) (b2x, b2y) =
 (b1x - 10) < b2x + tileSize &&
 b1x +50-10> b2x && b1y < b2y + tileSize && b1y +54> b2y

If the player is jumping the speedY is no its default value of -6. If the player hits a ceiling, we lower the speedY (otherwise the player would freeze the bottom of a wall tile until the speedY again would be positive). If jumping we decrease the speed by 0.1. If moving horizontally, we check if the MoveDirection is East or West, using guards and increase speedX if it’s lower than 5.0. On the other hand, if the player is not moving we decrease speed until it reaches 1 if not already defaulted.

moveX takes a MoveDirection and a GameState and returns a Point. If MoveDirection is either West or East if no collision is at hand we modify the player position. If moving West we multiply the speedX by -1, changing the direction of the moving. When Direction is None we create the illusion of decreasing acceleration by still moving, if speedX is greater than 0.

moveX :: MoveDirection -> GameState -> Point
moveX East gs =
  if not (isCollision gs (fst (position gs) + speedX gs, snd (position gs)) '*')
    then (fst (position gs) + speedX gs, snd (position gs))
    else position gs
moveX West gs =
  if not
       (isCollision
          gs
          (fst (position gs) + speedX gs * (-1), snd (position gs))
          '*')
    then (fst (position gs) + speedX gs * (-1), snd (position gs))
    else position gs
moveX _ gs =
  if speedX gs > 0 &&
     not
       (isCollision
          gs
          ( fst (position gs) +
            speedX gs *
            (if heading gs == FacingWest
               then (-1)
               else 1)
          , snd (position gs))
          '*')
    then ( fst (position gs) +
           speedX gs *
           (if heading gs == FacingWest
              then (-1)
              else 1)
         , snd (position gs))
    else position gs

moveY :: GameState -> Point -> Point
moveY gs pnt =
 if not (isCollision gs (fst pnt, snd pnt + speedY gs) '*')
 then (fst pnt, snd pnt + speedY gs)
else pnt

incSprite increases the spriteCount by one, if not 6 (5 since we begin a 0 and have 6 sprites for each direction).

incSprite :: GameState -> Int
incSprite gs =
 if direction gs /= None
 then if spriteCount gs == 5
 then 0
 else spriteCount gs + 1
else spriteCount gs

If the player is at a Cell holding food we filter out this element, implicitly making the list of Level one element shorter. If continued from ‘demo’ to ‘real’ game we would most likely increase the score at this point.

checkFood :: GameState -> Level
checkFood gs =
 filter
 (\cell -> not (isHit (fst cell) (position gs) && snd cell == '%'))
 (currentLevel gs)

This is a modified republication from a post on my blog, Here be seaswines