{-# LANGUAGE RankNTypes #-}
module Brillo.Internals.Interface.Game (
playWithBackendIO,
Event (..),
)
where
import Brillo.Data.Color
import Brillo.Data.Picture
import Brillo.Data.ViewPort
import Brillo.Internals.Interface.Animate.State qualified as AN
import Brillo.Internals.Interface.Animate.Timing
import Brillo.Internals.Interface.Backend
import Brillo.Internals.Interface.Callback qualified as Callback
import Brillo.Internals.Interface.Common.Exit
import Brillo.Internals.Interface.Event
import Brillo.Internals.Interface.Simulate.Idle
import Brillo.Internals.Interface.Simulate.State qualified as SM
import Brillo.Internals.Interface.ViewState.Reshape
import Brillo.Internals.Interface.Window
import Brillo.Rendering
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 :: 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
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 IORef a -> IO ()
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
callback_keyMouse
:: IORef world
-> IORef ViewPort
-> (Event -> world -> IO world)
-> Callback
callback_keyMouse :: forall world.
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 :: forall a t.
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 :: forall world.
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 :: forall a. 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 :: forall world.
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 :: forall a. IORef a -> (Event -> a -> IO a) -> 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)