langton's ant

For a round of code golf, I wrote this spare implementation of Chris Langton's remarkably simple universal computer. If you want amenities like pause, random starting pattern or even quit, check out this more complete version.

	import Control.Arrow ((***))
	import Control.Monad (when, join)
	import Data.Set (insert, delete, member, empty)
	import Graphics.UI.SDL as SDL
	(xres, yres, sq) = (1366, 768, 4)
	main = withInit [InitVideo] $ do
	w <- setVideoMode xres yres 32 [NoFrame]
	enableEvent SDLMouseMotion False
	setCaption "Langton's Ant" "Langton's Ant"
	run w [1..] p (0,1) empty
	where
	p = (xres `div` 2 `div` sq, yres `div` 2 `div` sq)
	run w (n:ns) p v ps = do
	when (n `mod` 7 == 0) render
	run w ns (move p $ g v) (g v) $ f p ps
	where
	b = member p ps
	(f,g) = if b then (delete, fl) else (insert, fr)
	fr (x,y) = if x == 0 then (-y,x) else (y,x)
	fl (x,y) = if x == 0 then (y,x) else (y,-x)
	move (x,y) = (x+) *** (+y)
	render = do
	fillRect w (Just $ Rect 0 0 xres yres) $ Pixel 0
	mapM_ (draw w . join (***) (* sq)) ps
	SDL.flip w
	draw w p = f p =<< g [SWSurface] sq sq 32 0 0 0 0
	where
	rect x y = Just $ Rect x y sq sq
	g = createRGBSurface
	f (x,y) s = do fillRect s (rect 0 0) $ Pixel 0xFFFFFF
	blitSurface s (rect 0 0) w $ rect x y

view raw langton_ant.hs hosted with ❤ by GitHub