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
-> Bool
-> Display
-> Color
-> (Float -> IO Picture)
-> (Controller -> IO ())
-> IO ()
animateWithBackendIO :: 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
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 IORef a
backendRef = do
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
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
(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)
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 (\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
$ \ 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
= \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 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