    {-# 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
    import Data.Functor

    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
            backend
            display
            backgroundColor
            simResolution
            worldStart
            worldToPicture
            worldAdvance
     = do
            let singleStepTime      = 1

            -- make the simulation state
            stateSR         <- newIORef $ SM.stateInit 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 backendRef
                 = do
                    -- convert the world to a picture
                    world           <- readIORef 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
                 =  [ Callback.Display      (animateBegin animateSR)
                    , Callback.Display      displayFun
                    , Callback.Display      (animateEnd   animateSR)
                    , Callback.Idle         (callback_simulate_idle
                                                    stateSR animateSR
                                                    (viewStateViewPort <$> readIORef viewSR)
                                                    worldSR worldAdvance
                                                    singleStepTime)
                    , callback_exit ()
                    , callback_viewState_keyMouse viewSR
                    , callback_viewState_motion   viewSR
                    , callback_viewState_reshape ]

            createWindow backend display backgroundColor callbacks