150 lines
4.9 KiB
Haskell
150 lines
4.9 KiB
Haskell
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE BangPatterns #-}
|
|
{-# LANGUAGE ExplicitForAll #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE RankNTypes #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
module Affection
|
|
( withAffection
|
|
, get
|
|
, put
|
|
, liftIO
|
|
, module A
|
|
) where
|
|
|
|
import SDL (($=))
|
|
import qualified SDL
|
|
import qualified SDL.Raw.Video as SDL (glSetAttribute)
|
|
import qualified SDL.Raw.Enum as SDL
|
|
|
|
import qualified Graphics.Rendering.OpenGL as GL (clear, flush, ClearBuffer(..))
|
|
import qualified Graphics.GL as GLRaw
|
|
|
|
import Foreign.Marshal.Array
|
|
|
|
import qualified Data.ByteString as B
|
|
import qualified Data.ByteString.Char8 as B8
|
|
|
|
import System.Clock
|
|
|
|
import Control.Monad.Loops
|
|
import Control.Monad.State.Strict
|
|
|
|
-- internal imports
|
|
|
|
import Affection.Types as A
|
|
import Affection.Class as A
|
|
import Affection.StateMachine as A
|
|
import Affection.Util as A
|
|
import Affection.MessageBus as A
|
|
import Affection.Subsystems as A
|
|
|
|
import Affection.Logging as A
|
|
|
|
-- | Main function which bootstraps everything else.
|
|
withAffection
|
|
:: forall us. (Affectionate us)
|
|
=> AffectionConfig us -- ^ Configuration of the Game and its engine.
|
|
-> IO ()
|
|
withAffection AffectionConfig{..} = do
|
|
liftIO $ logIO Debug "Affection starting"
|
|
liftIO $ logIO Debug "Initializing SDL"
|
|
-- intialiaze SDL
|
|
case initComponents of
|
|
All ->
|
|
SDL.initializeAll
|
|
Only is ->
|
|
SDL.initialize is
|
|
-- give SDL render quality
|
|
SDL.HintRenderScaleQuality SDL.$= SDL.ScaleLinear
|
|
-- just checking…
|
|
do
|
|
renderQuality <- SDL.get SDL.HintRenderScaleQuality
|
|
when (renderQuality /= SDL.ScaleLinear) $
|
|
logIO Warn "Linear texture filtering not enabled!"
|
|
-- construct window
|
|
liftIO $ logIO Debug "Creating Window(s)"
|
|
windows <- zip3 (map (\(x,_,_) -> x) windowConfigs) <$>
|
|
mapM
|
|
(\wc -> SDL.createWindow windowTitle ((\(_,y,_) -> y) wc))
|
|
windowConfigs <*>
|
|
pure (map (\(_,_,z) -> z) windowConfigs)
|
|
|
|
mapM_ (SDL.showWindow . (\(_,y,_) -> y)) windows
|
|
_ <- SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1
|
|
contexts <- zip (map (\(x,_,_) -> x) windows) <$>
|
|
mapM (SDL.glCreateContext . (\(_,y,_) -> y)) windows
|
|
mapM_ (\w -> flip SDL.setWindowMode ((\(_,_,z) -> z) w) ((\(_,y,_) -> y) w)) windows
|
|
-- sync updates with monitor
|
|
-- SDL.swapInterval $= SDL.SynchronizedUpdates -- <- causes Problems with windows
|
|
liftIO $ logIO Debug "Getting Time"
|
|
-- print current used GL Version
|
|
version <- peekArray0 (0 :: Word8) =<< GLRaw.glGetString GLRaw.GL_VERSION
|
|
print (B.pack version)
|
|
-- get current time
|
|
execTime <- getTime Monotonic
|
|
liftIO $ logIO Debug "Loading initial data container"
|
|
-- construct game data object from provided Affectionate instance
|
|
gameData <- loadState @us
|
|
-- build state container
|
|
let initContainer = AffectionData
|
|
{ drawWindows = windows
|
|
, glContext = contexts
|
|
, elapsedTime = 0
|
|
, deltaTime = 0
|
|
, sysTime = execTime
|
|
, pausedTime = False
|
|
}
|
|
-- initialize and run state
|
|
(_, _) <- runStateT
|
|
(A.runState
|
|
(do
|
|
liftIO $ logIO Debug "Running Pre-Loop stage"
|
|
-- run preLoop function from Affectionate
|
|
preLoop gameData
|
|
liftIO $ logIO Debug "Starting Loop"
|
|
whileM_ (hasNextStep gameData)
|
|
(do
|
|
-- get state
|
|
ad <- get
|
|
-- Measure time difference form last run
|
|
now <- liftIO $ getTime Monotonic
|
|
let lastTime = sysTime ad
|
|
-- compute dt and update elapsedTime
|
|
let !dt = fromIntegral
|
|
(toNanoSecs $ diffTimeSpec lastTime now) / (10 ^ (9 :: Int))
|
|
!ne = elapsedTime ad + dt
|
|
-- update state data object with new time values
|
|
put $ ad
|
|
{ elapsedTime = ne
|
|
, deltaTime = dt
|
|
}
|
|
-- poll events
|
|
evs <- preHandleEvents =<< liftIO SDL.pollEvents
|
|
-- handle events
|
|
handleEvents gameData evs
|
|
-- execute user defined update loop
|
|
unless (pausedTime ad) (update gameData dt)
|
|
-- clear GL buffer >> execute user defined draw loop >> flush GL buffer
|
|
liftIO $ GL.clear [GL.ColorBuffer, GL.DepthBuffer, GL.StencilBuffer]
|
|
draw gameData
|
|
liftIO GL.flush
|
|
-- actual displaying of newly drawn frame
|
|
mapM_ (SDL.glSwapWindow . (\(_,y,_) -> y)) windows
|
|
-- save new time
|
|
ad3 <- get
|
|
when (sysTime ad == sysTime ad3) (
|
|
put ad3
|
|
{ sysTime = now
|
|
}
|
|
)
|
|
)
|
|
)
|
|
) initContainer
|
|
liftIO $ logIO Debug "Loop ended. Cleaning"
|
|
cleanUp gameData
|
|
liftIO $ logIO Debug "Destroying Window"
|
|
mapM_ (SDL.glDeleteContext . snd) contexts
|
|
mapM_ (SDL.destroyWindow . (\(_,y,_) -> y)) windows
|
|
-- SDL.quit -- <- This causes segfaults depending on hardware
|
|
liftIO $ logIO Debug "This is the end"
|