haskellGameOfLife.hs

import qualified Data.Map as M
import System.Random
import Data.List
import Control.Concurrent

width = 50
height = 50
type FieldMap = M.Map (Int, Int) Bool
coodinates = [(x,y)|y <- [1..height], x <- [1..width]]

-------------------------------
updateField :: FieldMap -> FieldMap
updateField fieldMap = newFieldMap
    where
        newFieldMap = M.fromList $ map (newField fieldMap) coodinates

newField :: FieldMap -> (Int, Int) -> ((Int, Int), Bool)
newField fieldMap (x, y) =
    if g $ (M.lookup (x, y) fieldMap)
        then
            if numSur == 2 || numSur == 3
                then
                    ((x, y), True)
                else
                    ((x, y), False)
        else
            if numSur == 3
                then
                    ((x, y), True)
                else
                    ((x, y), False)
    where
        numSur = sumSur $ map ((flip M.lookup) fieldMap) [(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)]

sumSur :: [Maybe Bool] -> Int
sumSur list = sum $ map maybeToInt list

maybeToInt :: Maybe Bool -> Int
maybeToInt (Just x) = if x then 1 else 0
maybeToInt Nothing = 0
---------------------------------
-------------------------------
fieldMapToString :: FieldMap -> String
fieldMapToString fieldMap = unlines $ lineToLines $ map boolToChar oneLine
    where
        oneLine = map g $ (map ((flip M.lookup) fieldMap) coodinates)

lineToLines :: String -> [String]
lineToLines [] = [[]]
lineToLines list = (fst (splitAt width list)):(lineToLines $ snd (splitAt width list))

f :: FieldMap -> Int -> Int -> Bool
f fieldMap y x = g $ M.lookup (x, y) fieldMap

g (Just x) = x

boolToChar :: Bool -> Char
boolToChar state = if state then 'O' else '@'
---------------------------------
---------------------------------
genFirstField :: StdGen -> M.Map (Int, Int) Bool
genFirstField gen = M.fromList $ zip [(x,y)|x <- [1..width], y <- [1..height]] (randoms gen)
---------------------------------

updateScreen :: FieldMap -> IO FieldMap
updateScreen fieldMap = do
    let
        fieldMapStr = fieldMapToString fieldMap
    putStrLn fieldMapStr
    threadDelay (1 * 1000 * 1000)
    updateScreen (updateField fieldMap)

main = do 
    gen <- getStdGen
    let 
        field = genFirstField gen
    updateScreen field