import Data.Array -- Used to store the world state for processing
import System.Random -- Used to generate the initial random world
import Control.Monad -- Used for some fancy looping constructs
import Control.Concurrent -- Used to fork the quit event handler
import Graphics.UI.SDL as SDL -- Used to draw the pretty pictures
import Control.Parallel.Strategies
data Cell = Off | Dying | On deriving (Eq, Enum)
worldX = 90 -- The horizontal size of the world
worldY = 90 -- The vertical size of the world
cellSize = 8 -- The overall size of a cell
border = 1 -- The border width between cells
screenX = worldX * cellSize -- The horizontal size of the world, in pixels
screenY = worldY * cellSize -- The vertical size of the world, in pixels
fillSize = cellSize - border -- The size of the filled area in each cell
stepCell (Off, 2) = On -- If a dead cell has 2 live neighbors, turn on
stepCell (Off, _) = Off -- Otherwise, just stay turned off
stepCell (Dying, _) = Off -- Dying cells always turn off
stepCell (On, _) = Dying -- Live cells always start to die
indexArray x y = listArray ((1,1),(x,y)) [(a,b) | a <- [1..x], b <- [1..y]]
stepWorld w = newWorld `using` parArr rwhnf
where newWorld = fmap (stepCell . getPeers w) $ indexArray worldX worldY
getPeers world (x,y) = (world ! (x,y), length . filter (== On) $ neighbors)
where neighbors = [getCell x y | x <- [x-1 .. x+1], y <- [y-1 .. y+1]]
getCell x y = world ! (clip worldX x, clip worldY y)
clip max val | val < 1 = clip max $ val + max - 1
| val > max = clip max $ val - max + 1
| otherwise = val
main = do rng <- newStdGen
SDL.init [SDL.InitVideo]
SDL.setCaption "Brian's Purely Functional Brain" "Brian's Brain"
surface <- SDL.setVideoMode screenX screenY 24 [SDL.DoubleBuf]
forkIO . forever $ waitEvent >>= \e -> when (e == Quit) quit
mapM (drawWorld surface) (iterate stepWorld $ world rng)
where world = listArray ((1,1),(worldX,worldY)) . map toEnum . randomRs (0,2)
drawWorld s w = do sequence [draw x y | x <- [1..worldX], y <- [1..worldY]]
SDL.flip s
where draw x y = SDL.fillRect s (Just rect) . color $ w ! (x,y)
where rect = SDL.Rect (scale x) (scale y) fillSize fillSize
scale n = (n - 1) * cellSize
color On = SDL.Pixel 0x00FFFFFF
color Dying = SDL.Pixel 0x00888888
color Off = SDL.Pixel 0x00000000