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

            let displayFun :: IORef a -> IO ()
    displayFun backendRef :: IORef a
    backendRef = do
                    -- extract the current time from the state
                    Double
    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
    picture         <- Float -> IO Picture
    frameOp (Double -> Float
    double2Float Double
    timeS)

                    State
    renderS         <- IORef State -> IO State
    forall a. IORef a -> IO a
    readIORef IORef State
    renderSR
                    ViewPort
    portS           <- 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

                    (Int, Int)
    windowSize      <- IORef a -> IO (Int, Int)
    forall a. Backend a => IORef a -> IO (Int, Int)
    getWindowDimensions IORef a
    backendRef

                    -- render the frame
                    (Int, Int) -> Color -> State -> Float -> Picture -> IO ()
    displayPicture
                            (Int, Int)
    windowSize
                            Color
    backColor
                            State
    renderS
                            (ViewPort -> Float
    viewPortScale ViewPort
    portS)
                            (ViewPort -> Picture -> Picture
    applyViewPortToPicture ViewPort
    portS Picture
    picture)

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

            let callbacks :: [Callback]
    callbacks
                 =  [ DisplayCallback -> Callback
    Callback.Display      (IORef State -> DisplayCallback
    animateBegin IORef State
    animateSR)
                    , DisplayCallback -> Callback
    Callback.Display      DisplayCallback
    displayFun
                    , DisplayCallback -> Callback
    Callback.Display      (IORef State -> DisplayCallback
    animateEnd   IORef State
    animateSR)
                    , DisplayCallback -> Callback
    Callback.Idle         (\s :: 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 [])

            a -> Display -> Color -> [Callback] -> (IORef a -> IO ()) -> IO ()
    forall a.
    Backend a =>
    a -> Display -> Color -> [Callback] -> (IORef a -> IO ()) -> IO ()
    createWindow a
    backend Display
    display Color
    backColor [Callback]
    callbacks
               ((IORef a -> IO ()) -> IO ()) -> (IORef a -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \ backendRef :: IORef a
    backendRef
               ->  Controller -> IO ()
    eatController
                    (Controller -> IO ()) -> Controller -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Controller :: IO () -> ((ViewPort -> IO ViewPort) -> IO ()) -> Controller
    Controller
                    { controllerSetRedraw :: IO ()
    controllerSetRedraw
                       = IORef a -> IO ()
    DisplayCallback
    postRedisplay IORef a
    backendRef

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

    getsIORef :: IORef a -> (a -> r) -> IO r
    getsIORef :: IORef a -> (a -> r) -> IO r
    getsIORef ref :: IORef a
    ref fun :: 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