module Lambency.GameLoop (
  GameLoopState, mkLoopState,
  GameLoopConfig, mkLoopConfig,
  runGameLoop
  ) where

--------------------------------------------------------------------------------
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.RWS.Strict
import qualified Control.Wire as W

import qualified Graphics.UI.GLFW as GLFW
import qualified Graphics.Rendering.OpenGL as GL
import Data.Time

import FRP.Netwire.Input.GLFW

import Lambency.ResourceLoader
import Lambency.Sound
import Lambency.Sprite
import Lambency.Texture
import Lambency.Types
import Lambency.GameSession

import System.CPUTime

import Linear
--------------------------------------------------------------------------------

maximumFramerate :: NominalDiffTime
maximumFramerate = fromRational . toRational $ (1.0 / 10.0 :: Double)

-- When we handle actions, only really print logs and play any sounds
-- that may need to start or stop.
handleAction :: OutputAction -> IO ()
handleAction (SoundAction sound cmd) = handleCommand sound cmd
handleAction (LogAction s) = putStrLn s
handleAction (WireframeAction True) = GL.polygonMode GL.$= (GL.Line, GL.Line)
handleAction (WireframeAction False) = GL.polygonMode GL.$= (GL.Fill, GL.Fill)

step :: a -> Game a -> TimeStep ->
        GameMonad (Maybe a, Camera, [Light], Game a)
step go game t = do
  (Right cam, nCamWire) <-
    W.stepWire (getContinuousWire $ mainCamera game) t (Right ())
  (lights, lwires) <-
    collect <$>
    mapM (\w -> W.stepWire w t $ Right ()) (getContinuousWire <$> dynamicLights game)
  (Right result, gameWire) <-
    W.stepWire (getContinuousWire $ gameLogic game) t (Right go)
  case result of
    Nothing -> return (result, cam, lights, newGame nCamWire lwires W.mkEmpty)
    Just x  -> return (x `seq` result, cam, lights, newGame nCamWire lwires gameWire)
  where
    collect :: [(Either e b, GameWire a b)] -> ([b], [GameWire a b])
    collect [] = ([], [])
    collect ((Left _, _) : _) = error "Internal -- Light wire inhibited?"
    collect ((Right obj, wire) : rest) = (obj : objs, wire : wires)
      where
        (objs, wires) = collect rest

    newGame cam lights logic =
      Game { mainCamera = CW cam
           , dynamicLights = CW <$> lights
           , gameLogic = CW logic
           }

data GameLoopConfig = GameLoopConfig {
  gameRenderer :: Renderer,
  simpleQuadSprite :: Sprite,
  glfwInputControl :: Maybe GLFWInputControl,
  windowDimensions :: V2 Int
}

mkLoopConfig :: Renderer -> Maybe GLFW.Window -> IO (GameLoopConfig, IO ())
mkLoopConfig r win' = do
  -- !FIXME! Use fully opaque 'mask' texture that we can change the color and
  -- size for dynamically. This isn't the best way to do this, but it'll work.
  (sprite, unloadSprite) <-
    runResourceLoader r $ createSolidTexture (pure 255)
                      >>= loadStaticSpriteWithMask

  -- Collect the window dimensions. TODO: This should be done every frame so
  -- that we can properly update our UI on state changes. For now, we just tell
  -- GLFW to prevent the user from resizing the window, but that need not be a
  -- restriction.
  (winDims, ictl) <- case win' of
    Just win -> do
      winDims <- uncurry V2 <$> liftIO (GLFW.getWindowSize win)
      ictl <- Just <$> mkInputControl win
      return (winDims, ictl)
    Nothing -> return (V2 0 0, Nothing)

  return (GameLoopConfig r sprite ictl winDims, unloadSprite)

data GameLoopState a = GameLoopState {
  currentGameValue :: a,
  currentGameLogic :: Game a,
  currentGameSession :: GameSession,
  currentPhysicsAccum :: NominalDiffTime,
  lastFramePicoseconds :: Integer
}

mkLoopState :: a -> Game a -> GameLoopState a
mkLoopState initialVal initGame = GameLoopState
    { currentGameValue = initialVal
    , currentGameLogic = initGame
    , currentGameSession = mkGameSession
    , currentPhysicsAccum = toEnum 0
    , lastFramePicoseconds = 0
    }

type GameLoopM a = ReaderT GameLoopConfig (StateT (GameLoopState a) IO)

runLoop :: UTCTime -> GameLoopM a ()
runLoop prevFrameTime = do
  (GameLoopState _ _ _ accumulator _) <- get
  -- Step
  thisFrameTime <- liftIO getCurrentTime
  let newAccum = accumulator + (diffUTCTime thisFrameTime prevFrameTime)
  modify $ \ls -> ls { currentPhysicsAccum = min newAccum maximumFramerate }
  (go, (nextsession, accum), nextGame) <- stepGame

  case go of
    Just gobj -> do
      ls <- get
      put $ GameLoopState gobj nextGame nextsession accum (lastFramePicoseconds ls)
      runLoop thisFrameTime
    Nothing -> return ()

runGameLoop :: GameLoopState a -> GameLoopConfig -> IO ()
runGameLoop st config = do
  curTime <- getCurrentTime
  evalStateT (runReaderT (runLoop curTime) config) st

type TimeStepper = (GameSession, NominalDiffTime)

stepGame :: GameLoopM a (Maybe a, TimeStepper, Game a)
stepGame = do
  (GameLoopState go game session accum _) <- get
  if (accum < physicsDeltaUTC)
    then return (Just go, (session, accum), game)
    else runGame

runGame :: GameLoopM a (Maybe a, TimeStepper, Game a)
runGame = do
  gameLoopConfig <- ask
  gls <- get
  (hasInput, ipt) <- liftIO $ case glfwInputControl gameLoopConfig of
    Just glfwIpt -> getInput glfwIpt >>= (\x -> return (True, x))
    Nothing -> return (False, emptyGLFWState)

  -- Retreive the next time step from our game session
  (ts, nextSess) <- liftIO $ W.stepSession (currentGameSession gls)

  let
    -- The game step is the complete GameMonad computation that
    -- produces four values: Either inhibition or a new game value
    -- A new camera, a list of dynamic lights, and the next simulation
    -- wire
    gameStep = step (currentGameValue gls) (currentGameLogic gls) ts

    -- We need to render if we're going to fall below the physics threshold
    -- on the next frame. This simulates a while loop. If we don't fall
    -- through this threshold, we will perform another physics step before
    -- we finally decide to render.
    accum = currentPhysicsAccum gls

    winDims = windowDimensions gameLoopConfig
    renderTime = lastFramePicoseconds gls
    sprite = simpleQuadSprite gameLoopConfig
    frameConfig = GameConfig (gameRenderer gameLoopConfig) renderTime winDims sprite

  -- This is the meat of the step routine. This calls runRWS on the
  -- main game wire, and uses the results to figure out what needs
  -- to be done.
  ((result, cam, lights, nextGame), newIpt, (actions, renderActs)) <-
      liftIO $ runRWST (nextFrame gameStep) frameConfig ipt

  -- The ReaderT RenderConfig IO program that will do the actual rendering
  let accumRemainder = accum - physicsDeltaUTC
      needsRender = case result of
        Nothing -> False
        Just _ -> accumRemainder < physicsDeltaUTC

  frameTime <-
    if needsRender
    then liftIO $ do
      t <- getCPUTime
      render (gameRenderer gameLoopConfig) lights cam renderActs
      t' <- getCPUTime
      return (t' - t)
    else return renderTime

  _ <- liftIO $ do
    -- Actually do the associated actions
    mapM_ handleAction actions

    -- Poll the input
    when hasInput $ case glfwInputControl gameLoopConfig of
      Just glfwIpt -> pollGLFW newIpt glfwIpt >> return ()
      Nothing -> return ()

  -- If our main wire inhibited, return immediately.
  case result of
    Just obj -> do
      put $ GameLoopState obj nextGame nextSess accumRemainder frameTime
      stepGame
    Nothing -> return (result, (nextSess, accum), nextGame)
