--{-# LANGUAGE TupleSections #-}
{- |
Module      : Loop
Description : Simple game loop

This module sets up an SDL window which may be updated using a simple game loop.
-}
module Loop
    ( setupLoop
    ) where
import qualified Data.Text as T
import Control.Concurrent
import Control.Exception
import Control.Monad
import System.Mem
import SDL
import qualified Graphics.Rendering.OpenGL as GL
-- | Create a game loop with an SDL window.
setupLoop
    :: Int                  -- ^ Target seconds per frame
    -> T.Text               -- ^ Window title
    -> WindowConfig
    -> (world -> IO ())    -- ^ Function for cleaning up parameters, applied when exiting loop.
    -> IO world             -- ^ Initial simulation state.
    -> (world -> IO world)   -- ^ update, called once per frame. Allows for side effects such as rendering.
    -> (world -> Event -> IO (Maybe world))
                            -- ^ SDL Event handling, once per frame. Evaluating 'Nothing' exits the loop.
    -> IO ()
setupLoop spf title winconfig paramCleanup ioStartWorld sideEffects eventFn = do 
    initializeAll
    bracket 
        (createWindow title winconfig) 
        destroyWindow 
        $ \window -> bracket 
            (glCreateContext window) 
            ( \con -> GL.finish >> glDeleteContext con)
            $ \_   -> bracket 
                ioStartWorld
                paramCleanup 
                (doLoop spf window sideEffects eventFn)
-- | The internal loop.
doLoop
    :: Int      -- ^ target msec per frame
    -> Window   -- ^ The SDL window.
    -> (world -> IO world) -- ^ simulation update. 
    -> (world -> Event -> IO (Maybe world)) -- ^ SDL Event handling.
    -> world    -- ^ Current simulation state.
    -> IO ()
doLoop spf window worldSideEffects eventFn startWorld = do
    startTicks <- ticks
    worldAfterSimStep <- worldSideEffects startWorld
    glSwapWindow window
    maybeUpdatedWorld <- pollEvents >>= foldM (applyEventIO eventFn) (Just worldAfterSimStep)
    case maybeUpdatedWorld of
        Just updatedWorld -> do 
            performGC
            endTicks <- ticks -- it might be better to use System.Clock (monotonic)

            let theDelay = max 0 (spf + fromIntegral startTicks - fromIntegral endTicks)
            threadDelay (theDelay * 1000 )

            doLoop spf window worldSideEffects eventFn updatedWorld
        Nothing -> return ()

-- | Handle quit events in a manner to exit the loop. Other events handled as
-- determined by the custom function, although resize events also change the viewport.
applyEventIO :: (world -> Event -> IO (Maybe world)) -> Maybe world -> Event -> IO (Maybe world)
applyEventIO fn mw e = case eventPayload e of
    QuitEvent           -> return Nothing
    WindowClosedEvent _ -> return Nothing
    WindowSizeChangedEvent WindowSizeChangedEventData {windowSizeChangedEventSize = V2 x y}
                        -> (GL.viewport $= (GL.Position 0 0,GL.Size x y)) >> mupdate
    _                   -> mupdate
  where
    mupdate = case mw of
        Nothing -> return Nothing
        Just w  -> fn w e