{-# LANGUAGE RankNTypes #-}
module Brillo.Internals.Interface.Simulate (simulateWithBackendIO)
where
import Brillo.Data.Color
import Brillo.Data.Display
import Brillo.Data.Picture
import Brillo.Data.ViewPort
import Brillo.Data.ViewState
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.Simulate.Idle
import Brillo.Internals.Interface.Simulate.State qualified as SM
import Brillo.Internals.Interface.ViewState.KeyMouse
import Brillo.Internals.Interface.ViewState.Motion
import Brillo.Internals.Interface.ViewState.Reshape
import Brillo.Internals.Interface.Window
import Brillo.Rendering
import Data.IORef
import System.Mem
simulateWithBackendIO
:: forall model a
. (Backend a)
=> a
-> Display
-> Color
-> Int
-> model
-> (model -> IO Picture)
-> (ViewPort -> Float -> model -> IO model)
-> IO ()
simulateWithBackendIO :: forall model a.
Backend a =>
a
-> Display
-> Color
-> Int
-> model
-> (model -> IO Picture)
-> (ViewPort -> Float -> model -> IO model)
-> IO ()
simulateWithBackendIO
a
backend
Display
display
Color
backgroundColor
Int
simResolution
model
worldStart
model -> IO Picture
worldToPicture
ViewPort -> Float -> model -> IO model
worldAdvance =
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 model
worldSR <- model -> IO (IORef model)
forall a. a -> IO (IORef a)
newIORef model
worldStart
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
model
world <- IORef model -> IO model
forall a. IORef a -> IO a
readIORef IORef model
worldSR
ViewPort
port <- 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
Picture
picture <- model -> IO Picture
worldToPicture model
world
State
renderS <- IORef State -> IO State
forall a. IORef a -> IO a
readIORef IORef State
renderSR
(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
port)
(ViewPort -> Picture -> Picture
applyViewPortToPicture ViewPort
port 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 model
-> (ViewPort -> Float -> model -> IO model)
-> 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
(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)
IORef model
worldSR
ViewPort -> Float -> model -> IO model
worldAdvance
Float
singleStepTime
)
, () -> Callback
forall a. a -> Callback
callback_exit ()
, IORef ViewState -> Callback
callback_viewState_keyMouse IORef ViewState
viewSR
, IORef ViewState -> Callback
callback_viewState_motion IORef ViewState
viewSR
, Callback
callback_viewState_reshape
]
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
(IO () -> IORef a -> IO ()
forall a b. a -> b -> a
const (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()))