conway.hs

import Data.Array
import Control.Concurrent

main = do

    -- TODO guard against malicious input sequences

    putStrLn "How many rows do you want?"
    num_rows <- getLine 
    let x = (read num_rows :: Int)

    putStrLn "How many columns do you want?"
    num_cols <- getLine 
    let y = (read num_cols :: Int)

    putStrLn "Type a pattern name from (blinker, toad, glider, r-pento, diehard)"
    pattern_str <- getLine

    let initState = initializeMtx x y (generatePattern pattern_str (x `div` 2) (y `div` 2))

    putStrLn "Initial State: "
    printMtx initState

    putStrLn "How many steps do you want to simulate this for?"
    num_steps <- getLine
    let n = (read num_steps :: Int)

    putStrLn "How much delay do you want between each step (microseconds)?"
    raw_delay <- getLine
    let delay = (read raw_delay :: Int)

    simulate n initState delay

-- simulate and print each step from t to t+n
simulate n curState delay = do
    let countNeighbours (x, y) mtx = foldr (\(i, j) acc -> if (mtx!(i, j))==alive then acc+1 else acc) 0 [(x-1, y-1), (x-1, y), (x-1, y+1), (x, y-1), (x, y+1), (x+1, y-1), (x+1, y), (x+1, y+1)]
    let toBeBorn mtx = filter (\(x, y) -> if (mtx!(x,y)==dead && (countNeighbours (x, y) mtx)==3) then True else False) [(i, j) | i <- [1..((num_rows mtx)-1)], j <- [1..((num_cols mtx)-1)]]
    let toDie mtx = filter (\(x, y) -> let count = countNeighbours (x, y) mtx in if (mtx!(x,y)==alive && count /= 2 && count /= 3) then True else False) [(i, j) | i <- [1..((num_rows mtx)-1)], j <- [1..((num_cols mtx)-1)]]
    let takeStep state = activateCells (toBeBorn state) $ deactivateCells (toDie state) state

    if n <= 0 then return curState
    else
        let nextState = takeStep curState
        in do
            printMtx nextState
            threadDelay delay
            simulate (n-1) nextState delay

-- utility functions
num_cols mtx = snd $ snd $ bounds mtx
num_rows mtx = fst $ snd $ bounds mtx

alive = '⬜'
dead = '⬛'
boundary = ' '

printMtx mtx = 
    let rowAsStr mtx x = [mtx ! (x, y) | y <- [0..(num_cols mtx)]] 
    in 
      let mtxAsStr mtx = unlines [rowAsStr mtx x | x <- [0..(num_rows mtx)]] 
      in putStr (mtxAsStr mtx)

activateCells xs mtx = mtx // [(x, alive) | x <- xs]
deactivateCells xs mtx = mtx // [(x, dead) | x <- xs]

initializeMtx n m set_cells =
    -- intialize dead state. Padding of length 1 on all sides
    let emptyMtx = (array ((0, 0), (n+1, m+1)) [((i, j), dead) | i <- [0..(n+1)], j <- [0..(m+1)]]) 
    in
      let createBorders mtx = mtx // ([((0, j), boundary) | j <- [0..(num_cols mtx)]] ++ [((num_rows mtx, j), boundary) | j <- [0..(num_cols mtx)]] ++ [((i, 0), boundary) | i <- [1..(num_rows mtx)-1]] ++ [((i, (num_cols mtx)), boundary) | i <- [1..(num_rows mtx)-1]])
      in activateCells set_cells (createBorders emptyMtx)

-- 1. TODO add more patterns
-- 2. TODO allow custom inputs
generatePattern "blinker" x y =  [(x, y-1), (x, y), (x, y+1)]
generatePattern "toad" x y = [(x, y-1), (x, y), (x, y+1), (x+1, y), (x+1, y-1), (x+1, y-2)]
generatePattern "glider" x y = [(x-1, y), (x, y), (x+1, y), (x+1, y-1), (x, y-2)]
generatePattern "r-pento" x y = [(x, y), (x-1, y), (x+1, y), (x-1, y+1), (x, y-1)]
generatePattern "diehard" x y = [(x, y), (x+1, y), (x, y-1), (x+1, y+4), (x+1, y+5), (x+1, y+6), (x-1, y+5)]