update screenmode toggle function

This commit is contained in:
nek0 2020-05-04 11:00:49 +02:00
parent a7eac3e392
commit d6804f95fb
2 changed files with 30 additions and 18 deletions

View File

@ -103,7 +103,7 @@ pre ud = do
toggleFullScreen :: KeyboardMessage -> Affection () toggleFullScreen :: KeyboardMessage -> Affection ()
toggleFullScreen (MsgKeyboardEvent _ _ SDL.Pressed False sym) toggleFullScreen (MsgKeyboardEvent _ _ SDL.Pressed False sym)
| SDL.keysymKeycode sym == SDL.KeycodeF11 = toggleScreen | SDL.keysymKeycode sym == SDL.KeycodeF11 = toggleScreen 0
| otherwise = return () | otherwise = return ()
toggleFullScreen _ = return () toggleFullScreen _ = return ()

View File

@ -11,6 +11,7 @@ import qualified Graphics.Rendering.OpenGL as GL
import System.Clock import System.Clock
import Data.String (fromString) import Data.String (fromString)
import Data.List (find)
import Control.Monad.State import Control.Monad.State
@ -35,24 +36,35 @@ getDelta = gets deltaTime
-- | Toggle the Screen mode between 'SDL.Windowed' and 'SDL.FullscreenDesktop'. -- | Toggle the Screen mode between 'SDL.Windowed' and 'SDL.FullscreenDesktop'.
-- Pauses the Engine in the process. -- Pauses the Engine in the process.
toggleScreen :: Affection () toggleScreen :: Word -> Affection ()
toggleScreen = do toggleScreen windowIdent = do
ad <- get ad <- get
newMode <- case screenMode ad of let mwindow = find (\(ident, _, _) -> ident == windowIdent) (drawWindows ad)
SDL.Windowed -> do case mwindow of
mapM_ (flip SDL.setWindowMode SDL.FullscreenDesktop . (\(_,y,_) -> y)) (drawWindows ad) Just (ident, window, mode) -> do
return SDL.FullscreenDesktop newMode <- case mode of
SDL.FullscreenDesktop -> do SDL.FullscreenDesktop -> do
mapM_ (flip SDL.setWindowMode SDL.Windowed . (\(_,y,_) -> y)) (drawWindows ad) SDL.setWindowMode window SDL.Windowed
return SDL.Windowed return SDL.Windowed
x -> do SDL.Windowed -> do
liftIO $ logIO Warn ("Unexpected Screen mode: " <> fromString (show x)) SDL.setWindowMode window SDL.FullscreenDesktop
return x return SDL.FullscreenDesktop
now <- liftIO $ getTime Monotonic x -> do
put ad liftIO $ logIO Warn ("Unexpected window mode: " <> fromString (show x))
{ sysTime = now return x
, screenMode = newMode now <- liftIO $ getTime Monotonic
} put ad
{ sysTime = now
, drawWindows = map
(\e@(lid, win, mod) ->
if lid == ident
then (lid, win, newMode)
else e
)
(drawWindows ad)
}
Nothing -> do
liftIO $ logIO Warn ("No window found with ident " <> fromString (show windowIdent))
-- | Fit the GL Viewport to Window size -- | Fit the GL Viewport to Window size
fitViewport fitViewport