mirror of
https://github.com/fjvallarino/monomer.git
synced 2024-09-20 08:17:37 +03:00
Add config options for window maximized, fullscreen and title
This commit is contained in:
parent
94d4d8a4f2
commit
ffac763643
@ -32,6 +32,10 @@ main = do
|
||||
let config = [
|
||||
--windowSize (1280, 960),
|
||||
--windowSize (320, 240),
|
||||
--mainWindowState MainWindowFullScreen,
|
||||
--mainWindowState MainWindowMaximized,
|
||||
--mainWindowState $ MainWindowNormal (640, 480),
|
||||
mainWindowTitle "This is my title",
|
||||
useHdpi True,
|
||||
appTheme theme,
|
||||
appInitEvent InitApp,
|
||||
@ -75,9 +79,9 @@ handleAppEvent model evt = case evt of
|
||||
RunShortTask -> [Task $ do
|
||||
putStrLn "Running!"
|
||||
return $ Just (PrintMessage "Done!")]
|
||||
ChangeTitle title -> [Request (UpdateWindow (WindowTitle title))]
|
||||
ChangeTitle title -> [Request (UpdateWindow (WindowSetTitle title))]
|
||||
ExitApp -> [Request ExitApplication]
|
||||
FullWindow -> [Request (UpdateWindow WindowFullScreen)]
|
||||
FullWindow -> [Request (UpdateWindow WindowSetFullScreen)]
|
||||
MaxWindow -> [Request (UpdateWindow WindowMaximize)]
|
||||
MinWindow -> [Request (UpdateWindow WindowMinimize), Event RestoreWindowSchedule]
|
||||
RestoreWindowSchedule -> [Task $ do
|
||||
|
@ -10,10 +10,6 @@ import Monomer.Core.StyleTypes
|
||||
import Monomer.Core.WidgetTypes
|
||||
import Monomer.Graphics.Types
|
||||
|
||||
-- Config
|
||||
class WindowSize t s | t -> s where
|
||||
windowSize :: s -> t
|
||||
|
||||
-- Input
|
||||
class ValidInput t s | t -> s where
|
||||
validInput :: ALens' s Bool -> t
|
||||
|
@ -30,8 +30,8 @@ data TextOverflow
|
||||
deriving (Eq, Show)
|
||||
|
||||
data WindowRequest
|
||||
= WindowTitle Text
|
||||
| WindowFullScreen
|
||||
= WindowSetTitle Text
|
||||
| WindowSetFullScreen
|
||||
| WindowMaximize
|
||||
| WindowMinimize
|
||||
| WindowRestore
|
||||
|
@ -70,17 +70,15 @@ simpleApp_
|
||||
-> [AppConfig e]
|
||||
-> IO ()
|
||||
simpleApp_ model eventHandler uiBuilder configs = do
|
||||
window <- initSDLWindow config
|
||||
(window, dpr) <- initSDLWindow config
|
||||
winSize <- getDrawableSize window
|
||||
|
||||
let dpr = _sW winSize / fromIntegral winW
|
||||
let monomerContext = initMonomerContext () window winSize useHdpi dpr
|
||||
|
||||
runStateT (runApp window theme fonts appWidget) monomerContext
|
||||
detroySDLWindow window
|
||||
where
|
||||
config = mconcat configs
|
||||
(winW, winH) = fromMaybe defaultWindowSize (_apcWindowSize config)
|
||||
useHdpi = fromMaybe defaultUseHdpi (_apcHdpi config)
|
||||
fonts = _apcFonts config
|
||||
theme = fromMaybe def (_apcTheme config)
|
||||
|
@ -242,8 +242,8 @@ handleUpdateWindow
|
||||
handleUpdateWindow windowRequest previousStep = do
|
||||
window <- use L.window
|
||||
case windowRequest of
|
||||
WindowTitle title -> SDL.windowTitle window $= title
|
||||
WindowFullScreen -> SDL.setWindowMode window SDL.FullscreenDesktop
|
||||
WindowSetTitle title -> SDL.windowTitle window $= title
|
||||
WindowSetFullScreen -> SDL.setWindowMode window SDL.FullscreenDesktop
|
||||
WindowMaximize -> SDL.setWindowMode window SDL.Maximized
|
||||
WindowMinimize -> SDL.setWindowMode window SDL.Minimized
|
||||
WindowRestore -> SDL.setWindowMode window SDL.Windowed
|
||||
|
@ -1,4 +1,5 @@
|
||||
module Monomer.Main.Platform where
|
||||
{- HLint Ignore: Use forM_ -}
|
||||
|
||||
import Control.Monad.State
|
||||
import Data.Maybe
|
||||
@ -29,7 +30,7 @@ defaultWindowSize = (640, 480)
|
||||
defaultUseHdpi :: Bool
|
||||
defaultUseHdpi = True
|
||||
|
||||
initSDLWindow :: AppConfig e -> IO SDL.Window
|
||||
initSDLWindow :: AppConfig e -> IO (SDL.Window, Double)
|
||||
initSDLWindow config = do
|
||||
SDL.initialize [SDL.InitVideo]
|
||||
SDL.HintRenderScaleQuality $= SDL.ScaleLinear
|
||||
@ -38,17 +39,6 @@ initSDLWindow config = do
|
||||
when (renderQuality /= SDL.ScaleLinear) $
|
||||
putStrLn "Warning: Linear texture filtering not enabled!"
|
||||
|
||||
let customOpenGL = SDL.OpenGLConfig {
|
||||
SDL.glColorPrecision = SDL.V4 8 8 8 0,
|
||||
SDL.glDepthPrecision = 24,
|
||||
SDL.glStencilPrecision = 8,
|
||||
SDL.glProfile = SDL.Core SDL.Debug 3 2,
|
||||
SDL.glMultisampleSamples = 1
|
||||
}
|
||||
|
||||
let (winW, winH) = fromMaybe defaultWindowSize (_apcWindowSize config)
|
||||
let windowHiDPI = fromMaybe defaultUseHdpi (_apcHdpi config)
|
||||
|
||||
window <-
|
||||
SDL.createWindow
|
||||
"SDL / OpenGL Example"
|
||||
@ -59,6 +49,19 @@ initSDLWindow config = do
|
||||
SDL.windowGraphicsContext = SDL.OpenGLContext customOpenGL
|
||||
}
|
||||
|
||||
-- Get device pixel rate
|
||||
SDL.V2 fbWidth fbHeight <- SDL.glGetDrawableSize window
|
||||
let dpr = fromIntegral fbWidth / fromIntegral winW
|
||||
|
||||
when (isJust (_apcWindowTitle config)) $
|
||||
SDL.windowTitle window $= fromJust (_apcWindowTitle config)
|
||||
|
||||
when windowFullscreen $
|
||||
SDL.setWindowMode window SDL.FullscreenDesktop
|
||||
|
||||
when windowMaximized $
|
||||
SDL.setWindowMode window SDL.Maximized
|
||||
|
||||
err <- SRE.getError
|
||||
err <- STR.peekCString err
|
||||
putStrLn err
|
||||
@ -67,12 +70,32 @@ initSDLWindow config = do
|
||||
|
||||
_ <- glewInit
|
||||
|
||||
return window
|
||||
return (window, dpr)
|
||||
where
|
||||
customOpenGL = SDL.OpenGLConfig {
|
||||
SDL.glColorPrecision = SDL.V4 8 8 8 0,
|
||||
SDL.glDepthPrecision = 24,
|
||||
SDL.glStencilPrecision = 8,
|
||||
SDL.glProfile = SDL.Core SDL.Debug 3 2,
|
||||
SDL.glMultisampleSamples = 1
|
||||
}
|
||||
(winW, winH) = case _apcWindowState config of
|
||||
Just (MainWindowNormal size) -> size
|
||||
_ -> defaultWindowSize
|
||||
windowHiDPI = fromMaybe defaultUseHdpi (_apcHdpi config)
|
||||
windowFullscreen = case _apcWindowState config of
|
||||
Just MainWindowFullScreen -> True
|
||||
_ -> False
|
||||
windowMaximized = case _apcWindowState config of
|
||||
Just MainWindowMaximized -> True
|
||||
_ -> False
|
||||
|
||||
|
||||
detroySDLWindow :: SDL.Window -> IO ()
|
||||
detroySDLWindow window = do
|
||||
putStrLn "About to destroyWindow"
|
||||
SDL.destroyWindow window
|
||||
Raw.quitSubSystem Raw.SDL_INIT_VIDEO
|
||||
SDL.quit
|
||||
|
||||
getCurrentMousePos :: (MonadIO m) => m Point
|
||||
|
@ -48,8 +48,15 @@ data MonomerContext s = MonomerContext {
|
||||
_mcCursorIcons :: Map CursorIcon SDLR.Cursor
|
||||
}
|
||||
|
||||
data MainWindowState
|
||||
= MainWindowNormal (Int, Int)
|
||||
| MainWindowMaximized
|
||||
| MainWindowFullScreen
|
||||
deriving (Eq, Show)
|
||||
|
||||
data AppConfig e = AppConfig {
|
||||
_apcWindowSize :: Maybe (Int, Int),
|
||||
_apcWindowState :: Maybe MainWindowState,
|
||||
_apcWindowTitle :: Maybe Text,
|
||||
_apcHdpi :: Maybe Bool,
|
||||
_apcFonts :: [FontDef],
|
||||
_apcTheme :: Maybe Theme,
|
||||
@ -58,7 +65,8 @@ data AppConfig e = AppConfig {
|
||||
|
||||
instance Default (AppConfig e) where
|
||||
def = AppConfig {
|
||||
_apcWindowSize = Nothing,
|
||||
_apcWindowState = Nothing,
|
||||
_apcWindowTitle = Nothing,
|
||||
_apcHdpi = Nothing,
|
||||
_apcFonts = [],
|
||||
_apcTheme = Nothing,
|
||||
@ -67,7 +75,8 @@ instance Default (AppConfig e) where
|
||||
|
||||
instance Semigroup (AppConfig e) where
|
||||
(<>) a1 a2 = AppConfig {
|
||||
_apcWindowSize = _apcWindowSize a2 <|> _apcWindowSize a1,
|
||||
_apcWindowState = _apcWindowState a2 <|> _apcWindowState a1,
|
||||
_apcWindowTitle = _apcWindowTitle a2 <|> _apcWindowTitle a1,
|
||||
_apcHdpi = _apcHdpi a2 <|> _apcHdpi a1,
|
||||
_apcFonts = _apcFonts a1 ++ _apcFonts a2,
|
||||
_apcTheme = _apcTheme a2 <|> _apcTheme a1,
|
||||
@ -77,10 +86,15 @@ instance Semigroup (AppConfig e) where
|
||||
instance Monoid (AppConfig e) where
|
||||
mempty = def
|
||||
|
||||
instance WindowSize (AppConfig e) (Int, Int) where
|
||||
windowSize size = def {
|
||||
_apcWindowSize = Just size
|
||||
}
|
||||
mainWindowState :: MainWindowState -> AppConfig e
|
||||
mainWindowState title = def {
|
||||
_apcWindowState = Just title
|
||||
}
|
||||
|
||||
mainWindowTitle :: Text -> AppConfig e
|
||||
mainWindowTitle title = def {
|
||||
_apcWindowTitle = Just title
|
||||
}
|
||||
|
||||
useHdpi :: Bool -> AppConfig e
|
||||
useHdpi use = def {
|
||||
|
Loading…
Reference in New Issue
Block a user