An array representation on the other hand, grows proportionally with the area spanned by all live cells. Since random patterns quite often fire gliders in opposite directions, this area can grow very quickly.
Anyway, this program takes a .cells pattern file for an optional argument; you can also press 'r' while paused for a random pattern, or click to create your own.
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TupleSections #-}
import Graphics.UI.SDL as SDL
import System.Environment (getArgs)
import Control.Arrow ((***))
import Control.Monad (liftM2, join)
import Data.List (delete, unfoldr)
import System.Random.Mersenne.Pure64 (newPureMT, randomInt)
import qualified "hashmap" Data.HashSet as S
import qualified "unordered-containers" Data.HashMap.Strict as M
(xres, yres, cellSz) = (1600, 900, 3)
main = withInit [InitVideo] $ do
win <- setVideoMode xres yres 32 [Fullscreen]
args <- getArgs
pat <- case args of
[s] -> loadPattern s
_ -> return []
enableEvent SDLMouseMotion False
setCaption "Life" "Life"
pause win pat
pause w cs = do
delay 128
drawCells w cs
e <- pollEvent
case e of
KeyUp (Keysym SDLK_ESCAPE _ _) -> return ()
KeyUp (Keysym SDLK_SPACE _ _) -> run w cs
KeyUp (Keysym SDLK_r _ _) -> pause w =<< randPattern
MouseButtonUp x y _ -> click (scale x, scale y)
_ -> pause w cs
where
scale = (`div` cellSz) . fromIntegral
click c | c `elem` cs = pause w $ delete c cs
| otherwise = pause w $ c:cs
run w cs = do
drawCells w cs
e <- pollEvent
case e of
KeyUp (Keysym SDLK_ESCAPE _ _) -> return ()
KeyUp (Keysym SDLK_SPACE _ _) -> pause w cs
_ -> run w $ next cs
drawCells w cs = do
fillRect w (Just $ Rect 0 0 xres yres) (Pixel 0)
c <- createRGBSurface [SWSurface] cellSz cellSz 32 0 0 0 0
mapM_ (draw c . scale) cs
SDL.flip w
where
rect (x,y) = Just $ Rect x y cellSz cellSz
scale = join (***) (* cellSz)
draw c p = do fillRect c Nothing $ Pixel 0xFFFFFF
blitSurface c Nothing w $ rect p
----------------------------------------------------------------
loadPattern = fmap parse . readFile -- reads .cells format
where
parse = center . clean . coord . strip . lines
strip = dropWhile $ (== '!') . head
coord = zipWith zip $ map (zip [0..] . repeat) [0..]
clean = concatMap $ map fst . filter ((== 'O') . snd)
randPattern = fmap f newPureMT
where
f = center . uncurry zip . splitAt 48 . g
g = map (`rem` 9) . unfoldr (Just . randomInt)
center = map $ (x+) *** (+y)
where
[x,y] = map (`div` (2 * cellSz)) [xres, yres]
next cs = [i | (i,n) <- M.toList neighbors,
n == 3 || (n == 2 && S.member i cs')]
where
cs' = S.fromList cs
moore (x,y) = tail $ liftM2 (,) [x, x+1, x-1] [y, y+1, y-1]
neighbors = M.fromListWith (+) $ map (,1) $ moore =<< cs
