conway's game of 💩

shittylife.hs

-- conway's game of 💩
-- shittily written by benley

module Main where

import Control.Concurrent
import Data.Array.Unboxed
import System.Environment

data Cell = Live | Dead deriving Eq

instance Show Cell where
    show Live = "💩"
    show Dead = " "

type Board = Array (Int, Int) Cell

showboard :: Board -> String
showboard b = unlines [ concatMap show $ getrow b i | i <- range (ly, uy) ] where
  ((ly, lx), (uy, ux)) = bounds b
  getrow :: Board -> Int -> [Cell]
  getrow b n = [ b!(n, x) | x <- range (lx, ux) ]

neighbors :: Board -> (Int, Int) -> Int
neighbors b (y, x) = length (filter (== Live) ncells) where

  ((ly, lx), (uy, ux)) = bounds b

  check :: (Int, Int) -> Cell
  check (i, j) = b!(y', x') where
    y' | i < ly = uy | i > uy = ly | otherwise = i
    x' | j < lx = ux | j > ux = lx | otherwise = j

  ncells = map check [(y', x') | x' <- [x-1 .. x+1],
                                 y' <- [y-1 .. y+1],
                                 (x', y') /= (x, y)]

rules :: Cell -> Int -> Cell
rules Dead n | n == 3         = Live | otherwise = Dead
rules Live n | n `elem` [2,3] = Live | otherwise = Dead

readBoard :: String -> Board
readBoard b = array bsize (zip (range bsize) (map toCell $ concat blines)) where
  blines = lines b
  bsize = ((0, 0), (length blines - 1, length (head blines) - 1))

  toCell c | c `elem` ('+':show Live) = Live
  toCell _   = Dead

runOne :: Board -> Board
runOne b = array bbound [(pos, rules (b!pos) (neighbors b pos)) | pos <- range bbound]
           where bbound = bounds b

runLoop :: Board -> [Board]
runLoop b = b : runLoop (runOne b)

main :: IO ()
main = do
    args <- getArgs
    board <- readFile (head args)
    mapM_ printSlow (runLoop (readBoard board))
    where printSlow b = threadDelay 200000 >> putStr "\ESC[2J" >> putStr (showboard b)