A Haskell game of life using SDL for graphics. I moved it from a repository to keep things tidy.

Board.txt

------------------------------------
------------------------------------
------------------------------------
------------------------------------
------------------------------------
------------------------------------
------------------------------------
------------------------------------
------------------------------------
--------------xx--------------------
---------------xx-------------------
---------------x--------------------
------------------------------------
------------------------------------
------------------------------------
------------------------------------
------------------------------------
------------------------------------
------------------------------------
------------------------------------
------------------------------------
------------------------------------
------------------------------------
------------------------------------
------------------------------------
------------------------------------

GOL.hs

module Main where
import Prelude
import Graphics.UI.SDL as SDL
import System.Exit


data State = State {wh :: (Int,Int), new :: Cerray, old :: Cerray} deriving Show
data Cerray = Cerray [[Bool]]

instance Show Cerray where
  show (Cerray [])     = ""
  show (Cerray (x:xs)) = [if (y == True) then '0' else '-' | y <- x] ++ "\n" ++ show (Cerray xs)

filePath    = "Board.txt"
generations = 450
sdlWidth    = 500
sdlHeight   = 500
pixelColor  = (Pixel 300)

gWidth :: [[Bool]] -> Int
gWidth (x:xs) = (length x) - 1

gHeight :: [[Bool]] -> Int
gHeight y = (length y) - 1

gSizeVector :: [[Bool]] -> (Int,Int)
gSizeVector x = (gWidth x, gHeight x)

genCerray :: [String] -> [[Bool]]
genCerray [] = []
genCerray (x:xs) = (genXVals x) : genCerray xs
  where genXVals [] = []
        genXVals (y:ys)
          | y == '-' = False : genXVals ys
          | otherwise = True : genXVals ys

getNeighbors :: (Int, Int) -> State -> Int
getNeighbors (cellX, cellY) (State (wid,hei) _ (Cerray cerray)) = n + ne + e + se + s + sw + w + nw
  where n  = boolToInt $ if cellY > 0 then (cerray !! (cellY - 1)) !! cellX else False
        ne = boolToInt $ if cellY > 0 && cellX < wid then (cerray !! (cellY - 1)) !! (cellX + 1) else False
        e  = boolToInt $ if cellX < wid then (cerray !! cellY) !! (cellX + 1) else False
        se = boolToInt $ if cellY < hei && cellX < wid then (cerray !! (cellY + 1)) !! (cellX + 1) else False
        s  = boolToInt $ if cellY < hei then (cerray !! (cellY + 1)) !! cellX else False
        sw = boolToInt $ if cellY < hei && cellX > 0 then (cerray !! (cellY + 1)) !! (cellX - 1) else False
        w  = boolToInt $ if cellX > 0 then (cerray !! cellY) !! (cellX - 1) else False
        nw = boolToInt $ if cellY > 0 && cellX > 0 then (cerray !! (cellY - 1)) !! (cellX - 1) else False
        boolToInt a = if a == True then 1 else 0

applyRules :: Bool -> Int -> Bool
applyRules x y 
  | x == True && y < 2 = False
  | x == True && y > 3 = False
  | x == True && (y == 2 || y == 3) = True
  | x == False && y == 3 = True 
  | otherwise = False

transState :: (Int, Int) -> State -> [[Bool]]
transState _ (State _ (Cerray []) _) = []
transState (cellX, cellY) (State widheight (Cerray (newX:newXs)) (Cerray old)) = (transX cellX newX) : (transState (cellX, cellY + 1) (State widheight (Cerray newXs) (Cerray old)))
  where transX _ [] = []
        transX cellX (x:xs) = (applyRules x $ getNeighbors (cellX, cellY) (State widheight (Cerray old) (Cerray old))) : transX (cellX + 1) xs

readCellFile :: FilePath -> IO [[Bool]]
readCellFile file =  do
  f <- readFile file
  return $ genCerray $ lines f

gNewState :: IO State
gNewState = do
  f <- readCellFile filePath
  return $ State (gWidth f,gHeight f) (Cerray f) (Cerray f)

initSDL :: IO Surface
initSDL = do
  SDL.init [SDL.InitEverything]
  SDL.setVideoMode sdlWidth sdlHeight 32 []
  SDL.setCaption "Conway's Game of Life" "Game of Life!"
  screen <- getVideoSurface
  return screen

drawBoard :: (Int, Int) -> Surface -> State -> IO ()
drawBoard _ _ (State _ (Cerray []) _) = do return ()
drawBoard (xSpot, ySpot) surface (State (wid, hei) (Cerray (y:ys)) _) = do
  drawSquares y xSpot
  drawBoard (0, ySpot + 1) surface (State (wid, hei) (Cerray ys) (Cerray ys))
  return ()
    where drawSquares [] _ = return ()
          drawSquares (x:xs) xSpot = do
            let rect = Rect ((sdlWidth `div` wid) * xSpot) ((sdlHeight `div` hei) * ySpot) (sdlWidth `div` wid) (sdlHeight `div` hei)
            if x then fillRect surface (Just rect) pixelColor else return True
            drawSquares xs (xSpot + 1)

exit :: IO ()
exit = do
  SDL.quit
  exitSuccess
  return ()

mainLoop :: State -> Surface -> Int -> IO ()
mainLoop state surface gens = do
  fillRect surface (Just (Rect 0 0 sdlWidth sdlWidth)) (Pixel 1000)
  drawBoard (0,0) surface state
  SDL.flip surface
  print $ old state
  if gens == generations then exit else mainLoop newState surface (gens + 1)
    where newBoard = transState (0,0) state
          newState = State (wh state) (Cerray newBoard) (Cerray newBoard)

main :: IO ()
main = do
  f <- gNewState
  s <- initSDL
  mainLoop f s 0
  return ()