elementary cellular automata

This code takes the rule number for an elementary cellular automaton as input, and then runs the CA from a random seed, rendering the result. The seed comprises 600 random bits taken from rule 30. Its length, when accounting for scale, is greater than the window width; this helps keep pathological edge effects outside the visible frame. The screenshot at left shows an execution of the famous rule 110.

	import Control.Monad (when)
	import Graphics.UI.SDL as SDL
	import System.Environment (getArgs)
	(xres, yres, unit) = (800, 600, 2)
	main = withInit [InitVideo] $ do
	[n] <- getArgs
	w <- setVideoMode xres yres 32 [NoFrame]
	enableEvent SDLMouseMotion False
	setCaption "Elementary CA" "Elementary CA"
	pause w $ zip (concat $ cells (read n) seed) xys
	pause w cs = do
	delay 128
	e <- pollEvent
	case e of
	KeyUp (Keysym SDLK_ESCAPE _ _) -> return ()
	KeyUp (Keysym SDLK_SPACE _ _) -> run w cs
	_ -> pause w cs
	run w (b:bs) = do
	drawCell w b
	e <- pollEvent
	case e of
	KeyUp (Keysym SDLK_ESCAPE _ _) -> return ()
	KeyUp (Keysym SDLK_SPACE _ _) -> pause w $ b:bs
	_ -> run w bs
	drawCell w (b, (x,y)) = do
	f =<< createRGBSurface [SWSurface] unit unit 32 0 0 0 0
	when (x `mod` 73 == 0) $ SDL.flip w
	where
	rect = Just $ Rect x y unit unit
	rgb = if b == 1 then 0 else 0xFFFFFF
	f c = do fillRect c Nothing $ Pixel rgb
	blitSurface c Nothing w rect
	xys = concat . zipWith zip xs $ map repeat [0, unit..]
	where
	xs = offset $ iterate f [-299, -298.. 300]
	offset = map . map $ (+ (xres `div` 2)) . (* unit)
	f (n:ns) = enumFromTo (n-1) $ last ns + 1
	-----------------------------------------------------
	seed = take 600 . map mid . tail $ cells 30 [1]
	where
	mid xs = xs !! (length xs `div` 2)
	cells n = iterate next
	where
	next = map f . chunk . pad
	f = maybe 0 id . (`lookup` rule n)
	pad s = [0,0] ++ s ++ [0,0]
	rule = zip ns . bin
	where
	ns = map (drop 5 . bin) [7, 6..0]
	bin n = map (fromEnum . (`elem` bits n)) pows
	where
	pows = reverse $ map (2^) [0..7]
	bits 0 = []
	bits n = let x = f n in x : bits (n-x)
	where
	f n = last $ takeWhile (<= n) $ map (2^) [0..]
	chunk (a:b:c:ns) = [a,b,c] : chunk (b:c:ns)
	chunk _ = []

view raw elementary-cellular-automata.hs hosted with ❤ by GitHub