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

View file

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