module Graphics.Gloss.Internals.Interface.Animate
( animateInWindow
, animateInWindowWithBackend)
where
import Graphics.Gloss.Data.Color
import Graphics.Gloss.Data.Picture
import Graphics.Gloss.Internals.Render.Picture
import Graphics.Gloss.Internals.Render.ViewPort
import Graphics.Gloss.Internals.Interface.Backend
import Graphics.Gloss.Internals.Interface.Window
import Graphics.Gloss.Internals.Interface.Common.Exit
import Graphics.Gloss.Internals.Interface.ViewPort
import Graphics.Gloss.Internals.Interface.ViewPort.KeyMouse
import Graphics.Gloss.Internals.Interface.ViewPort.Motion
import Graphics.Gloss.Internals.Interface.ViewPort.Reshape
import Graphics.Gloss.Internals.Interface.Animate.Timing
import qualified Graphics.Gloss.Internals.Render.State as RS
import qualified Graphics.Gloss.Internals.Interface.ViewPort.ControlState as VPC
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)
animateInWindow
:: String
-> (Int, Int)
-> (Int, Int)
-> Color
-> (Float -> Picture)
-> IO ()
animateInWindow
= animateInWindowWithBackend defaultBackendState
animateInWindowWithBackend
:: Backend a
=> a
-> String
-> (Int, Int)
-> (Int, Int)
-> Color
-> (Float -> Picture)
-> IO ()
animateInWindowWithBackend backend name size pos backColor frameFun
= do
viewSR <- newIORef viewPortInit
viewControlSR <- newIORef VPC.stateInit
animateSR <- newIORef AN.stateInit
renderS_ <- RS.stateInit
renderSR <- newIORef renderS_
let displayFun backendRef = do
timeS <- animateSR `getsIORef` AN.stateAnimateTime
let picture = frameFun (double2Float timeS)
renderS <- readIORef renderSR
viewS <- readIORef viewSR
withViewPort
backendRef
viewS
(renderPicture backendRef renderS viewS picture)
performGC
let callbacks
= [ Callback.Display (animateBegin animateSR)
, Callback.Display displayFun
, Callback.Display (animateEnd animateSR)
, Callback.Idle (\s -> postRedisplay s)
, callback_exit ()
, callback_viewPort_keyMouse viewSR viewControlSR
, callback_viewPort_motion viewSR viewControlSR
, callback_viewPort_reshape ]
createWindow backend name size pos backColor callbacks
getsIORef :: IORef a -> (a -> r) -> IO r
getsIORef ref fun
= liftM fun $ readIORef ref