{-# LANGUAGE RankNTypes #-}

module Graphics.Gloss.Internals.Interface.Simulate
        (simulateWithBackendIO)
where
import Graphics.Gloss.Data.Display
import Graphics.Gloss.Data.Color
import Graphics.Gloss.Data.Picture
import Graphics.Gloss.Data.ViewPort
import Graphics.Gloss.Data.ViewState
import Graphics.Gloss.Rendering
import Graphics.Gloss.Internals.Interface.Backend
import Graphics.Gloss.Internals.Interface.Window
import Graphics.Gloss.Internals.Interface.Common.Exit
import Graphics.Gloss.Internals.Interface.ViewState.KeyMouse
import Graphics.Gloss.Internals.Interface.ViewState.Motion
import Graphics.Gloss.Internals.Interface.ViewState.Reshape
import Graphics.Gloss.Internals.Interface.Animate.Timing
import Graphics.Gloss.Internals.Interface.Simulate.Idle
import qualified Graphics.Gloss.Internals.Interface.Callback            as Callback
import qualified Graphics.Gloss.Internals.Interface.Simulate.State      as SM
import qualified Graphics.Gloss.Internals.Interface.Animate.State       as AN
import Data.IORef
import System.Mem


simulateWithBackendIO
        :: forall model a
        .  Backend a
        => a            -- ^ Initial state of the backend
        -> Display      -- ^ Display mode.
        -> Color        -- ^ Background color.
        -> Int          -- ^ Number of simulation steps to take for each second of real time.
        -> model        -- ^ The initial model.
        -> (model -> IO Picture)
                -- ^ A function to convert the model to a picture.
        -> (ViewPort -> Float -> model -> IO model)
                -- ^ A function to step the model one iteration. It is passed the
                --     current viewport and the amount of time for this simulation
                --     step (in seconds).
        -> IO ()

simulateWithBackendIO :: forall model a.
Backend a =>
a
-> Display
-> Color
-> Int
-> model
-> (model -> IO Picture)
-> (ViewPort -> Float -> model -> IO model)
-> IO ()
simulateWithBackendIO
        a
backend
        Display
display
        Color
backgroundColor
        Int
simResolution
        model
worldStart
        model -> IO Picture
worldToPicture
        ViewPort -> Float -> model -> IO model
worldAdvance
 = do
        let singleStepTime :: Float
singleStepTime      = Float
1

        -- make the simulation state
        stateSR         <- State -> IO (IORef State)
forall a. a -> IO (IORef a)
newIORef (State -> IO (IORef State)) -> State -> IO (IORef State)
forall a b. (a -> b) -> a -> b
$ Int -> State
SM.stateInit Int
simResolution

        -- make a reference to the initial world
        worldSR         <- newIORef worldStart

        -- make the initial GL view and render states
        viewSR          <- newIORef viewStateInit
        animateSR       <- newIORef AN.stateInit
        renderS_        <- initState
        renderSR        <- newIORef renderS_

        let displayFun IORef a
backendRef
             = do
                -- convert the world to a picture
                world           <- IORef model -> IO model
forall a. IORef a -> IO a
readIORef IORef model
worldSR
                port            <- viewStateViewPort <$> readIORef viewSR
                picture         <- worldToPicture world

                -- display the picture in the current view
                renderS         <- readIORef renderSR

                windowSize      <- getWindowDimensions backendRef

                -- render the frame
                displayPicture
                        windowSize
                        backgroundColor
                        renderS
                        (viewPortScale port)
                        (applyViewPortToPicture port picture)

                -- perform GC every frame to try and avoid long pauses
                performGC

        let callbacks
             =  [ DisplayCallback -> Callback
Callback.Display      (IORef State -> DisplayCallback
animateBegin IORef State
animateSR)
                , DisplayCallback -> Callback
Callback.Display      IORef a -> IO ()
DisplayCallback
displayFun
                , DisplayCallback -> Callback
Callback.Display      (IORef State -> DisplayCallback
animateEnd   IORef State
animateSR)
                , DisplayCallback -> Callback
Callback.Idle         (IORef State
-> IORef State
-> IO ViewPort
-> IORef model
-> (ViewPort -> Float -> model -> IO model)
-> Float
-> DisplayCallback
forall world.
IORef State
-> IORef State
-> IO ViewPort
-> IORef world
-> (ViewPort -> Float -> world -> IO world)
-> Float
-> DisplayCallback
callback_simulate_idle
                                                IORef State
stateSR IORef State
animateSR
                                                (ViewState -> ViewPort
viewStateViewPort (ViewState -> ViewPort) -> IO ViewState -> IO ViewPort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef ViewState -> IO ViewState
forall a. IORef a -> IO a
readIORef IORef ViewState
viewSR)
                                                IORef model
worldSR ViewPort -> Float -> model -> IO model
worldAdvance
                                                Float
singleStepTime)
                , () -> Callback
forall a. a -> Callback
callback_exit ()
                , IORef ViewState -> Callback
callback_viewState_keyMouse IORef ViewState
viewSR
                , IORef ViewState -> Callback
callback_viewState_motion   IORef ViewState
viewSR
                , Callback
callback_viewState_reshape ]

        createWindow backend display backgroundColor
                callbacks
                (const (return ()))