{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE Strict #-} {-# 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 Data.String (fromString) import System.Clock import Control.Monad.Loops import Control.Monad.State.Strict import Control.Monad.Trans.Resource -- 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{..} = runResourceT $ 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… renderQuality <- SDL.get SDL.HintRenderScaleQuality when (renderQuality /= SDL.ScaleLinear) $ liftIO $ logIO Warn "Linear texture filtering not enabled!" void $ liftIO (logIO Debug . fromString . show <$> (SDL.version :: IO (Integer, Integer, Integer))) -- construct window liftIO $ logIO Debug "Creating Window(s)" windows <- mapM (\(_, sdlWindowConfig, mode) -> do (windowKey, window) <- allocate (SDL.createWindow windowTitle sdlWindowConfig) (\window -> do logIO Debug "Destroying Window" SDL.destroyWindow window ) return $ AffectionWindow window windowKey mode ) windowConfigs -- Show windows mapM_ (SDL.showWindow . awWindow) windows -- set modes of windows mapM_ (\(AffectionWindow window _ mode) -> SDL.setWindowMode window mode) windows -- Make GL context shareable void $ SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1 -- Create OpenGL contexts contexts <- mapM (\(AffectionWindow window _ _) -> do (contextKey, context) <- allocate (SDL.glCreateContext window) (\context -> do logIO Debug "Destroying context" SDL.glDeleteContext context ) return $ AffectionContext context contextKey ) windows -- sync updates with monitor -- SDL.swapInterval $= SDL.SynchronizedUpdates -- <- causes Problems with windows -- print current used GL Version version <- liftIO $ peekArray0 (0 :: Word8) =<< GLRaw.glGetString GLRaw.GL_VERSION liftIO $ print (B.pack version) -- get current time liftIO $ logIO Debug "Getting Time" execTime <- liftIO $ getTime Monotonic liftIO $ logIO Debug "Loading initial data container" -- construct game data object from provided Affectionate instance (gameDataKey, gameData) <- allocate (liftIO $ loadState @us) (liftIO . cleanUp) -- build state container let initContainer = AffectionData { drawWindows = windows , glContext = contexts , elapsedTime = 0 , deltaTime = 0 , sysTime = execTime , pausedTime = False } -- initialize and run state void $ liftIO $ runAffection initContainer (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 . awWindow) windows -- save new time ad3 <- get when (sysTime ad == sysTime ad3) ( put ad3 { sysTime = now } ) ) ) -- Cleanup works liftIO $ logIO Debug "Loop ended. Cleaning" release gameDataKey -- 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" runAffection :: AffectionData -> AffectionState AffectionData ResIO a -> IO (a, AffectionData) runAffection initialState a = runResourceT $ runStateT (A.runState a) initialState