--{-# 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
    -> (Int,Int)            -- ^ The window size.
    -> Maybe (Int,Int)            -- ^ The window position.
    -> (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 (xSize,ySize) winpos paramCleanup ioStartWorld sideEffects eventFn = do 
    initializeAll
    bracket 
        (createWindow (T.pack "Simple Game Loop") (winConfig xSize ySize winpos)) 
        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
    events <- pollEvents
    maybeUpdatedWorld <- foldM (applyEventIO eventFn) (Just worldAfterSimStep) events
    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
-- | Create an OpenGL SDL window configuration with a given x and y size.
winConfig :: Int -> Int -> Maybe (Int, Int) -> WindowConfig
winConfig x y winpos = defaultWindow 
    { windowGraphicsContext = OpenGLContext $ defaultOpenGL 
        { glProfile = Core Normal 4 3
        , glColorPrecision = V4 8 8 8 8
        } 
    , windowPosition = theWinPos
    , windowInitialSize = V2 (fromIntegral x) (fromIntegral y)
    , windowResizable =True
    }
  where
    theWinPos = case winpos of
        Just (px,py) -> Absolute (P (V2 (fromIntegral px) (fromIntegral py)))
        Nothing      -> Wherever