logging and more beautiful fullscreen toggle
This commit is contained in:
parent
e75735bbf6
commit
13991556dc
2 changed files with 18 additions and 3 deletions
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue