LifeGame.hs

import System.IO

type Pos = (Int, Int)

width :: Int
width = 5

height :: Int
height = 5

type Board = [Pos]

goto :: Pos -> IO ()
goto (x, y) = putStr ("\ESC[" ++ show x ++ ";" ++ show y ++ "H")

writeat :: Pos -> String -> IO ()
writeat p xs = do goto p
                  putStr xs

seqn :: [IO a] -> IO ()
seqn [] = return ()
seqn (a:as) = do a
                 seqn as

showcells :: Board -> IO ()
showcells b = seqn [writeat p "$" | p <- b]

isAlive :: Board -> Pos -> Bool
isAlive b p = p `elem` b

isEmpty :: Board -> Pos -> Bool
isEmpty b p = not (isAlive b p)

neighbs :: Pos -> [Pos]
neighbs (x, y) = map wrap [(pred x, pred y), (x, pred y),
                          (succ x, pred y), (pred x, y),
                          (succ x, y), (pred x, succ y),
                          (x, succ y), (succ x, succ y)]

wrap :: Pos -> Pos
wrap (x, y) = (succ $ (pred x) `mod` width, succ $ (pred y) `mod` height)

liveneighbs :: Board -> Pos -> Int
liveneighbs b = length . filter (isAlive b) . neighbs

suvivors :: Board -> [Pos]
suvivors b = [p | p <- b, liveneighbs b p `elem` [2,3]]

births :: Board -> [Pos]
-- births b = [(x, y) | x <- [1..width], y <- [1..width],
--             isEmpty b (x, y), liveneighbs b (x, y) == 3]
births b = [p | p <- rmdups . concat . map neighbs $ b,
            isEmpty b p, liveneighbs b p == 3]

rmdups :: Eq a => [a] -> [a]
rmdups [] = []
rmdups (x:xs) = x : (rmdups . filter (/= x) $ xs)

nextgen :: Board -> Board
nextgen b = suvivors b ++ births b

cls :: IO ()
cls = putStr "\ESC[2J"

life :: Board -> IO ()
life b = do cls
            showcells b
            wait 5000000
            life . nextgen $ b

wait :: Int -> IO ()
wait n = seqn [return () | _ <- [1..n]]

glider :: Board
glider = [(4,2), (2,3), (4,3), (3,4), (4,4)]

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  life glider