Commits

Brian McKenna committed 4335edf

Initial commit

Comments (0)

Files changed (4)

+.*\.hi
+.*\.o
+.*\.prof
+Main
+SDLMain
+module GameOfLife where
+
+import Data.Array
+import System.Random
+
+data Cell = Alive | Dead deriving (Show, Eq)
+
+gridToList grid = assocs grid
+
+liveNeighbours x y grid =
+  length $ filter (== Alive) $ [grid ! pos | pos <- neighbours, inBounds pos]
+    where neighbours = [(cX, cY) | cX <- [x - 1, x, x + 1], cY <- [y - 1, y, y + 1], not (x == cX && y == cY)]
+          lower = fst $ bounds grid
+          upper = snd $ bounds grid
+          boundsX = (fst lower, fst upper)
+          boundsY = (snd lower, snd upper)
+          inBounds (cX, cY) = inRange boundsX cX && inRange boundsY cY
+
+nextCellGeneration Alive 2 = Alive
+nextCellGeneration _ 3 = Alive
+nextCellGeneration _ _ = Dead
+
+setAlive x y grid = 
+  array (bounds grid) [((cellX, cellY), if (cellY == y && cellX == x) then Alive else cell) | ((cellX, cellY), cell) <- assocs grid]
+
+makeGrid width height =
+  array ((1, 1), (width, height)) l
+    where l = zip [(w, h) | w <- [1..width], h <- [1..height]] (repeat Dead)
+
+cellX ((x, _), _) = x
+cellY ((_, y), _) = y
+cellState (_, c) = c
+
+nextGridGeneration grid =
+  array (bounds grid) $ map (\((x, y), c) -> ((x, y), nextCellGeneration c (liveNeighbours x y grid))) $ assocs grid
+
+glider x y grid = grid // [((x, y + 1), Alive), ((x + 1, y + 2), Alive), ((x + 2, y), Alive), ((x + 2, y + 1), Alive), ((x + 2, y + 2), Alive)]
+
+randomGrid grid = do
+  gen <- newStdGen
+  let randomOnes = randomRs (0, 1) gen :: [Int]
+      is = indices grid
+    in return $ grid // [(is !! i, if (randomOnes !! i) == 1 then Alive else Dead) | i <- [0..length is - 1]]
+module Main where
+
+import GameOfLife
+
+import Control.Concurrent
+import System.IO
+
+cellChar Dead  = ' '
+cellChar Alive = '*'
+
+printGrid grid = do
+  putStr "\ESC[0;31m"
+  mapM_ (\((x, y), c) -> putStr ("\ESC[" ++ show y ++ ";" ++ show x ++ "H" ++ [cellChar c])) $ gridToList grid
+  putStr "\ESC[0m"
+
+runGrid grid = do
+  printGrid $ grid
+  threadDelay 250000
+  runGrid $ nextGridGeneration grid
+
+test label True = putStrLn $ "Pass: " ++ label
+test label False = putStrLn $ "Fail: " ++ label
+  
+runTests = do
+  test "test alive w/1 neighbours" $ (nextCellGeneration Alive 1) == Dead
+  test "test alive w/ 2 neighbours" $ (nextCellGeneration Alive 2) == Alive
+  test "test alive w/ 3 neighbours" $ (nextCellGeneration Alive 3) == Alive
+  test "test dead w/ 1 neighbours" $ (nextCellGeneration Dead 1) == Dead
+  test "test dead w/ 3 neighbours" $ (nextCellGeneration Dead 3) == Alive
+  
+main = do
+  hSetBuffering stdout NoBuffering
+  --runGrid $ glider 10 10 $ setAlive 6 6 $ setAlive 6 5 $ setAlive 5 6 $ setAlive 5 5 $ makeGrid 60 20
+  grid <- randomGrid $ makeGrid 60 20
+  
+  putStr "\ESC[2J"
+  runGrid grid
+module Main where
+
+import GameOfLife
+
+import Graphics.UI.SDL as SDL
+
+width = 128
+height = 96
+
+scale = 5
+
+getPix x y = SDL.Rect (fromIntegral (x - 1) * scale) (fromIntegral (y - 1) * scale) scale scale
+
+drawPixel screen (x, y) = do
+  fillRect screen (Just (getPix x y)) $ Pixel 0xFF0000
+
+draw grid screen = do
+  fillRect screen Nothing $ Pixel 0xFFFFFF
+  
+  mapM_ (drawPixel screen) $ map fst $ filter (\(_, c) -> c == Alive) $ gridToList grid
+  
+  SDL.flip screen
+
+gameHandler grid screen = do
+  draw grid screen
+  
+  e <- pollEvent
+  case e of
+    Quit -> return ()
+    otherwise -> gameHandler (nextGridGeneration grid) screen
+
+main = do
+  SDL.init [InitEverything]
+  setVideoMode (width * scale) (height * scale) 32 []
+  screen <- getVideoSurface
+  
+  grid <- randomGrid $ makeGrid width height
+  
+  gameHandler grid screen