module Graphics.Gloss.Internals.Interface.Game
( gameInWindow
, Event(..))
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.Window
import Graphics.Gloss.Internals.Interface.Callback
import Graphics.Gloss.Internals.Interface.Common.Exit
import Graphics.Gloss.Internals.Interface.ViewPort
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.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 qualified Graphics.Rendering.OpenGL.GL as GL
import Data.IORef
import System.Mem
data Event
= EventKey GLUT.Key GLUT.KeyState GLUT.Modifiers (Float, Float)
| EventMotion (Float, Float)
deriving (Eq, Show)
gameInWindow
:: forall world
. String
-> (Int, Int)
-> (Int, Int)
-> Color
-> Int
-> world
-> (world -> Picture)
-> (Event -> world -> world)
-> (Float -> world -> world)
-> IO ()
gameInWindow
windowName
windowSize
windowPos
backgroundColor
simResolution
worldStart
worldToPicture
worldHandleEvent
worldAdvance
= do
let singleStepTime = 1
stateSR <- newIORef $ SM.stateInit simResolution
worldSR <- newIORef worldStart
viewSR <- newIORef viewPortInit
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_keyMouse worldSR viewSR worldHandleEvent
, callback_motion worldSR worldHandleEvent
, callback_viewPort_reshape ]
createWindow windowName windowSize windowPos backgroundColor callbacks
callback_keyMouse
:: IORef world
-> IORef ViewPort
-> (Event -> world -> world)
-> Callback
callback_keyMouse worldRef viewRef eventFn
= KeyMouse (handle_keyMouse worldRef viewRef eventFn)
handle_keyMouse
:: IORef a
-> t
-> (Event -> a -> a)
-> GLUT.Key
-> GLUT.KeyState
-> GLUT.Modifiers
-> GL.Position
-> IO ()
handle_keyMouse worldRef _ eventFn key keyState keyMods pos
= do pos' <- convertPoint pos
worldRef `modifyIORef` \world -> eventFn (EventKey key keyState keyMods pos') world
callback_motion
:: IORef world
-> (Event -> world -> world)
-> Callback
callback_motion worldRef eventFn
= Motion (handle_motion worldRef eventFn)
handle_motion
:: IORef a
-> (Event -> a -> a)
-> GL.Position
-> IO ()
handle_motion worldRef eventFn pos
= do pos' <- convertPoint pos
worldRef `modifyIORef` \world -> eventFn (EventMotion pos') world
convertPoint :: GL.Position -> IO (Float,Float)
convertPoint pos
= do (GLUT.Size sizeX_ sizeY_) <- GL.get GLUT.windowSize
let (sizeX, sizeY) = (fromIntegral sizeX_, fromIntegral sizeY_)
let GLUT.Position px_ py_ = pos
let px = fromIntegral px_
let py = sizeY fromIntegral py_
let px' = px sizeX / 2
let py' = py sizeY / 2
let pos' = (px', py')
return pos'