module FRP.Spice.Internal.Engine ( startEngine
, startEngineDefault
) where
import Graphics.Rendering.OpenGL
import Graphics.UI.GLFW as GLFW
import FRP.Elerea.Param
import Data.Default
import Data.IORef
import FRP.Spice.Internal.Assets
import FRP.Spice.Internal.Input
import FRP.Spice.Internal.Types
closeCallback :: IORef Bool -> WindowCloseCallback
closeCallback closedRef = do
writeIORef closedRef True
return True
resizeCallback :: WindowSizeCallback
resizeCallback size@(Size w' h') = do
let (Vector w h) = Vector (fromIntegral w' / 640) (fromIntegral h' / 480)
matrixMode $= Projection
loadIdentity
ortho (w) ( w)
(h) ( h)
(1) ( 1)
matrixMode $= Modelview 0
viewport $= (Position 0 0, size)
makeNetwork :: Game a => a -> Signal Input -> IO (Float -> IO a)
makeNetwork game inputSignal = start $ transfer game update inputSignal
runInput :: IORef Bool -> IO (Maybe DeltaTime)
runInput closedRef = do
pollEvents
closed <- readIORef closedRef
t <- get time
time $= 0
return $ if closed
then Nothing
else Just $ realToFrac t
driveNetwork :: Game a => Assets -> (Float -> IO a) -> IO (Maybe Float) -> IO ()
driveNetwork assets network iomdriver = do
mdriver <- iomdriver
case mdriver of
Nothing -> return ()
Just driver -> do
game <- network driver
renderWrapper $ render assets game
driveNetwork assets network iomdriver
where renderWrapper :: Scene -> IO ()
renderWrapper scene = do
clear [ColorBuffer]
scene
swapBuffers
startEngine :: Game a => WindowConfig -> a -> IO ()
startEngine wc game = do
initialize
openWindow (Size (fromIntegral $ getWindowWidth wc)
(fromIntegral $ getWindowHeight wc))
[DisplayRGBBits 8 8 8, DisplayAlphaBits 8, DisplayDepthBits 24]
(case getWindowFullscreen wc of
True -> FullScreen
False -> Window)
closedRef <- newIORef False
windowTitle $= getWindowTitle wc
windowCloseCallback $= closeCallback closedRef
windowSizeCallback $= resizeCallback
assets <- performAssetLoads $ loadAssets game
ic <- makeInputContainer
mousePosCallback $= makeMousePosCallback ic
mouseButtonCallback $= makeMouseButtonCallback ic
keyCallback $= makeKeyCallback ic
network <- makeNetwork game $ getInput ic
time $= 0
driveNetwork assets network $ runInput closedRef
closeWindow
startEngineDefault :: Game a => a -> IO ()
startEngineDefault = startEngine def