module Loop
    ( setupLoop
--    , withExits
    ) where
import SDL
import qualified Data.Text as T
import Control.Concurrent
import Control.Exception
import qualified Graphics.Rendering.OpenGL as GL
import Control.Monad
import System.Mem
import Foreign.C
import Geometry

import Preload

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

winConfig x y = defaultWindow 
    { windowGraphicsContext
        = OpenGLContext (defaultOpenGL { glProfile = Core Normal 4 3
                                       , glColorPrecision = V4 8 8 8 8
                                       } 
                        )
    , windowInitialSize = V2 x y
    , windowResizable =True
    }

--setupLoop :: String
--        -> CInt
--        -> CInt
--        -> IO setupParams
--        -> (setupParams -> IO ())
--        -> world
--        -> (setupParams -> world -> IO setupParams)
--        -> (world -> Event -> Maybe world)
--        -> (world -> Maybe world)
--        -> IO ()
setupLoop :: String
        -> CInt
        -> CInt
        -> IO (PreloadData a)
        -> (PreloadData a -> IO ())
        -> world
        -> (PreloadData a -> world -> IO (PreloadData a))
        -> (world -> Event -> Maybe world)
        -> (world -> Maybe world)
        -> IO ()
setupLoop wName xSize ySize 
            customInit initCleanup startWorld sideEffects eventFn worldFn = do 
    initializeAll
    bracket (createWindow (T.pack wName) (winConfig xSize ySize)) destroyWindow
        (\window -> 
            do bracket (glCreateContext window) (\con -> GL.finish >> glDeleteContext con)
                 (\_ -> bracket customInit initCleanup $ \setup -> do --  setup <- customInit
--                            swapInterval $= ImmediateUpdates
                            GL.blend $= GL.Enabled
                            GL.depthMask $= GL.Enabled
                            GL.blendEquation $= GL.FuncAdd
                            GL.blendFunc $= (GL.SrcAlpha,GL.OneMinusSrcAlpha)
                            GL.clearColor $= GL.Color4 0 0.5 0 1
                            GL.clearDepth $= (200)
                            doLoop setup window startWorld
                                   sideEffects eventFn worldFn
                 )
        )


--doLoop :: setupParams -> Window -> WorldView world0
--            -> (setupParams -> WorldView world0 -> IO ()) 
--            -> (world0 -> Event -> Maybe world0) 
--            -> (world0 -> Maybe world0) 
--            -> IO ()
doLoop setup window startWorld
        worldSideEffects 
        eventFn 
        worldUpdate 
  = do
    startLoopTicks <- ticks
    GL.clear [GL.ColorBuffer,GL.DepthBuffer]
    newParams <- worldSideEffects (setup & currentTime .~ startLoopTicks) startWorld
    glSwapWindow window
    endSideTicks <- ticks
    --worldSideEffects setup updatedWorld
    events <- pollEvents
    --let-- maybeUpdatedWorld :: Maybe (WorldView world0)
    --    maybeUpdatedWorld = applyEvents eventFn startWorld events worldUpdate
    maybeUpdatedWorld <- applyEventsIO eventFn startWorld events
    case maybeUpdatedWorld >>= worldUpdate of
        Just updatedWorld -> do 
            --GL.clear [GL.ColorBuffer,GL.DepthBuffer]
            --worldSideEffects setup updatedWorld
            --glSwapWindow window
            --GL.flush
            endSimTicks <- ticks
            performGC
            endLoopTicks <- ticks -- it might be better to use System.Clock (monotonic)
            let delay = max 0 (10 + fromIntegral startLoopTicks - fromIntegral endLoopTicks)
            threadDelay (delay * 1000)
            endTime <- ticks
            let newNewParams = newParams & idleTime +~ (endTime - endLoopTicks)
                                         & gcTime +~ (endLoopTicks - endSimTicks)
                                         & simTime +~ (endSimTicks - endSideTicks)
            doLoop newNewParams window updatedWorld worldSideEffects eventFn worldUpdate
        Nothing -> showTiming setup

applyEvents :: (world0 -> Event -> Maybe world0)
                -> world0 
                -> [Event]
                -> (world0 -> Maybe world0)
                -> Maybe world0
applyEvents eventFn startWorld events worldUpdate = 
    case foldM (applyH eventFn) startWorld events of
        Just w -> fmap (\w' -> w') $ worldUpdate w
        Nothing -> Nothing
    where
        applyH :: (world0 -> Event -> Maybe world0) -> world0 -> Event -> Maybe world0
        applyH f w e 
            = case eventPayload e of
                QuitEvent -> Nothing
                WindowClosedEvent _ -> Nothing
                _ -> f w e

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

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