    module Graphics.Gloss.Internals.Interface.Animate
            (animateWithBackendIO)
    where
    import Graphics.Gloss.Data.Color
    import Graphics.Gloss.Data.Controller
    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 qualified Graphics.Gloss.Internals.Interface.Animate.State       as AN
    import qualified Graphics.Gloss.Internals.Interface.Callback            as Callback
    import Data.IORef
    import Control.Monad
    import System.Mem
    import GHC.Float (double2Float)

    animateWithBackendIO
            :: Backend a
            => a                     -- ^ Initial State of the backend
            -> Bool                  -- ^ Whether to allow the image to be panned around.
            -> Display               -- ^ Display mode.
            -> Color                 -- ^ Background color.
            -> (Float -> IO Picture) -- ^ Function to produce the next frame of animation.
                                     --     It is passed the time in seconds since the program started.
            -> (Controller -> IO ()) -- ^ Eat the controller.
            -> IO ()

    animateWithBackendIO :: forall a.
    Backend a =>
    a
    -> Bool
    -> Display
    -> Color
    -> (Float -> IO Picture)
    -> (Controller -> IO ())
    -> IO ()
    animateWithBackendIO
            a
    backend Bool
    pannable Display
    display Color
    backColor
            Float -> IO Picture
    frameOp Controller -> IO ()
    eatController
     = do
            --
            viewSR          <- ViewState -> IO (IORef ViewState)
    forall a. a -> IO (IORef a)
    newIORef ViewState
    viewStateInit
            animateSR       <- newIORef AN.stateInit
            renderS_        <- initState
            renderSR        <- newIORef renderS_

            let displayFun IORef a
    backendRef = do
                    -- extract the current time from the state
                    timeS           <- IORef State
    animateSR IORef State -> (State -> Double) -> IO Double
    forall a r. IORef a -> (a -> r) -> IO r
    `getsIORef` State -> Double
    AN.stateAnimateTime

                    -- call the user action to get the animation frame
                    picture         <- frameOp (double2Float timeS)

                    renderS         <- readIORef renderSR
                    portS           <- viewStateViewPort <$> readIORef viewSR

                    windowSize      <- getWindowDimensions backendRef

                    -- render the frame
                    displayPicture
                            windowSize
                            backColor
                            renderS
                            (viewPortScale portS)
                            (applyViewPortToPicture portS 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 a
    s -> IORef a -> IO ()
    DisplayCallback
    postRedisplay IORef a
    s)
                    , () -> Callback
    forall a. a -> Callback
    callback_exit ()
                    , IORef ViewState -> Callback
    callback_viewState_motion IORef ViewState
    viewSR
                    , Callback
    callback_viewState_reshape ]

                 [Callback] -> [Callback] -> [Callback]
    forall a. [a] -> [a] -> [a]
    ++ (if Bool
    pannable
                      then [IORef ViewState -> Callback
    callback_viewState_keyMouse IORef ViewState
    viewSR]
                      else [])

            createWindow backend display backColor callbacks
               $ \ IORef a
    backendRef
               ->  Controller -> IO ()
    eatController
                    (Controller -> IO ()) -> Controller -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Controller
                    { controllerSetRedraw :: IO ()
    controllerSetRedraw
                       = IORef a -> IO ()
    DisplayCallback
    postRedisplay IORef a
    backendRef

                    , controllerModifyViewPort :: (ViewPort -> IO ViewPort) -> IO ()
    controllerModifyViewPort
                       = \ViewPort -> IO ViewPort
    modViewPort
                         -> do viewState       <- IORef ViewState -> IO ViewState
    forall a. IORef a -> IO a
    readIORef IORef ViewState
    viewSR
                               port'           <- modViewPort $ viewStateViewPort viewState
                               let viewState'  =  ViewState
    viewState { viewStateViewPort = port' }
                               writeIORef viewSR viewState'
                               postRedisplay backendRef
                    }

    getsIORef :: IORef a -> (a -> r) -> IO r
    getsIORef :: forall a r. IORef a -> (a -> r) -> IO r
    getsIORef IORef a
    ref a -> r
    fun
     = (a -> r) -> IO a -> IO r
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM a -> r
    fun (IO a -> IO r) -> IO a -> IO r
    forall a b. (a -> b) -> a -> b
    $ IORef a -> IO a
    forall a. IORef a -> IO a
    readIORef IORef a
    ref