{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE Strict #-} {-# 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 liftIO SDL.pumpEvents 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"