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