{-# LANGUAGE RankNTypes #-}
module Graphics.Gloss.Internals.Interface.Game
( playWithBackendIO
, Event(..) )
where
import Graphics.Gloss.Data.Color
import Graphics.Gloss.Data.Picture
import Graphics.Gloss.Data.ViewPort
import Graphics.Gloss.Rendering
import Graphics.Gloss.Internals.Interface.Event
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.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 Data.IORef
import System.Mem
playWithBackendIO
:: forall world a
. Backend a
=> a
-> Display
-> Color
-> Int
-> world
-> (world -> IO Picture)
-> (Event -> world -> IO world)
-> (Float -> world -> IO world)
-> Bool
-> IO ()
playWithBackendIO :: a
-> Display
-> Color
-> Int
-> world
-> (world -> IO Picture)
-> (Event -> world -> IO world)
-> (Float -> world -> IO world)
-> Bool
-> IO ()
playWithBackendIO
a
backend
Display
display
Color
backgroundColor
Int
simResolution
world
worldStart
world -> IO Picture
worldToPicture
Event -> world -> IO world
worldHandleEvent
Float -> world -> IO world
worldAdvance
Bool
withCallbackExit
= do
let singleStepTime :: Float
singleStepTime = Float
1
IORef State
stateSR <- State -> IO (IORef State)
forall a. a -> IO (IORef a)
newIORef (State -> IO (IORef State)) -> State -> IO (IORef State)
forall a b. (a -> b) -> a -> b
$ Int -> State
SM.stateInit Int
simResolution
IORef world
worldSR <- world -> IO (IORef world)
forall a. a -> IO (IORef a)
newIORef world
worldStart
IORef ViewPort
viewSR <- ViewPort -> IO (IORef ViewPort)
forall a. a -> IO (IORef a)
newIORef ViewPort
viewPortInit
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
world
world <- IORef world -> IO world
forall a. IORef a -> IO a
readIORef IORef world
worldSR
Picture
picture <- world -> IO Picture
worldToPicture world
world
State
renderS <- IORef State -> IO State
forall a. IORef a -> IO a
readIORef IORef State
renderSR
ViewPort
viewPort <- IORef ViewPort -> IO ViewPort
forall a. IORef a -> IO a
readIORef IORef ViewPort
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
backgroundColor
State
renderS
(ViewPort -> Float
viewPortScale ViewPort
viewPort)
(ViewPort -> Picture -> Picture
applyViewPortToPicture ViewPort
viewPort 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 State
-> IORef State
-> IO ViewPort
-> IORef world
-> (ViewPort -> Float -> world -> IO world)
-> Float
-> DisplayCallback
forall world.
IORef State
-> IORef State
-> IO ViewPort
-> IORef world
-> (ViewPort -> Float -> world -> IO world)
-> Float
-> DisplayCallback
callback_simulate_idle
IORef State
stateSR IORef State
animateSR (IORef ViewPort -> IO ViewPort
forall a. IORef a -> IO a
readIORef IORef ViewPort
viewSR)
IORef world
worldSR (\ViewPort
_ -> Float -> world -> IO world
worldAdvance)
Float
singleStepTime)
, IORef world
-> IORef ViewPort -> (Event -> world -> IO world) -> Callback
forall world.
IORef world
-> IORef ViewPort -> (Event -> world -> IO world) -> Callback
callback_keyMouse IORef world
worldSR IORef ViewPort
viewSR Event -> world -> IO world
worldHandleEvent
, IORef world -> (Event -> world -> IO world) -> Callback
forall world.
IORef world -> (Event -> world -> IO world) -> Callback
callback_motion IORef world
worldSR Event -> world -> IO world
worldHandleEvent
, IORef world -> (Event -> world -> IO world) -> Callback
forall world.
IORef world -> (Event -> world -> IO world) -> Callback
callback_reshape IORef world
worldSR Event -> world -> IO world
worldHandleEvent]
let exitCallback :: [Callback]
exitCallback
= if Bool
withCallbackExit then [() -> Callback
forall a. a -> Callback
callback_exit ()] 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
backgroundColor
([Callback]
callbacks [Callback] -> [Callback] -> [Callback]
forall a. [a] -> [a] -> [a]
++ [Callback]
exitCallback)
(\IORef a
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
callback_keyMouse
:: IORef world
-> IORef ViewPort
-> (Event -> world -> IO world)
-> Callback
callback_keyMouse :: IORef world
-> IORef ViewPort -> (Event -> world -> IO world) -> Callback
callback_keyMouse IORef world
worldRef IORef ViewPort
viewRef Event -> world -> IO world
eventFn
= KeyboardMouseCallback -> Callback
KeyMouse (IORef world
-> IORef ViewPort
-> (Event -> world -> IO world)
-> KeyboardMouseCallback
forall a t.
IORef a -> t -> (Event -> a -> IO a) -> KeyboardMouseCallback
handle_keyMouse IORef world
worldRef IORef ViewPort
viewRef Event -> world -> IO world
eventFn)
handle_keyMouse
:: IORef a
-> t
-> (Event -> a -> IO a)
-> KeyboardMouseCallback
handle_keyMouse :: IORef a -> t -> (Event -> a -> IO a) -> KeyboardMouseCallback
handle_keyMouse IORef a
worldRef t
_ Event -> a -> IO a
eventFn IORef a
backendRef Key
key KeyState
keyState Modifiers
keyMods (Int, Int)
pos
= do Event
ev <- IORef a -> Key -> KeyState -> Modifiers -> (Int, Int) -> IO Event
forall a.
Backend a =>
IORef a -> Key -> KeyState -> Modifiers -> (Int, Int) -> IO Event
keyMouseEvent IORef a
backendRef Key
key KeyState
keyState Modifiers
keyMods (Int, Int)
pos
a
world <- IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
worldRef
a
world' <- Event -> a -> IO a
eventFn Event
ev a
world
IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
worldRef a
world'
callback_motion
:: IORef world
-> (Event -> world -> IO world)
-> Callback
callback_motion :: IORef world -> (Event -> world -> IO world) -> Callback
callback_motion IORef world
worldRef Event -> world -> IO world
eventFn
= MotionCallback -> Callback
Motion (IORef world -> (Event -> world -> IO world) -> MotionCallback
forall a. IORef a -> (Event -> a -> IO a) -> MotionCallback
handle_motion IORef world
worldRef Event -> world -> IO world
eventFn)
handle_motion
:: IORef a
-> (Event -> a -> IO a)
-> MotionCallback
handle_motion :: IORef a -> (Event -> a -> IO a) -> MotionCallback
handle_motion IORef a
worldRef Event -> a -> IO a
eventFn IORef a
backendRef (Int, Int)
pos
= do Event
ev <- IORef a -> (Int, Int) -> IO Event
forall a. Backend a => IORef a -> (Int, Int) -> IO Event
motionEvent IORef a
backendRef (Int, Int)
pos
a
world <- IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
worldRef
a
world' <- Event -> a -> IO a
eventFn Event
ev a
world
IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
worldRef a
world'
callback_reshape
:: IORef world
-> (Event -> world -> IO world)
-> Callback
callback_reshape :: IORef world -> (Event -> world -> IO world) -> Callback
callback_reshape IORef world
worldRef Event -> world -> IO world
eventFN
= MotionCallback -> Callback
Reshape (IORef world -> (Event -> world -> IO world) -> MotionCallback
forall a. IORef a -> (Event -> a -> IO a) -> MotionCallback
handle_reshape IORef world
worldRef Event -> world -> IO world
eventFN)
handle_reshape
:: IORef world
-> (Event -> world -> IO world)
-> ReshapeCallback
handle_reshape :: IORef world -> (Event -> world -> IO world) -> MotionCallback
handle_reshape IORef world
worldRef Event -> world -> IO world
eventFn IORef a
stateRef (Int
width,Int
height)
= do world
world <- IORef world -> IO world
forall a. IORef a -> IO a
readIORef IORef world
worldRef
world
world' <- Event -> world -> IO world
eventFn ((Int, Int) -> Event
EventResize (Int
width, Int
height)) world
world
IORef world -> world -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef world
worldRef world
world'
IORef a -> (Int, Int) -> IO ()
MotionCallback
viewState_reshape IORef a
stateRef (Int
width, Int
height)