module Main where

import Control.Arrow hiding (left, right)
import Control.Monad (when)
import Data.IORef  ( IORef, newIORef, readIORef, modifyIORef )

import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT

import GraphLife
import Random

main = do
   (progName, args) <- getArgsAndInitialize
   let [w, h] = map read args
   initialDisplayMode $= [DoubleBuffered, RGBMode]
   initialWindowSize $= Size 500 500
   createWindow progName
   reshapeCallback $= Just reshape
   installField (w,h)
   mainLoop

installField (w,h) = do
  gen <- newStdGen
  fieldRef <- newIORef $ buildRandomTorus evalLife w h gen
  displayCallback $= display (w,h) fieldRef
  initGLState (w,h)
  every 0 $ do
    modifyIORef fieldRef future
    postRedisplay Nothing    

display (w, h) fieldRef = do
   clear [ColorBuffer]
   field <- readIORef fieldRef
   mapM_ (mapM_ drawCell . walk first right w) . walk second down h 
     $ ((0,0), field)
   swapBuffers
  where drawCell (p, c) = when (value c) (blockAt p)

reshape s = do
   viewport $= (Position 0 0, s)

initGLState (gw, gh) = do
  shadeModel $= Flat
  matrixMode $= Projection
  loadIdentity
  ortho 0 1 0 1 (-1) 1
  matrixMode $= Modelview 0
  loadIdentity
  scale (1 / (fromIntegral gw)) (1 / (fromIntegral gh)) (1 :: GLdouble)


blockAt (i, j) = rect (Vertex2 i' j')
                      (Vertex2 (i'+1) (j'+1))
  where i' = fromIntegral i :: GLfloat
        j' = fromIntegral j :: GLfloat

every interval a = addTimerCallback interval (a >> every interval a)

walk :: Enum c => ((c -> c) -> p -> p) ->   -- coordinate stepper
                  (Cell v n -> Cell v n) -> -- grid direction
                  Int ->                    -- how many
                  (p, Cell v n) ->          -- initial cell
                  [(p, Cell v n)]           -- cells in a line
walk acc dir count = take count . iterate (acc succ *** dir)