Add config options for window maximized, fullscreen and title

app/Main.hs

@@ -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

src/Monomer/Core/Combinators.hs

@@ -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

src/Monomer/Core/WidgetTypes.hs

@@ -30,8 +30,8 @@ data TextOverflow
   deriving (Eq, Show)
 
 data WindowRequest
-  = WindowTitle Text
+  = WindowSetTitle Text
-  | WindowFullScreen
+  | WindowSetFullScreen
   | WindowMaximize
   | WindowMinimize
   | WindowRestore

src/Monomer/Main/Core.hs

@@ -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)

src/Monomer/Main/Handlers.hs

@@ -242,8 +242,8 @@ handleUpdateWindow
 handleUpdateWindow windowRequest previousStep = do
   window <- use L.window
   case windowRequest of
-    WindowTitle title -> SDL.windowTitle window $= title
+    WindowSetTitle title -> SDL.windowTitle window $= title
-    WindowFullScreen -> SDL.setWindowMode window SDL.FullscreenDesktop
+    WindowSetFullScreen -> SDL.setWindowMode window SDL.FullscreenDesktop
     WindowMaximize -> SDL.setWindowMode window SDL.Maximized
     WindowMinimize -> SDL.setWindowMode window SDL.Minimized
     WindowRestore -> SDL.setWindowMode window SDL.Windowed

src/Monomer/Main/Platform.hs

@@ -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

src/Monomer/Main/Types.hs

@@ -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,9 +86,14 @@ instance Semigroup (AppConfig e) where
 instance Monoid (AppConfig e) where
   mempty = def
 
-instance WindowSize (AppConfig e) (Int, Int) where
+mainWindowState :: MainWindowState -> AppConfig e
-  windowSize size = def {
+mainWindowState title = def {
-    _apcWindowSize = Just size
+  _apcWindowState = Just title
+}
+
+mainWindowTitle :: Text -> AppConfig e
+mainWindowTitle title = def {
+  _apcWindowTitle = Just title
 }
 
 useHdpi :: Bool -> AppConfig e