{-|
Module      : Monomer.Main.Types
Copyright   : (c) 2018 Francisco Vallarino
License     : BSD-3-Clause (see the LICENSE file)
Maintainer  : fjvallarino@gmail.com
Stability   : experimental
Portability : non-portable

Basic types for Main module.
-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Strict #-}

module Monomer.Main.Types where

import Control.Applicative ((<|>))
import Control.Concurrent.Async
import Control.Concurrent.STM.TChan
import Control.Monad.Catch
import Control.Monad.State
import Data.Default
import Data.Map (Map)
import Data.Text (Text)
import Data.Typeable (Typeable)
import Data.Sequence (Seq)
import GHC.Generics

import qualified Data.Map as M
import qualified SDL
import qualified SDL.Raw.Types as SDLR

import Monomer.Common
import Monomer.Core.Combinators
import Monomer.Core.StyleTypes
import Monomer.Core.ThemeTypes
import Monomer.Core.WidgetTypes
import Monomer.Event.Types
import Monomer.Graphics.Types

-- | Main Monomer monad.
type MonomerM s e m = (Eq s, MonadState (MonomerCtx s e) m, MonadCatch m, MonadIO m)

-- | Messages received by the rendering thread.
data RenderMsg s e
  = MsgRender (WidgetEnv s e) (WidgetNode s e)
  | MsgResize Size
  | MsgRemoveImage Text
  | forall i . MsgRunInRender (TChan i) (IO i)

{-|
Requirements for periodic rendering by a widget. Start time is stored to
calculate next frame based on the step ms. A maximum number of repetitions may
be provided.
-}
data RenderSchedule = RenderSchedule {
  RenderSchedule -> WidgetId
_rsWidgetId :: WidgetId,
  RenderSchedule -> Int
_rsStart :: Int,
  RenderSchedule -> Int
_rsMs :: Int,
  RenderSchedule -> Maybe Int
_rsRepeat :: Maybe Int
} deriving (RenderSchedule -> RenderSchedule -> Bool
(RenderSchedule -> RenderSchedule -> Bool)
-> (RenderSchedule -> RenderSchedule -> Bool) -> Eq RenderSchedule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderSchedule -> RenderSchedule -> Bool
$c/= :: RenderSchedule -> RenderSchedule -> Bool
== :: RenderSchedule -> RenderSchedule -> Bool
$c== :: RenderSchedule -> RenderSchedule -> Bool
Eq, Int -> RenderSchedule -> ShowS
[RenderSchedule] -> ShowS
RenderSchedule -> String
(Int -> RenderSchedule -> ShowS)
-> (RenderSchedule -> String)
-> ([RenderSchedule] -> ShowS)
-> Show RenderSchedule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderSchedule] -> ShowS
$cshowList :: [RenderSchedule] -> ShowS
show :: RenderSchedule -> String
$cshow :: RenderSchedule -> String
showsPrec :: Int -> RenderSchedule -> ShowS
$cshowsPrec :: Int -> RenderSchedule -> ShowS
Show, (forall x. RenderSchedule -> Rep RenderSchedule x)
-> (forall x. Rep RenderSchedule x -> RenderSchedule)
-> Generic RenderSchedule
forall x. Rep RenderSchedule x -> RenderSchedule
forall x. RenderSchedule -> Rep RenderSchedule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RenderSchedule x -> RenderSchedule
$cfrom :: forall x. RenderSchedule -> Rep RenderSchedule x
Generic)

-- | Drag action started by "WidgetId", with an associated message.
data DragAction = DragAction {
  DragAction -> WidgetId
_dgaWidgetId :: WidgetId,
  DragAction -> WidgetDragMsg
_dgaDragData :: WidgetDragMsg
} deriving (DragAction -> DragAction -> Bool
(DragAction -> DragAction -> Bool)
-> (DragAction -> DragAction -> Bool) -> Eq DragAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DragAction -> DragAction -> Bool
$c/= :: DragAction -> DragAction -> Bool
== :: DragAction -> DragAction -> Bool
$c== :: DragAction -> DragAction -> Bool
Eq, Int -> DragAction -> ShowS
[DragAction] -> ShowS
DragAction -> String
(Int -> DragAction -> ShowS)
-> (DragAction -> String)
-> ([DragAction] -> ShowS)
-> Show DragAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DragAction] -> ShowS
$cshowList :: [DragAction] -> ShowS
show :: DragAction -> String
$cshow :: DragAction -> String
showsPrec :: Int -> DragAction -> ShowS
$cshowsPrec :: Int -> DragAction -> ShowS
Show)

{-|
Asychronous widget task. Results must be provided as user defined, Typeable,
types. Error handling should be done inside the task and reporting handled as
part of the user type.
-}
data WidgetTask
  -- | Task generating a single result (for example, an HTTP request).
  = forall i . Typeable i => WidgetTask WidgetId (Async i)
  -- | Task generating a multiple result (for example, a Socket).
  | forall i . Typeable i => WidgetProducer WidgetId (TChan i) (Async ())

-- | Current state of the Monomer runtime.
data MonomerCtx s e = MonomerCtx {
  -- | Main application model.
  MonomerCtx s e -> s
_mcMainModel :: s,
  -- | Active window.
  MonomerCtx s e -> Window
_mcWindow :: ~SDL.Window,
  -- | Main window size.
  MonomerCtx s e -> Size
_mcWindowSize :: Size,
  -- | Device pixel rate.
  MonomerCtx s e -> Double
_mcDpr :: Double,
  -- | Event pixel rate.
  MonomerCtx s e -> Double
_mcEpr :: Double,
  -- | Event pixel rate.
  MonomerCtx s e -> TChan (RenderMsg s e)
_mcRenderChannel :: TChan (RenderMsg s e),
  -- | Input status (mouse and keyboard).
  MonomerCtx s e -> InputStatus
_mcInputStatus :: InputStatus,
  -- | Cursor icons (a stack is used because of parent -> child relationship).
  MonomerCtx s e -> [(WidgetId, CursorIcon)]
_mcCursorStack :: [(WidgetId, CursorIcon)],
  -- | WidgetId of focused widget.
  MonomerCtx s e -> WidgetId
_mcFocusedWidgetId :: WidgetId,
  -- | WidgetId of hovered widget, if any.
  MonomerCtx s e -> Maybe WidgetId
_mcHoveredWidgetId :: Maybe WidgetId,
  -- | WidgetId of overlay widget, if any.
  MonomerCtx s e -> Maybe WidgetId
_mcOverlayWidgetId :: Maybe WidgetId,
  -- | Active drag action, if any.
  MonomerCtx s e -> Maybe DragAction
_mcDragAction :: Maybe DragAction,
  -- | Start point and target of latest main button press, if any.
  MonomerCtx s e -> Maybe (Path, Point)
_mcMainBtnPress :: Maybe (Path, Point),
  -- | Active widget tasks.
  MonomerCtx s e -> Seq WidgetTask
_mcWidgetTasks :: Seq WidgetTask,
  {-|
  Associations of WidgetId to updated paths. Only WidgetIds whose initial path
  changed are included.
  -}
  MonomerCtx s e -> Map WidgetId Path
_mcWidgetPaths :: Map WidgetId Path,
  -- | Association of Monomer CursorIcon to SDL Cursors.
  MonomerCtx s e -> Map CursorIcon Cursor
_mcCursorIcons :: Map CursorIcon SDLR.Cursor,
  {-|
  Hacky flag to avoid resizing when transitioning hover. Needed because sizes
  may change and new target of hover should not change.
  -}
  MonomerCtx s e -> Bool
_mcLeaveEnterPair :: Bool,
  -- | Widgets with pending resize requests.
  MonomerCtx s e -> Seq WidgetId
_mcResizeRequests :: Seq WidgetId,
  -- | Flag indicating render was requested in this cycle.
  MonomerCtx s e -> Bool
_mcRenderRequested :: Bool,
  -- | Active periodic rendering requests.
  MonomerCtx s e -> Map WidgetId RenderSchedule
_mcRenderSchedule :: Map WidgetId RenderSchedule,
  -- | Whether there was a request to exit the application.
  MonomerCtx s e -> Bool
_mcExitApplication :: Bool
}

-- | Requests for main window size.
data MainWindowState
  -- | Normal window with a given size.
  = MainWindowNormal (Int, Int)
  -- | Maximized window.
  | MainWindowMaximized
  -- | Full screen window.
  | MainWindowFullScreen
  deriving (MainWindowState -> MainWindowState -> Bool
(MainWindowState -> MainWindowState -> Bool)
-> (MainWindowState -> MainWindowState -> Bool)
-> Eq MainWindowState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MainWindowState -> MainWindowState -> Bool
$c/= :: MainWindowState -> MainWindowState -> Bool
== :: MainWindowState -> MainWindowState -> Bool
$c== :: MainWindowState -> MainWindowState -> Bool
Eq, Int -> MainWindowState -> ShowS
[MainWindowState] -> ShowS
MainWindowState -> String
(Int -> MainWindowState -> ShowS)
-> (MainWindowState -> String)
-> ([MainWindowState] -> ShowS)
-> Show MainWindowState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MainWindowState] -> ShowS
$cshowList :: [MainWindowState] -> ShowS
show :: MainWindowState -> String
$cshow :: MainWindowState -> String
showsPrec :: Int -> MainWindowState -> ShowS
$cshowsPrec :: Int -> MainWindowState -> ShowS
Show)

-- | Main application config.
data AppConfig e = AppConfig {
  -- | Initial size of the main window.
  AppConfig e -> Maybe MainWindowState
_apcWindowState :: Maybe MainWindowState,
  -- | Title of the main window.
  AppConfig e -> Maybe Text
_apcWindowTitle :: Maybe Text,
  -- | Whether the main window is resizable.
  AppConfig e -> Maybe Bool
_apcWindowResizable :: Maybe Bool,
  -- | Whether the main window has a border.
  AppConfig e -> Maybe Bool
_apcWindowBorder :: Maybe Bool,
  -- | Whether a separate render thread should be used. Defaults to True.
  AppConfig e -> Maybe Bool
_apcUseRenderThread :: Maybe Bool,
  {-|
  Max number of FPS the application will run at. It does not necessarily mean
  rendering will happen every frame, but events and schedules will be checked at
  this rate.
  -}
  AppConfig e -> Maybe Int
_apcMaxFps :: Maybe Int,
  {-|
  Scale factor to apply. This factor only affects the content, not the size of
  the window. It is applied in addition to the OS zoom in plaforms where it is
  reliably detected (i.e., system scaling may not be detected reliably on Linux)
  -}
  AppConfig e -> Maybe Double
_apcScaleFactor :: Maybe Double,
  {-|
  Available fonts to the application. An empty list will make it impossible to
  render text.
  -}
  AppConfig e -> [FontDef]
_apcFonts :: [FontDef],
  -- | Initial theme.
  AppConfig e -> Maybe Theme
_apcTheme :: Maybe Theme,
  -- | Initial event, useful for loading resources.
  AppConfig e -> [e]
_apcInitEvent :: [e],
  -- | Dispose event, useful for closing resources.
  AppConfig e -> [e]
_apcDisposeEvent :: [e],
  -- | Exit event, useful for cancelling an application close event.
  AppConfig e -> [e]
_apcExitEvent :: [e],
  -- | Resize event handler.
  AppConfig e -> [Rect -> e]
_apcResizeEvent :: [Rect -> e],
  -- | Defines which mouse button is considered main.
  AppConfig e -> Maybe Button
_apcMainButton :: Maybe Button,
  -- | Defines which mouse button is considered secondary or context button.
  AppConfig e -> Maybe Button
_apcContextButton :: Maybe Button,
  -- | Whether wheel/trackpad horizontal movement should be inverted.
  AppConfig e -> Maybe Bool
_apcInvertWheelX :: Maybe Bool,
  -- | Whether wheel/trackpad vertical movement should be inverted.
  AppConfig e -> Maybe Bool
_apcInvertWheelY :: Maybe Bool
}

instance Default (AppConfig e) where
  def :: AppConfig e
def = AppConfig :: forall e.
Maybe MainWindowState
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Int
-> Maybe Double
-> [FontDef]
-> Maybe Theme
-> [e]
-> [e]
-> [e]
-> [Rect -> e]
-> Maybe Button
-> Maybe Button
-> Maybe Bool
-> Maybe Bool
-> AppConfig e
AppConfig {
    _apcWindowState :: Maybe MainWindowState
_apcWindowState = Maybe MainWindowState
forall a. Maybe a
Nothing,
    _apcWindowTitle :: Maybe Text
_apcWindowTitle = Maybe Text
forall a. Maybe a
Nothing,
    _apcWindowResizable :: Maybe Bool
_apcWindowResizable = Maybe Bool
forall a. Maybe a
Nothing,
    _apcWindowBorder :: Maybe Bool
_apcWindowBorder = Maybe Bool
forall a. Maybe a
Nothing,
    _apcUseRenderThread :: Maybe Bool
_apcUseRenderThread = Maybe Bool
forall a. Maybe a
Nothing,
    _apcMaxFps :: Maybe Int
_apcMaxFps = Maybe Int
forall a. Maybe a
Nothing,
    _apcScaleFactor :: Maybe Double
_apcScaleFactor = Maybe Double
forall a. Maybe a
Nothing,
    _apcFonts :: [FontDef]
_apcFonts = [],
    _apcTheme :: Maybe Theme
_apcTheme = Maybe Theme
forall a. Maybe a
Nothing,
    _apcInitEvent :: [e]
_apcInitEvent = [],
    _apcDisposeEvent :: [e]
_apcDisposeEvent = [],
    _apcExitEvent :: [e]
_apcExitEvent = [],
    _apcResizeEvent :: [Rect -> e]
_apcResizeEvent = [],
    _apcMainButton :: Maybe Button
_apcMainButton = Maybe Button
forall a. Maybe a
Nothing,
    _apcContextButton :: Maybe Button
_apcContextButton = Maybe Button
forall a. Maybe a
Nothing,
    _apcInvertWheelX :: Maybe Bool
_apcInvertWheelX = Maybe Bool
forall a. Maybe a
Nothing,
    _apcInvertWheelY :: Maybe Bool
_apcInvertWheelY = Maybe Bool
forall a. Maybe a
Nothing
  }

instance Semigroup (AppConfig e) where
  <> :: AppConfig e -> AppConfig e -> AppConfig e
(<>) AppConfig e
a1 AppConfig e
a2 = AppConfig :: forall e.
Maybe MainWindowState
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Int
-> Maybe Double
-> [FontDef]
-> Maybe Theme
-> [e]
-> [e]
-> [e]
-> [Rect -> e]
-> Maybe Button
-> Maybe Button
-> Maybe Bool
-> Maybe Bool
-> AppConfig e
AppConfig {
    _apcWindowState :: Maybe MainWindowState
_apcWindowState = AppConfig e -> Maybe MainWindowState
forall e. AppConfig e -> Maybe MainWindowState
_apcWindowState AppConfig e
a2 Maybe MainWindowState
-> Maybe MainWindowState -> Maybe MainWindowState
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AppConfig e -> Maybe MainWindowState
forall e. AppConfig e -> Maybe MainWindowState
_apcWindowState AppConfig e
a1,
    _apcWindowTitle :: Maybe Text
_apcWindowTitle = AppConfig e -> Maybe Text
forall e. AppConfig e -> Maybe Text
_apcWindowTitle AppConfig e
a2 Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AppConfig e -> Maybe Text
forall e. AppConfig e -> Maybe Text
_apcWindowTitle AppConfig e
a1,
    _apcWindowResizable :: Maybe Bool
_apcWindowResizable = AppConfig e -> Maybe Bool
forall e. AppConfig e -> Maybe Bool
_apcWindowResizable AppConfig e
a2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AppConfig e -> Maybe Bool
forall e. AppConfig e -> Maybe Bool
_apcWindowResizable AppConfig e
a1,
    _apcWindowBorder :: Maybe Bool
_apcWindowBorder = AppConfig e -> Maybe Bool
forall e. AppConfig e -> Maybe Bool
_apcWindowBorder AppConfig e
a2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AppConfig e -> Maybe Bool
forall e. AppConfig e -> Maybe Bool
_apcWindowBorder AppConfig e
a1,
    _apcUseRenderThread :: Maybe Bool
_apcUseRenderThread = AppConfig e -> Maybe Bool
forall e. AppConfig e -> Maybe Bool
_apcUseRenderThread AppConfig e
a2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AppConfig e -> Maybe Bool
forall e. AppConfig e -> Maybe Bool
_apcUseRenderThread AppConfig e
a1,
    _apcMaxFps :: Maybe Int
_apcMaxFps = AppConfig e -> Maybe Int
forall e. AppConfig e -> Maybe Int
_apcMaxFps AppConfig e
a2 Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AppConfig e -> Maybe Int
forall e. AppConfig e -> Maybe Int
_apcMaxFps AppConfig e
a1,
    _apcScaleFactor :: Maybe Double
_apcScaleFactor = AppConfig e -> Maybe Double
forall e. AppConfig e -> Maybe Double
_apcScaleFactor AppConfig e
a2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AppConfig e -> Maybe Double
forall e. AppConfig e -> Maybe Double
_apcScaleFactor AppConfig e
a1,
    _apcFonts :: [FontDef]
_apcFonts = AppConfig e -> [FontDef]
forall e. AppConfig e -> [FontDef]
_apcFonts AppConfig e
a1 [FontDef] -> [FontDef] -> [FontDef]
forall a. [a] -> [a] -> [a]
++ AppConfig e -> [FontDef]
forall e. AppConfig e -> [FontDef]
_apcFonts AppConfig e
a2,
    _apcTheme :: Maybe Theme
_apcTheme = AppConfig e -> Maybe Theme
forall e. AppConfig e -> Maybe Theme
_apcTheme AppConfig e
a2 Maybe Theme -> Maybe Theme -> Maybe Theme
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AppConfig e -> Maybe Theme
forall e. AppConfig e -> Maybe Theme
_apcTheme AppConfig e
a1,
    _apcInitEvent :: [e]
_apcInitEvent = AppConfig e -> [e]
forall e. AppConfig e -> [e]
_apcInitEvent AppConfig e
a1 [e] -> [e] -> [e]
forall a. [a] -> [a] -> [a]
++ AppConfig e -> [e]
forall e. AppConfig e -> [e]
_apcInitEvent AppConfig e
a2,
    _apcDisposeEvent :: [e]
_apcDisposeEvent = AppConfig e -> [e]
forall e. AppConfig e -> [e]
_apcDisposeEvent AppConfig e
a1 [e] -> [e] -> [e]
forall a. [a] -> [a] -> [a]
++ AppConfig e -> [e]
forall e. AppConfig e -> [e]
_apcDisposeEvent AppConfig e
a2,
    _apcExitEvent :: [e]
_apcExitEvent = AppConfig e -> [e]
forall e. AppConfig e -> [e]
_apcExitEvent AppConfig e
a1 [e] -> [e] -> [e]
forall a. [a] -> [a] -> [a]
++ AppConfig e -> [e]
forall e. AppConfig e -> [e]
_apcExitEvent AppConfig e
a2,
    _apcResizeEvent :: [Rect -> e]
_apcResizeEvent = AppConfig e -> [Rect -> e]
forall e. AppConfig e -> [Rect -> e]
_apcResizeEvent AppConfig e
a1 [Rect -> e] -> [Rect -> e] -> [Rect -> e]
forall a. [a] -> [a] -> [a]
++ AppConfig e -> [Rect -> e]
forall e. AppConfig e -> [Rect -> e]
_apcResizeEvent AppConfig e
a2,
    _apcMainButton :: Maybe Button
_apcMainButton = AppConfig e -> Maybe Button
forall e. AppConfig e -> Maybe Button
_apcMainButton AppConfig e
a2 Maybe Button -> Maybe Button -> Maybe Button
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AppConfig e -> Maybe Button
forall e. AppConfig e -> Maybe Button
_apcMainButton AppConfig e
a1,
    _apcContextButton :: Maybe Button
_apcContextButton = AppConfig e -> Maybe Button
forall e. AppConfig e -> Maybe Button
_apcContextButton AppConfig e
a2 Maybe Button -> Maybe Button -> Maybe Button
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AppConfig e -> Maybe Button
forall e. AppConfig e -> Maybe Button
_apcContextButton AppConfig e
a1,
    _apcInvertWheelX :: Maybe Bool
_apcInvertWheelX = AppConfig e -> Maybe Bool
forall e. AppConfig e -> Maybe Bool
_apcInvertWheelX AppConfig e
a2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AppConfig e -> Maybe Bool
forall e. AppConfig e -> Maybe Bool
_apcInvertWheelX AppConfig e
a1,
    _apcInvertWheelY :: Maybe Bool
_apcInvertWheelY = AppConfig e -> Maybe Bool
forall e. AppConfig e -> Maybe Bool
_apcInvertWheelY AppConfig e
a2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AppConfig e -> Maybe Bool
forall e. AppConfig e -> Maybe Bool
_apcInvertWheelY AppConfig e
a1
  }

instance Monoid (AppConfig e) where
  mempty :: AppConfig e
mempty = AppConfig e
forall a. Default a => a
def

-- | Initial size of the main window.
appWindowState :: MainWindowState -> AppConfig e
appWindowState :: MainWindowState -> AppConfig e
appWindowState MainWindowState
title = AppConfig e
forall a. Default a => a
def {
  _apcWindowState :: Maybe MainWindowState
_apcWindowState = MainWindowState -> Maybe MainWindowState
forall a. a -> Maybe a
Just MainWindowState
title
}

-- | Title of the main window.
appWindowTitle :: Text -> AppConfig e
appWindowTitle :: Text -> AppConfig e
appWindowTitle Text
title = AppConfig e
forall a. Default a => a
def {
  _apcWindowTitle :: Maybe Text
_apcWindowTitle = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
title
}

-- | Whether the main window is resizable.
appWindowResizable :: Bool -> AppConfig e
appWindowResizable :: Bool -> AppConfig e
appWindowResizable Bool
resizable = AppConfig e
forall a. Default a => a
def {
  _apcWindowResizable :: Maybe Bool
_apcWindowResizable = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
resizable
}

-- | Whether the main window has a border.
appWindowBorder :: Bool -> AppConfig e
appWindowBorder :: Bool -> AppConfig e
appWindowBorder Bool
border = AppConfig e
forall a. Default a => a
def {
  _apcWindowBorder :: Maybe Bool
_apcWindowBorder = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
border
}

{-|
Performs rendering on the main thread. On macOS and Windows this also disables
continuous rendering on window resize, but in some Linux configurations it still
works.

This option is useful when OpenGL driver issues prevent normal startup showing
the "Unable to make GL context current" error.

It can also be used for single threaded applications (without -threaded).
-}
appRenderOnMainThread :: AppConfig e
appRenderOnMainThread :: AppConfig e
appRenderOnMainThread = AppConfig e
forall a. Default a => a
def {
  _apcUseRenderThread :: Maybe Bool
_apcUseRenderThread = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
}

{-|
Max number of FPS the application will run on. It does not necessarily mean
rendering will happen every frame, but events and schedules will be checked at
this rate and may cause it.
-}
appMaxFps :: Int -> AppConfig e
appMaxFps :: Int -> AppConfig e
appMaxFps Int
fps = AppConfig e
forall a. Default a => a
def {
  _apcMaxFps :: Maybe Int
_apcMaxFps = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
fps
}

{-|
Scale factor to apply. This factor only affects the content, not the size of the
window. It is applied in addition to the OS zoom in plaforms where it is
reliably detected (i.e., system scaling may not be detected reliably on Linux).
-}
appScaleFactor :: Double -> AppConfig e
appScaleFactor :: Double -> AppConfig e
appScaleFactor Double
factor = AppConfig e
forall a. Default a => a
def {
  _apcScaleFactor :: Maybe Double
_apcScaleFactor = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
factor
}

{-|
Available fonts to the application. An empty list will make it impossible to
render text.
-}
appFontDef :: Text -> Text -> AppConfig e
appFontDef :: Text -> Text -> AppConfig e
appFontDef Text
name Text
path = AppConfig e
forall a. Default a => a
def {
  _apcFonts :: [FontDef]
_apcFonts = [ Text -> Text -> FontDef
FontDef Text
name Text
path ]
}

-- | Initial theme.
appTheme :: Theme -> AppConfig e
appTheme :: Theme -> AppConfig e
appTheme Theme
t = AppConfig e
forall a. Default a => a
def {
  _apcTheme :: Maybe Theme
_apcTheme = Theme -> Maybe Theme
forall a. a -> Maybe a
Just Theme
t
}

-- | Initial event, useful for loading resources.
appInitEvent :: e -> AppConfig e
appInitEvent :: e -> AppConfig e
appInitEvent e
evt = AppConfig e
forall a. Default a => a
def {
  _apcInitEvent :: [e]
_apcInitEvent = [e
evt]
}

-- | Dispose event, useful for closing resources.
appDisposeEvent :: e -> AppConfig e
appDisposeEvent :: e -> AppConfig e
appDisposeEvent e
evt = AppConfig e
forall a. Default a => a
def {
  _apcDisposeEvent :: [e]
_apcDisposeEvent = [e
evt]
}

-- | Exit event, useful for cancelling an application close event.
appExitEvent :: e -> AppConfig e
appExitEvent :: e -> AppConfig e
appExitEvent e
evt = AppConfig e
forall a. Default a => a
def {
  _apcExitEvent :: [e]
_apcExitEvent = [e
evt]
}

-- | Resize event handler.
appResizeEvent :: (Rect -> e) -> AppConfig e
appResizeEvent :: (Rect -> e) -> AppConfig e
appResizeEvent Rect -> e
evt = AppConfig e
forall a. Default a => a
def {
  _apcResizeEvent :: [Rect -> e]
_apcResizeEvent = [Rect -> e
evt]
}

-- | Defines which mouse button is considered main.
appMainButton :: Button -> AppConfig e
appMainButton :: Button -> AppConfig e
appMainButton Button
btn = AppConfig e
forall a. Default a => a
def {
  _apcMainButton :: Maybe Button
_apcMainButton = Button -> Maybe Button
forall a. a -> Maybe a
Just Button
btn
}

-- | Defines which mouse button is considered secondary or context button.
appContextButton :: Button -> AppConfig e
appContextButton :: Button -> AppConfig e
appContextButton Button
btn = AppConfig e
forall a. Default a => a
def {
  _apcContextButton :: Maybe Button
_apcContextButton = Button -> Maybe Button
forall a. a -> Maybe a
Just Button
btn
}

{-|
Whether the horizontal wheel/trackpad movement should be inverted. In general
platform detection should do the right thing.
-}
appInvertWheelX :: Bool -> AppConfig e
appInvertWheelX :: Bool -> AppConfig e
appInvertWheelX Bool
invert = AppConfig e
forall a. Default a => a
def {
  _apcInvertWheelX :: Maybe Bool
_apcInvertWheelX = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
invert
}

{-|
Whether the vertical wheel/trackpad movement should be inverted. In general
platform detection should do the right thing.
-}
appInvertWheelY :: Bool -> AppConfig e
appInvertWheelY :: Bool -> AppConfig e
appInvertWheelY Bool
invert = AppConfig e
forall a. Default a => a
def {
  _apcInvertWheelY :: Maybe Bool
_apcInvertWheelY = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
invert
}