Let's build an Othello AI - part 2B - Advanced Functions and UI (16.4.2017)

In the series:

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 where 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 = [] where (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 where 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] where 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 GitHub