Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Will Donnelly May 30, 2011
file 50 lines (42 sloc) 2.648 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49
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` parTraversable rpar
  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
Something went wrong with that request. Please try again.