{-# OPTIONS_GHC -funbox-strict-fields -fglasgow-exts #-}
module Main where

import Graphics.UI.GLUT
import Data.Word
import Data.Array.Unboxed
import Data.Array.IArray
import Data.IORef
import System.Exit
import System.Random
import System.Environment

point :: Double -> Double -> Vertex2 GLdouble
point x y = (Vertex2 x y)

col :: Double -> Double -> Double -> IO ()
col x y z = color $ Color3 x y z

drawBlock :: Int -- ^ Size of the Canvas (example 2)
          -> Int -- ^ Half of the size of the part of the automaton displayed (typically will be 15)
          -> Int -- ^ Vertical position
          -> Int -- ^ Horizontal position
          -> IO ()
drawBlock area s i j = rect (point x y) (point (x + d) (y + d))
      where
        y = -(fromIntegral area)/2 + (fromIntegral area)/(fromIntegral (2*s+1)) * (fromIntegral i)
        x = -(fromIntegral area)/2 + (fromIntegral area)/(fromIntegral (2*s+1)) * (fromIntegral j)
        d = min 0.05 ((fromIntegral area)/(fromIntegral (2*s+1)))
        

data Automaton = A !Int !(UArray Int Word8)

(##) :: Automaton -> (Int , Int) -> Word8
(A size a) ## (i,j) = if (i>=0) && (j>=0) && (i < 2*size+1) && (j < 2*size+1) then a ! (i*(2*size+1)+j) else 0

life :: Automaton -> (Int , Int) -> Word8
life a (i, j)  = 
             let a1 = a ## (i-1,j-1) 
                 a2 = a ## (i-1,j) 
                 a3 = a ## (i-1,j+1) 
                 b1 = a ## (i,j-1) 
                 b2 = a ## (i,j) 
                 b3 = a ## (i,j+1) 
                 c1 = a ## (i+1,j-1) 
                 c2 = a ## (i+1,j) 
                 c3 = a ## (i+1,j+1) 
                 t = a1+a2+a3+b1+b3+c1+c2+c3 
                 in
                 if ((b2 == 0) && (t == 3)) || ((b2 == 1) && ((t == 2) || (t == 3))) then 1 else 0
 
evolve :: Automaton -> Automaton
evolve a@(A s m) = A s (listArray (0,(2*s+1)*(2*s+1)-1) . map (life a) $ [(i,j) | i <- [0..2*s], j <- [0..2*s]])

createAuto :: Int -> [Word8] -> Automaton
createAuto size l = A size (listArray (0,(2*size+1)*(2*size+1)-1) l)

draw :: Automaton -> IO ()
draw (A size m) = do
  mapM_ drawIfNotDead . zip [(i,j) | i <- [0..2*size], j <- [0..2*size]] $ (elems m) where
  drawIfNotDead ((i,j),a) | a /= 0 = drawBlock 2 size i j
                          | otherwise = return ()

quit :: Key -> KeyState -> Modifiers -> Position -> IO ()
quit (Char 'q') _ _ _ = exitWith ExitSuccess >> return ()
quit _ _ _ _ = return ()

drawCell :: IORef (Automaton) -> Window -> DisplayCallback 
drawCell cell w = do
  clear [ColorBuffer]
  u <- readIORef cell
  draw u
  cell $= (evolve u)
  swapBuffers  
  
readSize :: [String] -> Int
readSize [] = 50
readSize (a:_) = let r = read a :: Int in
  if r > 200 
      then 200 
      else if r < 10
          then 10
          else r

main :: IO ()
main = do
  m <- getArgs
  let hwidth = readSize m
  (name,args) <- getArgsAndInitialize 
  initialWindowSize $= Size 400 400
  initialDisplayMode $= [DoubleBuffered]
  w <- createWindow "Main"
  keyboardMouseCallback  $= Just quit
  let l = map fromInteger . randomRs (0,1) . mkStdGen $ 0
  cell <- newIORef (createAuto hwidth l)
  clearColor $= (Color4 238 238 238 0)
  col 0 0 1
  loadIdentity
  displayCallback $= drawCell cell w
  idleCallback $= Just (postRedisplay (Just w))
  mainLoop