{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE BangPatterns #-} module Affection ( withAffection , get , getAffection , putAffection , delaySec , get , put , module A ) where import SDL (($=)) import qualified SDL import qualified SDL.Internal.Numbered as SDL (toNumber) import qualified SDL.Raw as Raw import Data.Maybe import Data.IORef import System.Clock import Control.Monad.Loops import Control.Monad.State import Foreign.C.Types (CInt(..)) import Foreign.Storable (peek) import Debug.Trace import Affection.Types as A import Affection.StateMachine as A import Affection.MouseInteractable as A import Affection.Util as A import Affection.MessageBus as A import Graphics.Rendering.OpenGL as GL (clear, flush, ClearBuffer(..)) -- | Main function which bootstraps everything else. withAffection :: AffectionConfig us msg -- ^ Configuration of the Game and its engine. -> IO () withAffection AffectionConfig{..} = do -- 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) $ putStrLn "Warning: Linear texture filtering not enabled!" -- construct window window <- SDL.createWindow windowTitle windowConfig SDL.showWindow window context <- SDL.glCreateContext(window) let SDL.V2 (CInt rw) (CInt rh) = SDL.windowInitialSize windowConfig (w, h) = case canvasSize of Just (cw, ch) -> (cw, ch) Nothing -> (fromIntegral rw, fromIntegral rh) SDL.setWindowMode window initScreenMode SDL.swapInterval $= SDL.SynchronizedUpdates -- get current time execTime <- getTime Monotonic initContainer <- (\x -> AffectionData { quitEvent = False , userState = x , drawWindow = window , glContext = context , drawDimensions = case canvasSize of Just (cw, ch) -> (cw, ch) Nothing -> (w, h) , screenMode = initScreenMode , elapsedTime = 0 , deltaTime = 0 , sysTime = execTime , pausedTime = False }) <$> loadState (_, nState) <- runStateT ( A.runState $ do preLoop whileM_ (do current <- get return $ not $ A.quitEvent current ) (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) !ne = elapsedTime ad + dt put $ ad { elapsedTime = ne , deltaTime = dt } -- poll events evs <- preHandleEvents =<< liftIO SDL.pollEvents mapM_ eventLoop evs -- execute user defined update loop unless (pausedTime ad) (updateLoop dt) -- execute user defined draw loop liftIO $ GL.clear [ColorBuffer, DepthBuffer] drawLoop liftIO $ flush -- handle all new draw requests ad2 <- get -- actual drawing SDL.glSwapWindow window -- save new time ad3 <- get when (sysTime ad == sysTime ad3) ( put ad3 { sysTime = now } ) ) ) initContainer cleanUp $ userState nState SDL.destroyWindow window SDL.quit