{- |
Module      : Loop
Description : Minimal 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 Foreign.C
import SDL
import qualified Graphics.Rendering.OpenGL as GL

import Control.Lens ((.~),(&),(+~))

-- | Create a game loop with an SDL window.
setupLoop
    :: (Int,Int)            -- ^ The window size.
    -> IO params            -- ^ Initial parameters.
    -> (params -> IO ())    -- ^ Function for cleaning up parameters, applied when exiting loop.
    -> IO world             -- ^ Initial simulation state.
    -> (params -> world -> IO params)   -- ^ Parameter update, called once per frame. Allows for side effects such as rendering.
    -> (world -> Event -> Maybe world)
                            -- ^ SDL Event handling, once per frame. Evaluating 'Nothing' exits the loop.
    -> (world -> Maybe world)
                            -- ^ Simulation update, once per frame. 'Nothing' exits the loop.
    -> IO ()
setupLoop 
    (xSize,ySize)
    initParams 
    paramCleanup 
    ioStartWorld 
    sideEffects 
    eventFn 
    worldFn = do 
        startWorld <- ioStartWorld
        initializeAll
        bracket 
            (createWindow (T.pack "A Minimal Game Loop") (winConfig xSize ySize)) 
            destroyWindow 
            $ \window -> bracket 
                (glCreateContext window) 
                ( \con -> GL.finish >> glDeleteContext con)
                $ \_   -> bracket 
                    initParams 
                    paramCleanup 
                    $ doLoop window startWorld sideEffects eventFn worldFn

-- | The internal loop.
doLoop 
    :: Window   -- ^ The SDL window.
    -> world    -- ^ Current simulation state.
    -> (params -> world -> IO params) -- ^ Parameter update. 
    -> (world -> Event -> Maybe world) -- ^ SDL Event handling.
    -> (world -> Maybe world) -- ^ Simulation update
    -> params -- ^ Current parameters.
    -> IO ()
doLoop 
    window 
    startWorld
    worldSideEffects 
    eventFn 
    worldUpdate 
    startParams 
  = do
    startTicks <- ticks
    newParams <- worldSideEffects startParams startWorld
    glSwapWindow window
    events <- pollEvents
    maybeUpdatedWorld <- foldM (applyEventIO eventFn) (Just startWorld) events
    case maybeUpdatedWorld >>= worldUpdate of
        Just updatedWorld -> do 
            performGC
            endTicks <- ticks -- it might be better to use System.Clock (monotonic)

            let delay = max 0 (20 + fromIntegral startTicks - fromIntegral endTicks)
            threadDelay (delay * 1000 )

            doLoop window updatedWorld worldSideEffects eventFn worldUpdate newParams
        Nothing -> return ()

applyEventsIO 
    :: (world -> Event -> Maybe world)
    -> world
    -> [Event]
    -> IO (Maybe world)
applyEventsIO fn w = foldM (applyEventIO fn) (Just w)

-- | 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 -> 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) >> return (mw >>= \w -> fn w e)
    _                   -> return $ mw >>= flip fn e

-- | Create an OpenGL SDL window configuration with a given x and y size.
winConfig :: Int -> Int -> WindowConfig
winConfig x y = defaultWindow 
    { windowGraphicsContext
        = OpenGLContext (defaultOpenGL { glProfile = Core Normal 4 3
                                       , glColorPrecision = V4 8 8 8 8
                                       } 
                        )
    , windowInitialSize = V2 (fromIntegral x) (fromIntegral y)
    , windowResizable =True
    }