Simple interative Haskell game

Note: This is a group project for CSE 230, principles of functional programming language. I am responsible for coding the GUI and handling the interaction between the front-end and back-end using the brick library based on the Haskell programming language. Runnable project can be seen at: t3chou/haskell-game-of-life (github.com)

In this project, we

• Designed the core logic in pure functional language
• Wrote the GUI in pure functional language
• Designed a user-friendly interface
• Did property tests to catch logical errors

Overview

This project implements Conway’s Game of Life by using Haskell, which is great for modeling complex mathematical concepts with the design of Haskell. The Game of Life, a zero-player game, evolves from an initial state, showing emergent behavior based on some rules and status (Birth, Survival, and Death). Haskell’s strong typing and pure functionality align perfectly with this game.

Game Description

The Game of Life occurs on an infinite grid of cells. The status of each cell will be changed based on neighboring cells following those rules:

• Birth: A dead cell with three live neighbors becomes alive.
• Survival: A live cell with two or three live neighbors stays alive.
• Death:
  • Overpopulation: A live cell with over three live neighbors dies.
  • Loneliness: A live cell with under two live neighbors dies.

implementation

Haskell’s fits for expressing the game’s rules. Key aspects of our implementation include:

1. Functional Grid Representation: Using list comprehensions and higher-order functions for the grid.
2. State Transformation: Pure functions for state transitions between generations.
3. Interaction Functionality: Implementing pause/continue in the game, boosting the interaction between users and the game with the help of the brick library.
4. Unit Testing: Using QuickCheck to test each functionality, and game logic.
5. Managing Dependencies: Making use of tools like Cabal or Stack to manage dependencies.

Project Goals

1. Mathematical Fidelity: Ensure full implementation of the game following Conway’s rules.
2. User Interactions: Interacting with a user-friendly interface by key presses for pausing/continuing the game or quitting using the brick library.
3. Using existing libraries of the hackage ecosystem: Utilizing existing libraries like containers and vector.

This project aims to create a Conway’s Game of Life simulation in Haskell, as well as representing a string connection between a mathematical model and functional programming.

Source acknowledgment

1. As required by the course website, we are using the Brick library to implement the GUI interface. We did look at the official guidelines from https://github.com/jtdaugherty/brick to implement any components relevant to GUI because the Brick library has never been taught in class.
2. We use Haskell’s Hoodle to explore and employ functions for implementing our project because not all Haskell components were covered during class.
3. We use QuickCheck library to accomplish the unit testing requirments as required by the course website.

Code

The following shows codes for the front-end interface based on the brick library. In more detail, the GUI contains clickable buttons, a user-friendly setting interface, and a playable game with everything being programmed using state in Haskell:

clickable{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Main (main) where

import qualified Life       as L
import qualified PresetGrid as P
import Control.Concurrent (threadDelay)
import qualified Data.Text as T

import Lens.Micro ((^.), (%~), set)
import Lens.Micro.TH (makeLenses)
import Lens.Micro.Mtl (use, (.=), (%=))
import Control.Monad (void)
import Control.Monad.Trans (liftIO)
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>))
#endif
import qualified Graphics.Vty as V

import qualified Brick.Types as T
import Brick.AttrMap
import Brick.Util
import Brick.Types (Widget, ViewportType(Vertical), EventM
  , BrickEvent(..) 
  )
import qualified Brick.Widgets.Center as C
import qualified Brick.Widgets.Border as B
import qualified Brick.Widgets.Border.Style as BS
import Brick.Main
  ( App(..), neverShowCursor, defaultMain
  , suspendAndResume, halt, getVtyHandle, showFirstCursor, vScrollBy, viewportScroll
  )
import Brick.Widgets.Core
import qualified Data.Array as A
import Life (GridState(..))

data Name = Block | Beehive | Loaf | Boat | Tub | Blinker | Toad | Beacon | Reset | Next | Quit | Cell { _idx :: L.GridIndex , _cst :: L.CellState}
          deriving (Show, Ord, Eq)

data St =
    St { _clicked :: [T.Extent Name]
       , _lastReportedClick :: Maybe (Name, T.Location)
       , _state :: L.GridState
       , _step :: Int 
       , _msg :: String
       }

makeLenses ''St

drawUi :: St -> [Widget Name]
drawUi st =
  [vBox [ 
          B.hBorderWithLabel (str "haskell game of life")
         , vBox [ buttonLayer st
             <+> B.vBorder
             <+> C.vCenter (padAll 3 $ hLimit 10 $ vBox [ strWrap ("Click to modify state\n\nCurrent:") , padTop (Pad 1) (gridLayer st L.gridRows L.gridCols)])
                  , str "(Press Esc to quit or n for the next state)" ]]]

gridLayer :: St -> Int -> Int -> Widget Name
gridLayer st rs cs = vBox (map (\r -> hBox (map (\c -> mc (r, c) (_state st)) [0..cs-1])) [0..rs-1])
    where
        mkCell cell = 
            clickable cell $
            --    padTopBottom 1 $
            --    padLeftRight (if wasClicked then 2 else 3) $
            str (if _cst cell == L.Alive then "o" else ".")
        mc idx (GridState g)  = mkCell (Cell idx (g A.! idx)) --str (case g A.! idx of
            --L.Alive -> "o"
            --L.Dead  -> ".") 
        -- cellChar L.Alive = "o"
        -- cellChar L.Dead  = "."

buttonLayer :: St -> Widget Name
buttonLayer st =
    vBox [(padLeft (Pad 1) $ str ("Current steps:" <> show (_step st))) , B.hBorder,
    (padLeft (Pad 1) $  str "Select profile (always live):") 
    ,(hBox $ padAll 1 <$> buttons), 
    vBox [ (padLeft (Pad 1) $  str "Select profile (oscillators):") 
    ,(hBox $ padAll 1 <$> buttons1), (padLeft (Pad 1) $  str "Controls:") 
    ,(hBox $ padAll 1 <$> buttons2)]]
    where
        buttons = mkButton <$> buttonData
        buttonData = [ (Block, "Block", attrName "Block")
                     , (Beehive, "Beehive", attrName "Beehive")
                     , (Loaf, "Loaf", attrName "Loaf")
                     , (Boat, "Boat", attrName "Boat")
                     , (Tub, "Tub", attrName "Tub")
                     ]
        buttons1 = mkButton <$> buttonData1
        buttonData1 = [ (Blinker, "Blinker", attrName "Blinker")
                     , (Toad, "Toad", attrName "Toad")
                     , (Beacon, "Beacon", attrName "Beacon")
                     ]
        buttons2 = mkButton <$> buttonData2
        buttonData2 = [ (Reset, "Reset", attrName "Reset")
                     , (Next, "Next", attrName "Next")
                     , (Quit, "Quit", attrName "Quit")
                     ]
        mkButton (name, label, attr) =
            let wasClicked = (fst <$> st^.lastReportedClick) == Just name
            in clickable name $
               withDefAttr attr $
               B.border $
            --    padTopBottom 1 $
               padLeftRight (if wasClicked then 2 else 3) $
               str (if wasClicked then "<" <> label <> ">" else label)

appEvent :: T.BrickEvent Name e -> T.EventM Name St ()
appEvent ev@(T.MouseDown n _ _ loc) = do
        lastReportedClick .= Just (n, loc)
        case n of
            Block -> do 
                state .= (P.strToGrid P.block)
                step .= 0
            Beehive -> do 
                state .= (P.strToGrid P.beehive)
                step .= 0
            Loaf -> do 
                state .= (P.strToGrid P.loaf)
                step .= 0
            Boat -> do 
                state .= (P.strToGrid P.boat)
                step .= 0
            Tub -> do 
                state .= (P.strToGrid P.tub)
                step .= 0
            Blinker -> do 
                state .= (P.strToGrid P.blinker)
                step .= 0
            Toad -> do 
                state .= (P.strToGrid P.toad)
                step .= 0
            Beacon -> do 
                state .= (P.strToGrid P.beacon)
                step .= 0
            Reset -> do 
                state .= P.deadGrid
                step .= 0
            Next -> do 
                state %= L.evolution
                step %= (+ 1)
            Quit -> do 
                halt
            Cell idx cst -> state %= (\s -> L.toggleState s idx)
            
            
appEvent (T.VtyEvent (V.EvKey (V.KChar 'n') [])) = do
    state %= L.evolution
    step %= (+ 1)
appEvent (T.MouseUp {}) =
    lastReportedClick .= Nothing
appEvent (T.VtyEvent (V.EvMouseUp {})) =
    lastReportedClick .= Nothing
appEvent (T.VtyEvent (V.EvKey V.KEsc [])) =
    halt
appEvent ev = 
    return ()

aMap :: AttrMap
aMap = attrMap V.defAttr
    [ (attrName "Block",   V.white `on` V.green)
    , (attrName "Beehive",   V.white `on` V.green)
    , (attrName "Loaf",   V.white `on` V.green)
    , (attrName "Boat",   V.white `on` V.green)
    , (attrName "Tub",   V.white `on` V.green)
    , (attrName "Blinker",   V.white `on` V.blue)
    , (attrName "Toad",   V.white `on` V.blue)
    , (attrName "Beacon",   V.white `on` V.blue)
    , (attrName "Reset",   V.white `on` V.cyan)
    , (attrName "Next",   V.white `on` V.cyan)
    , (attrName "Quit",   V.white `on` V.cyan)
    ]

app :: App St e Name
app =
    App { appDraw = drawUi
          , appStartEvent = do
              vty <- getVtyHandle
              liftIO $ V.setMode (V.outputIface vty) V.Mouse True
          , appHandleEvent = appEvent
          , appAttrMap = const aMap
          , appChooseCursor = showFirstCursor
          }

main :: IO ()
main = do
    void $ defaultMain app $ St [] Nothing P.deadGrid 0 ""