PREVIOUS PART: Data Structures and Basic Functionality

Part 2B - Advanced Functions and UI

Advanced functionality

In the last part, we added basic board functionality. Let’s next add functionality to support making moves on a board. First, let’s define what should change when some spot is clicked with a certain player

-- Returns a list of pieces that should be changed to the player's color on a board when clicking on some point. If the list is empty, the move is not valid
getMovesOnPoint :: Board -> Player -> Coordinate -> [Coordinate]
getMovesOnPoint board player base_coord
     -- Not a valid base coordinate, invalid
    | isValidBaseCoord == False = []
     -- Not valid, must be an empty location
    | basePiece /= (Empty) = []
     -- No valid directions, no result
    | null (resultingDirections) = []
     -- Include our base coord, and return
    | otherwise = base_coord:resultingDirections
        resultingDirections = concat (map (walkAndMark) directionsToCheck)

        walkAndMark :: Coordinate -> [Coordinate]
        walkAndMark direction = walkAndMarkIntr (baseX+dirX,baseY+dirY) direction [] where
            (dirX,dirY) = direction

        -- Walk and mark - walk in a direction and mark down the found coordinates. If it terminates on a placed piece of the opposing player, return the list. If to our player or empty, nothing
        walkAndMarkIntr :: Coordinate -> Coordinate -> [Coordinate] -> [Coordinate]
        walkAndMarkIntr currentPos direction listOfFound
            -- At the end, do not include the terminating piece
            | isEndPiece = listOfFound
            | isValidTraversalPiece = walkAndMarkIntr (curX+dirX,curY+dirY) direction (currentPos:listOfFound)
            -- Not a valid end piece nor a traversal piece
            | otherwise = [] 
                (curX,curY) = currentPos
                (dirX,dirY) = direction
                isEndPiece = isValidPos && ((pieceAtCoordinate board currentPos) == (Placed player))
                isValidTraversalPiece = isValidPos && ((pieceAtCoordinate board currentPos) == (Placed (opposingPlayer player)))
                isValidPos = (coordinateInBounds board currentPos)
         -- Which relative directions we need to check?
        directionsToCheck = [(-1,-1), (-1,0), (-1,1), (0,-1), (0,1), (1,-1), (1,0), (1,1)]

        (baseX,baseY) = base_coord
        isValidBaseCoord = coordinateInBounds board base_coord
        basePiece = pieceAtCoordinate board base_coord 

-- Returns a list containing lists of coordinates for applying moves. The first item in the list is always the piece clicked
movesAvailableForPlayer :: Board -> Player -> [[Coordinate]]
movesAvailableForPlayer board player = filteredResults -- Return the resulting list as defined below
        filteredResults = filter (\lst -> (null lst) == False) mappedCoords
        mappedCoords = gridComprehension (getMovesOnPoint board player)

-- Determines if no moves are possible at all on a given board
noMovesPossibleAtAll :: Board -> Bool
noMovesPossibleAtAll board = null $ (movesAvailableForPlayer board Red) ++ (movesAvailableForPlayer board Blue)

-- Applies a move; in practice, this means setting the pieces at coordinates given to the player wanted         
applyMove :: Board -> Player -> [Coordinate] -> Board
applyMove board player move_list = Board ((boardGrid board) // (map (\coord -> (coord, Placed player)) move_list))

Take your time digesting all that; the gist is that moves are stored as lists containing coordinates to change, and applying is simply changing all coordinates listed to contain the button of our color. We also need to use a recursive algorithm to “walk” from our starting points, enabling us to determine if there’s any valid move at that point.


Naturally, our game requires an user interface. First, let’s define a few constants again; in this case, we need to do some unit conversions as GLOSS marks position in terms of a relative coordinate from the centre of a window. This is tricky to us, so we need to implement conversion to a more reasonable edge-based form

-- The resolution of the window
resolutionX :: Int
resolutionX = 700
resolutionY :: Int
resolutionY = 700

-- As the rendering is from the centre, in what way the coordinates should be translated to return them back to left lower edge-based positioning
centreAdjustmentX :: Int
centreAdjustmentX = -1 * (resolutionX `div` 2)
centreAdjustmentY :: Int
centreAdjustmentY = -1 * (resolutionY `div` 2)

gridAbsoluteLeftX :: Int
gridAbsoluteLeftX = 50 -- From left edge
gridAbsoluteLeftY :: Int
gridAbsoluteLeftY = 100 -- From bottom
gridBoxSize :: Int
gridBoxSize = 45 -- How large a single square is?

circleSize :: Float
 -- Radius of the circle
circleSize = 20

-- From which coordinate the text is rendered, X
textBottomLeftX = 50 
-- From which coordinate the text is rendered, Y 
textBottomLeftY = 100  

Our rendering library, GLOSS, operates by the concept of a world; each state of the game is contained in the world, the picture shown is a result of a function taking the world, and all events (e.g mouse clicks) alter the world. Let’s define that

data GameWorld = World {
    gameBoard :: Board, -- Board in this current state?
    playerTurn :: Player, -- Whose turn it is
    passedOnLastTurn :: Bool, -- Was there a pass on the last turn?
    bothStalled :: Bool, -- Has the game stalled, AKA two passes in a row, meaning game over
    ticks :: Float -- Ticks counter to count how long to wait until AI kicks into action

-- Initial world contains an initial board state, starting on Red, no passes or stall and starting at zero ticks.
initialWorld = World initialBoard Red False False 0.0 

Next, rendering code; another big bunch of code, but should be manageable - we are nearly there! In here we construct our game display out of multiple distinct elements, and finally merge all of them together to a final picture we’ll return for the world

-- Rendering is a bit tricky, as the render is centered to the center of the window and not to the sides! We then need to adjust these down
renderWorld :: GameWorld -> Picture
renderWorld world = Translate (fromIntegral centreAdjustmentX) (fromIntegral centreAdjustmentY) (Pictures (concat [boardRender, gridList, [textRender]])) where -- Translate a list of subpictures (elements of the drawn screen) to their correct position, as we have a special calculation mechanism for coordinates used below

    winningPlayerText :: Maybe Player -> String -- Define winner texts
    winningPlayerText (Just Red) = "Red wins"
    winningPlayerText (Just Blue) = "Blue wins"
    winningPlayerText Nothing = "Draw"

    -- Define a text to render at the bottom of the screen, denoting current status.
    -- Here, you will find a new operator ($) - it means anything on the right side of the said operator will take precedence over the left side, basically allowing you to avoid using parentheses to delimit parameters
    textRender = Scale 0.15 0.15 $ (Translate textBottomLeftX textBottomLeftY $ Color white (Text (
                case () of _
                            | noMovesPossibleAtAll (gameBoard world) -> winningPlayerText (winningPlayer (gameBoard world))
                            | null (movesAvailableForPlayer (gameBoard world) (playerTurn world)) -> "No possible positions for you, " ++ (show $ playerTurn world) ++ ", passing"
                            | playerTurn (world) == Blue -> "Turn for Blue"
                            | playerTurn (world) == Red -> "Turn for Red"
                            | otherwise -> ""
    -- Board state, including buttons
    boardRender = [Translate (fst $ gridPosForAssoc placedButton) (snd $ gridPosForAssoc placedButton) $ Color (colorForAssoc placedButton) (Circle circleSize) | placedButton <- placedButtons]
            gridPosForAssoc :: (Coordinate, BoardPosition) -> (Float, Float)
            gridPosForAssoc assoc = (actualX, actualY) where
                 (coordX, coordY) = fst assoc
                 actualX :: Float
                 actualX = fromIntegral $ gridAbsoluteLeftX + ((coordX*gridBoxSize) + (gridBoxSize `div` 2))
                 actualY :: Float
                 actualY = fromIntegral $ gridAbsoluteLeftY + ((((gameGridSize-1)-(coordY))*gridBoxSize) + (gridBoxSize `div` 2))
            colorForAssoc :: (Coordinate, BoardPosition) -> Color
            colorForAssoc assoc = if (snd assoc) == Placed Red then red else blue
            placedButtons = filter (\asc -> snd (asc) /= Empty) (assocs (boardGrid (gameBoard world)))

    -- Grid comprehension to form the drawings for the grid
    gridDrawingFunction (gridX, gridY) = whiteBox (fromIntegral $ gridAbsoluteLeftX+(gridBoxSize*gridX),fromIntegral $ gridAbsoluteLeftY + (gridBoxSize*gridY)) (fromIntegral $ gridAbsoluteLeftX+(gridBoxSize*(gridX+1)),fromIntegral $ gridAbsoluteLeftY+(gridBoxSize*(gridY+1)))
    gridList = gridComprehension gridDrawingFunction
    -- A helper function for rendering a white hollow box
    whiteBox startPoint endPoint = Color white (Line points) where
        (endX, endY) = endPoint
        (startX, startY) = startPoint
        points = [(startX, startY), (endX, startY), (endX, endY), (startX, endY), (startX, startY)]

handleEvent :: Event -> GameWorld -> GameWorld -- Handles any events, like clicks or mouse movement
handleEvent _ world = world -- Not relevant at the moment
timerTick :: Float -> GameWorld -> GameWorld -- A timer that is called at an interval specified
timerTick _ world = world -- Not relevant at the moment
main = play -- This program is a GLOSS game..
        (InWindow "Haskellversi" (resolutionX,resolutionY) (20,20)) -- In a window of a suitable size
         black -- With a black background
         24 -- 24fps
         initialWorld -- Initial state
         renderWorld -- Render images using renderWorld
         handleEvent -- Handle events using handleEvent
         timerTick -- Timer effects via timerTick..

And finally, we need to add a few more dependencies to the haskellversi.cabal file in the root directory of the project.

This is easy: open the file, and where you find this (should be under “executable haskellversi”)

build-depends:       base >= 4.7 && < 5

change it to

build-depends:       base >= 4.7 && < 5, gloss, array

Now, it should build and display something! You may now test your program by:

Granted, it is not really a game yet - what you should now see is somewhat akin to the picture in the very first post - just that it doesn’t do anything at all, when you click it. Still, the scaffolding is there - now we just need interaction logic, and the fabled Artificial Intelligence to play with you. That’s the thing we’ll be looking at in part 3 in our series of posts - and then, you will finally get to play :D

Thanks for your time! Be sure to comment, particularly if there are any issues getting this program to build.

The full source is available also on GitLab

NEXT PART: Artificial Intelligence