module Graphics.Gloss.Internals.Interface.Simulate
(simulateInWindow)
where
import Graphics.Gloss.Color
import Graphics.Gloss.Picture
import Graphics.Gloss.ViewPort
import Graphics.Gloss.Internals.Render.Picture
import Graphics.Gloss.Internals.Render.ViewPort
import Graphics.Gloss.Internals.Interface.Window
import Graphics.Gloss.Internals.Interface.Common.Exit
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 Graphics.Gloss.Internals.Interface.Simulate.Idle
import qualified Graphics.Gloss.Internals.Interface.Callback as Callback
import qualified Graphics.Gloss.Internals.Interface.ViewPort.ControlState as VPC
import qualified Graphics.Gloss.Internals.Interface.Simulate.State as SM
import qualified Graphics.Gloss.Internals.Interface.Animate.State as AN
import qualified Graphics.Gloss.Internals.Render.Options as RO
import qualified Graphics.UI.GLUT as GLUT
import Data.IORef
import System.Mem
simulateInWindow
:: forall world
. String
-> (Int, Int)
-> (Int, Int)
-> Color
-> Int
-> world
-> (world -> Picture)
-> (ViewPort -> Float -> world -> world)
-> IO ()
simulateInWindow
windowName
windowSize
windowPos
backgroundColor
simResolution
worldStart
worldToPicture
worldAdvance
= do
let singleStepTime = 1
stateSR <- newIORef $ SM.stateInit simResolution
worldSR <- newIORef worldStart
viewSR <- newIORef viewPortInit
viewControlSR <- newIORef VPC.stateInit
renderSR <- newIORef RO.optionsInit
animateSR <- newIORef AN.stateInit
let displayFun
= do
world <- readIORef worldSR
let picture = worldToPicture world
renderS <- readIORef renderSR
viewS <- readIORef viewSR
withViewPort
viewS
(renderPicture renderS viewS picture)
performGC
let callbacks
= [ Callback.Display (animateBegin animateSR)
, Callback.Display displayFun
, Callback.Display (animateEnd animateSR)
, Callback.Idle (callback_simulate_idle
stateSR animateSR viewSR
worldSR worldStart worldAdvance
singleStepTime)
, callback_exit ()
, callback_viewPort_keyMouse viewSR viewControlSR
, callback_viewPort_motion viewSR viewControlSR
, callback_viewPort_reshape ]
createWindow windowName windowSize windowPos backgroundColor callbacks