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