{-# LANGUAGE OverloadedStrings #-}
module Game where

import Control.Exception.Base
import Control.DeepSeq

import System.CPUTime

import Control.Concurrent
import Control.Concurrent.MVar

import qualified Data.Matrix as M
import Cell
import qualified Control.Concurrent.Thread.Delay as Delay

--
import Data.Text (Text)
import Foreign.C.Types
import SDL.Vect
import SDL.Video.Renderer

import SDL
import Linear (V2(..), V4(..))
import Control.Monad (when, unless, forM_)
--

import Data.Word

import qualified Grid as G
import qualified Render as R

data Color = White | Black | Red | Green | Blue

encodeColor :: Color -> V4 Word8
encodeColor White = V4 255 255 255 255
encodeColor Black = V4 0   0   0   255
encodeColor Red   = V4 255 0   0   255
encodeColor Green = V4 0   255 0   255
encodeColor Blue  = V4 0   0   255 255

{- Game params. -}

cellHeight, cellWidth :: CInt
cellHeight = 60
cellWidth  = 60

gridHeight, gridWidth :: CInt
gridHeight = cellHeight * fromIntegral verticalCellsNum
gridWidth  = cellWidth  * fromIntegral horizontalCellsNum

verticalCellsNum, horizontalCellsNum :: Int
verticalCellsNum   = 6
horizontalCellsNum = 6

lineColor, aliveCellColor, deadCellColor :: Color
lineColor      = Red
aliveCellColor = Green
deadCellColor  = Blue

upperLeftX, upperLeftY :: CInt
upperLeftX = 10
upperLeftY = 10

delayTimeout :: Integer
delayTimeout = 100000


{- Game main. -}

-- Type of state.
type GridState = G.Grid
-- Type of geometry.
type GridShape = R.Grid

-- Type of color.
data GridColor
    = GridColor
    { gridColorLine      :: Color
    , gridColorCellAlive :: Color
    , gridColorCellDead  :: Color }


-- Wraps all grid related data together.

{- Note.

    Packing all necessery data makes a blob of stuff
    such that not every function it works with needs
    it. It does some encapsulation but also hides
    relationship between data. So that's a minus of
    'Grid' data type.
    
-}
data Grid
    = Grid
    { gridState :: GridState
    , gridShape :: GridShape
    , gridColor :: GridColor }
    
    
-- Makes grid.
makeGrid
    :: M.Matrix Bool
    -> (CInt, CInt)
    -> Point V2 CInt
    -> GridColor
    -> Grid
makeGrid
    stateMatrix
    (cellHeight, cellWidht)
    upperLeftCorner
    color
    = let
        state = makeState
        shape = makeShape in
            Grid state shape color
            where
                makeState = G.fromMatrix stateMatrix
                makeShape =
                    let vCellCnt = M.nrows stateMatrix
                        hCellCnt = M.ncols stateMatrix in
                          R.Grid
                            cellHeight
                            cellWidth
                            vCellCnt
                            hCellCnt
                            upperLeftCorner
                       
             
-- Updates grid.             
updateGrid :: Grid -> Grid
updateGrid (Grid state shape color) =

    -- So that's where lenses should be used for!    
    Grid (G.update state) shape color
    --   ^^^^^^^^^^^^^^^^

-- Returns coordinates of alive cells on grid.
aliveCells :: Grid -> [(Int, Int)]
aliveCells (Grid state _ _) = G.aliveCoords state
    
    
-- Returns a rectangle occupied by a grid.
gridRect :: Grid -> Rectangle CInt
gridRect (Grid _ shape _) =
    let ulCorner = R.gridULCorner shape
        -- These two must be calculated at construction time I guess.
        height   = getHeight
        width    = getWidth
        -- Result.
        in Rectangle ulCorner (V2 width height)
        where
            getHeight =
                R.gridCellHeight shape *
                    fromIntegral (R.gridCellVerNum shape)
                    
            getWidth =
                R.gridCellWidth  shape *
                    fromIntegral (R.gridCellHorNum shape)

-- Renders lines of grid.
renderGridLines :: Grid -> Renderer -> IO ()
renderGridLines (Grid _ shape color) renderer =
    do
        -- Get line color.
        let lnColor = gridColorLine color
        
        -- Draw lines.
        R.drawGrid shape (encodeColor lnColor) renderer
        
-- Renders background of grid.
renderGridBackground :: Grid -> Renderer -> IO ()
renderGridBackground g r =
    do
        -- Get color of dead cell.
        let deadCellColor = gridColorCellDead $ gridColor g
        
        -- Set color for drawing.
        rendererDrawColor r $= encodeColor deadCellColor
        
        -- Fill background.
        fillRect r $ Just $ gridRect g
        
-- Renders alive cells of grid.
renderGridAliveCells :: Grid -> Renderer -> IO ()
renderGridAliveCells g r =
    do
        -- Get color of alive cell.
        let aliveCellColor = gridColorCellAlive $ gridColor g
        
        -- Set color for drawing.
        rendererDrawColor r $= encodeColor aliveCellColor
        
        -- Get coordinates of alive cells.
        let aliveCoords = aliveCells g
        
        -- Get shape of a grid.
        let shape = gridShape g
        
        -- Fill each alive cell.
        forM_ aliveCoords $
            \ coords ->
                R.fillCell coords shape r
        
-- Renders grid.
renderGrid :: Grid -> Renderer -> IO ()
renderGrid grid renderer
    = do
    
        -- Background.
        renderGridBackground grid renderer
        -- Lines.
        renderGridLines      grid renderer
        -- Alive cells.
        renderGridAliveCells grid renderer

    
    
{- Running. -}
    
-- Initial state for test.
initGrid' :: M.Matrix Bool
initGrid' = M.fromLists
    [[True,  False, False, False, False, True]
    ,[False, True,  False, True,  False, True]
    ,[False, False, False, False, True,  True]
    ,[False, False, True,  True,  False, False]
    ,[True,  True,  False, True,  True,  False]
    ,[False, True,  True,  False, False, True]]

-- Initial grid for test.
initGrid :: Grid
initGrid =
    makeGrid
        initGrid'
            (cellHeight, cellWidth)
                (P (V2 upperLeftX upperLeftY))
                    (GridColor Black Black White)

-- Runs test game.
runGame :: IO ()
runGame = do
  initializeAll
  window <- createWindow "Game of Life" defaultWindow
  renderer <- createRenderer window (-1) defaultRenderer
  
  -- Render at first iteration.
  gameLoop initGrid renderer 0 renderTimeout
    

{-

    NOTE:
    
        It's not possible to collect events in separate thread.
        It's better to present a renderer until some timer and
        to collect events the rest time.

-}

-- Collects events into variable.
collectEvents :: MVar [Event] -> IO ()
collectEvents eventListVar = do

    putStrLn "Collecting events..."

    putStrLn "pollEvents"
    -- Get new events.
    newEventList <- pollEvents
    print newEventList
    
    putStrLn "putMVar"
    -- Put them into variable.
    --putMVar eventListVar newEventList
    swapMVar eventListVar newEventList
    putStrLn "delay"
    -- Wait until timeout.
    Delay.delay collectEventsTimeout
    
    putStrLn "Collecting events... finished."
    
    -- Repeat.
    collectEvents eventListVar
    where
        -- Timeout to wait until check for new events.
        collectEventsTimeout = 100
    
renderTimeout :: Integer
renderTimeout = 500000000000000000

renderingTime :: Integer
renderingTime = 10000000000000
    
-- Test game loop.
gameLoop :: Grid -> Renderer -> Int -> Integer -> IO ()
gameLoop g r counter timer = do

  -- Checks whether 'q' key was pressed.
  events <- pollEvents
  let eventIsQPress event =
        case eventPayload event of
          KeyboardEvent keyboardEvent ->
            keyboardEventKeyMotion keyboardEvent == Pressed &&
            keysymKeycode (keyboardEventKeysym keyboardEvent) == KeycodeQ
          _ -> False
      qPressed = not (null (filter eventIsQPress events))
  
  unless qPressed $ do 
  
      -- Get time increment.
      timerInc <- getCPUTime
      
      -- Calculate a new timer value.
      let timer' = timer + timerInc
      
      -- If timer' is equal or greater then renderTimeout,
      -- then render and drop timer to zero.
      if timer' >= renderTimeout
        then do
            
              -- Start time of rendering.
              timeStart <- (getCPUTime >>= evaluate)
            
              -- Set background color.
              rendererDrawColor r $= V4 255 255 255 255
              
              -- Fill background.
              clear r >>= evaluate . rnf
              
              -- Render grid.
              renderGrid g r >>= evaluate . rnf
              
              -- Flush graphics.
              present r >>= evaluate . rnf
              
              -- Update grid.
              let g' = updateGrid g
              
              -- Finish time of rendering.
              timeStop <- (getCPUTime >>= evaluate)
              
              -- Total rendering time.
              let timeTotal = timeStop - timeStart
              
              when (timeTotal < renderingTime) $
                do
                  -- Time left.
                  let timeLeft = renderingTime - timeTotal
                  return ()
                  -- Sleep time which left.
                  -- Delay.delay timeLeft
                  -- putStrLn $ "Time left: " ++ show timeLeft
              
              
              -- Show the relation between renderingTime and timeTotal.
              putStr "renderingTime : timeTotal | "
              putStr $ show renderingTime
              putStr " : "
              putStr $ show timeTotal
              putStrLn ""
                  
              -- Continue with zero timer.
              gameLoop g' r (counter + 1) 0
              
              
      
      -- Wait until timeout.
      -- Delay.delay delayTimeout
      
        else gameLoop g r (counter + 1) timer'
          
