logging and more beautiful fullscreen toggle

This commit is contained in:
nek0 2017-12-19 21:53:47 +01:00
parent e75735bbf6
commit 13991556dc
2 changed files with 18 additions and 3 deletions

View file

@ -36,6 +36,8 @@ withAffection
:: AffectionConfig us -- ^ Configuration of the Game and its engine. :: AffectionConfig us -- ^ Configuration of the Game and its engine.
-> IO () -> IO ()
withAffection AffectionConfig{..} = do withAffection AffectionConfig{..} = do
liftIO $ logIO Debug "Affection starting"
liftIO $ logIO Debug "Initializing SDL"
-- intialiaze SDL -- intialiaze SDL
case initComponents of case initComponents of
All -> All ->
@ -50,6 +52,7 @@ withAffection AffectionConfig{..} = do
when (renderQuality /= SDL.ScaleLinear) $ when (renderQuality /= SDL.ScaleLinear) $
logIO Warn "Linear texture filtering not enabled!" logIO Warn "Linear texture filtering not enabled!"
-- construct window -- construct window
liftIO $ logIO Debug "Creating Window"
window <- SDL.createWindow windowTitle windowConfig window <- SDL.createWindow windowTitle windowConfig
SDL.showWindow window SDL.showWindow window
context <- SDL.glCreateContext window context <- SDL.glCreateContext window
@ -59,8 +62,10 @@ withAffection AffectionConfig{..} = do
Nothing -> (fromIntegral rw, fromIntegral rh) Nothing -> (fromIntegral rw, fromIntegral rh)
SDL.setWindowMode window initScreenMode SDL.setWindowMode window initScreenMode
SDL.swapInterval $= SDL.SynchronizedUpdates SDL.swapInterval $= SDL.SynchronizedUpdates
liftIO $ logIO Debug "Getting Time"
-- get current time -- get current time
execTime <- getTime Monotonic execTime <- getTime Monotonic
liftIO $ logIO Debug "Loading initial data container"
initContainer <- (\x -> AffectionData initContainer <- (\x -> AffectionData
{ quitEvent = False { quitEvent = False
, userState = x , userState = x
@ -76,6 +81,7 @@ withAffection AffectionConfig{..} = do
, pausedTime = False , pausedTime = False
}) <$> loadState }) <$> loadState
(_, nState) <- runStateT ( A.runState $ do (_, nState) <- runStateT ( A.runState $ do
liftIO $ logIO Debug "Starting Loop"
preLoop preLoop
whileM_ (do whileM_ (do
current <- get current <- get
@ -118,6 +124,9 @@ withAffection AffectionConfig{..} = do
) )
) )
) initContainer ) initContainer
liftIO $ logIO Debug "Loop ended. Cleaning"
cleanUp $ userState nState cleanUp $ userState nState
liftIO $ logIO Debug "Destroying Window"
SDL.destroyWindow window SDL.destroyWindow window
SDL.quit SDL.quit
liftIO $ logIO Debug "This is the end"

View file

@ -2,6 +2,7 @@ module Affection.Util
where where
import Affection.Types import Affection.Types
import Affection.Logging
import qualified SDL import qualified SDL
@ -49,16 +50,21 @@ quit = do
ad <- get ad <- get
put $ ad { quitEvent = True } put $ ad { quitEvent = True }
-- | Toggle the Screen mode between 'SDL.Windowed' and 'SDL.FullscreenDesktop'.
-- Pauses the Engine in the process.
toggleScreen :: Affection us () toggleScreen :: Affection us ()
toggleScreen = do toggleScreen = do
ad <- get ad <- get
newMode <- case screenMode ad of newMode <- case screenMode ad of
SDL.Windowed -> do SDL.Windowed -> do
SDL.setWindowMode (drawWindow ad) SDL.Fullscreen SDL.setWindowMode (drawWindow ad) SDL.FullscreenDesktop
return SDL.Fullscreen return SDL.FullscreenDesktop
SDL.Fullscreen -> do SDL.FullscreenDesktop -> do
SDL.setWindowMode (drawWindow ad) SDL.Windowed SDL.setWindowMode (drawWindow ad) SDL.Windowed
return SDL.Windowed return SDL.Windowed
x -> do
liftIO $ logIO Warn ("Unknown Screen mode: " ++ show x)
return x
now <- liftIO $ getTime Monotonic now <- liftIO $ getTime Monotonic
put ad put ad
{ sysTime = now { sysTime = now