{-|
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
import Data.ByteString (ByteString)

-- | 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
  = MsgInit (WidgetEnv s e) (WidgetNode s e)
  | MsgRender (WidgetEnv s e) (WidgetNode s e)
  | MsgResize Size
  | MsgRemoveImage Text
  | forall i . MsgRunInRender (TChan i) (IO i)

-- | Result from attempting to set up the secondary rendering thread.
data RenderSetupResult
  = RenderSetupSingle
  | RenderSetupMulti
  | RenderSetupMakeCurrentFailed String
  deriving (RenderSetupResult -> RenderSetupResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderSetupResult -> RenderSetupResult -> Bool
$c/= :: RenderSetupResult -> RenderSetupResult -> Bool
== :: RenderSetupResult -> RenderSetupResult -> Bool
$c== :: RenderSetupResult -> RenderSetupResult -> Bool
Eq, Int -> RenderSetupResult -> ShowS
[RenderSetupResult] -> ShowS
RenderSetupResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderSetupResult] -> ShowS
$cshowList :: [RenderSetupResult] -> ShowS
show :: RenderSetupResult -> String
$cshow :: RenderSetupResult -> String
showsPrec :: Int -> RenderSetupResult -> ShowS
$cshowsPrec :: Int -> RenderSetupResult -> ShowS
Show)

{-|
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 -> Millisecond
_rsStart :: Millisecond,
  RenderSchedule -> Millisecond
_rsMs :: Millisecond,
  RenderSchedule -> Maybe Int
_rsRepeat :: Maybe Int
} deriving (RenderSchedule -> RenderSchedule -> Bool
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
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. 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
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
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.
  forall s e. MonomerCtx s e -> s
_mcMainModel :: s,
  -- | Active window.
  forall s e. MonomerCtx s e -> Window
_mcWindow :: ~SDL.Window,
  -- | Main window size.
  forall s e. MonomerCtx s e -> Size
_mcWindowSize :: Size,
  -- | Device pixel rate.
  forall s e. MonomerCtx s e -> Double
_mcDpr :: Double,
  -- | Event pixel rate.
  forall s e. MonomerCtx s e -> Double
_mcEpr :: Double,
  -- | Renderer instance or communication channel with the render thread.
  forall s e.
MonomerCtx s e -> Either Renderer (TChan (RenderMsg s e))
_mcRenderMethod :: Either Renderer (TChan (RenderMsg s e)),
  -- | Input status (mouse and keyboard).
  forall s e. MonomerCtx s e -> InputStatus
_mcInputStatus :: InputStatus,
  -- | Cursor icons (a stack is used because of parent -> child relationship).
  forall s e. MonomerCtx s e -> [(WidgetId, CursorIcon)]
_mcCursorStack :: [(WidgetId, CursorIcon)],
  -- | WidgetId of focused widget.
  forall s e. MonomerCtx s e -> WidgetId
_mcFocusedWidgetId :: WidgetId,
  -- | WidgetId of hovered widget, if any.
  forall s e. MonomerCtx s e -> Maybe WidgetId
_mcHoveredWidgetId :: Maybe WidgetId,
  -- | WidgetId of overlay widget, if any.
  forall s e. MonomerCtx s e -> Maybe WidgetId
_mcOverlayWidgetId :: Maybe WidgetId,
  -- | Active drag action, if any.
  forall s e. MonomerCtx s e -> Maybe DragAction
_mcDragAction :: Maybe DragAction,
  -- | Start point and target of latest main button press, if any.
  forall s e. MonomerCtx s e -> Maybe (Path, Point)
_mcMainBtnPress :: Maybe (Path, Point),
  -- | Active widget tasks.
  forall s e. MonomerCtx s e -> Seq WidgetTask
_mcWidgetTasks :: Seq WidgetTask,
  {-|
  Associations of WidgetId to updated paths. Only WidgetIds whose initial path
  changed are included.
  -}
  forall s e. MonomerCtx s e -> Map WidgetId Path
_mcWidgetPaths :: Map WidgetId Path,
  -- | Association of Monomer CursorIcon to SDL Cursors.
  forall s e. 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.
  -}
  forall s e. MonomerCtx s e -> Bool
_mcLeaveEnterPair :: Bool,
  -- | Widgets with pending resize requests.
  forall s e. MonomerCtx s e -> Seq WidgetId
_mcResizeRequests :: Seq WidgetId,
  -- | Flag indicating render was requested in this cycle.
  forall s e. MonomerCtx s e -> Bool
_mcRenderRequested :: Bool,
  -- | Active periodic rendering requests.
  forall s e. MonomerCtx s e -> Map WidgetId RenderSchedule
_mcRenderSchedule :: Map WidgetId RenderSchedule,
  -- | Whether there was a request to exit the application.
  forall s e. 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
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
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.
  forall e. AppConfig e -> Maybe MainWindowState
_apcWindowState :: Maybe MainWindowState,
  -- | Title of the main window.
  forall e. AppConfig e -> Maybe Text
_apcWindowTitle :: Maybe Text,
  -- | Whether the main window is resizable.
  forall e. AppConfig e -> Maybe Bool
_apcWindowResizable :: Maybe Bool,
  -- | Whether the main window has a border.
  forall e. AppConfig e -> Maybe Bool
_apcWindowBorder :: Maybe Bool,
  -- | Path to an icon file in BMP format.
  forall e. AppConfig e -> Maybe Text
_apcWindowIcon :: Maybe Text,
  -- | Whether a separate render thread should be used. Defaults to True.
  forall e. 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.
  -}
  forall e. 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 detected display scaling.
  -}
  forall e. AppConfig e -> Maybe Double
_apcScaleFactor :: Maybe Double,
  {-|
  Whether display scaling detection should not be attempted. If set to True, the
  display scale will be set to 1. This works together with 'appScaleFactor'.
  -}
  forall e. AppConfig e -> Maybe Bool
_apcDisableAutoScale :: Maybe Bool,
  {-|
  Available fonts to the application. An empty list will make it impossible to
  render text.
  -}
  forall e. AppConfig e -> [FontDef]
_apcFonts :: [FontDef],
  -- | Initial theme.
  forall e. AppConfig e -> Maybe Theme
_apcTheme :: Maybe Theme,
  -- | Initial event, useful for loading resources.
  forall e. AppConfig e -> [e]
_apcInitEvent :: [e],
  -- | Dispose event, useful for closing resources.
  forall e. AppConfig e -> [e]
_apcDisposeEvent :: [e],
  -- | Exit event, useful for cancelling an application close event.
  forall e. AppConfig e -> [e]
_apcExitEvent :: [e],
  -- | Resize event handler.
  forall e. AppConfig e -> [Rect -> e]
_apcResizeEvent :: [Rect -> e],
  -- | Defines which mouse button is considered main.
  forall e. AppConfig e -> Maybe Button
_apcMainButton :: Maybe Button,
  -- | Defines which mouse button is considered secondary or context button.
  forall e. AppConfig e -> Maybe Button
_apcContextButton :: Maybe Button,
  -- | Whether wheel/trackpad horizontal movement should be inverted.
  forall e. AppConfig e -> Maybe Bool
_apcInvertWheelX :: Maybe Bool,
  -- | Whether wheel/trackpad vertical movement should be inverted.
  forall e. AppConfig e -> Maybe Bool
_apcInvertWheelY :: Maybe Bool,
  -- | Whether compositing should be disabled. Defaults to False.
  forall e. AppConfig e -> Maybe Bool
_apcDisableCompositing :: Maybe Bool,
  -- | Whether the screensaver should be disabled. Defaults to False.
  forall e. AppConfig e -> Maybe Bool
_apcDisableScreensaver :: Maybe Bool
}

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

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

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

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

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

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

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

-- | Path to an icon file in BMP format.
appWindowIcon :: Text -> AppConfig e
appWindowIcon :: forall e. Text -> AppConfig e
appWindowIcon Text
path = forall a. Default a => a
def {
  _apcWindowIcon :: Maybe Text
_apcWindowIcon = forall a. a -> Maybe a
Just Text
path
}

{-|
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 configuration option was originally available to handle:

  - OpenGL driver issues which prevented normal startup showing the "Unable to
    make GL context current" error.
  - Single threaded applications (without -threaded) which cannot use forkOS.

This flag is no longer necessary for those cases, since the library will:

  - Attempt to fall back to rendering on the main thread if setting up a
    secondary rendering thread fails.
  - Will not attempt to set up a secondary rendering thread if the runtime does
    not support bound threads (i.e. compiled without the -threaded flag).
-}
{-# DEPRECATED appRenderOnMainThread
  "Should no longer be needed. Check appRenderOnMainThread's Haddock page." #-}
appRenderOnMainThread :: AppConfig e
appRenderOnMainThread :: forall e. AppConfig e
appRenderOnMainThread = forall a. Default a => a
def {
  _apcUseRenderThread :: Maybe Bool
_apcUseRenderThread = 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 :: forall e. Int -> AppConfig e
appMaxFps Int
fps = forall a. Default a => a
def {
  _apcMaxFps :: Maybe Int
_apcMaxFps = forall a. a -> Maybe a
Just Int
fps
}

{-|
Scale factor to apply to the viewport. This factor only affects the content, not
the size of the window. It is applied in addition to the detected display scale
factor, and can be useful if the detected value is not the desired.
-}
appScaleFactor :: Double -> AppConfig e
appScaleFactor :: forall e. Double -> AppConfig e
appScaleFactor Double
factor = forall a. Default a => a
def {
  _apcScaleFactor :: Maybe Double
_apcScaleFactor = forall a. a -> Maybe a
Just Double
factor
}

{-|
Whether display scaling detection should not be attempted. If set to True, the
display scale will be set to 1. This flag does not cause an effect on macOS.

Disabling auto scaling also affects window size on Linux and Windows in the
cases where the library would have applied scaling. This happens because window
and viewport size are the same in those operating systems. Window size can be
adjusted with 'appWindowState'.

The logic for detecting display scaling varies depending on the platform:

__macOS__

Scaling can be detected based on the window size and viewport size; the ratio
between these two give the scaling factor.

Using window and viewport size for detecting DPI only works on macOS; both
Windows and Linux return the same value for window and viewport size.

__Windows__

SDL_GetDisplayDPI returns the DPI of the screen, and dividing by 96 gives the
scaling factor. This factor is used to scale the window size and the content.

__Linux__

The situation is more complex, since SDL_GetDisplayDPI does not always return
valid information. There is not a practical DPI/scale detection solution that
works for all combinations of Linux display servers and window managers. Even
when using the most popular window managers, the scaling factor may be handled
differently by the distribution (GNOME in Ubuntu). For a reference of some of
the existing options for DPI scaling detection, check here:
https://wiki.archlinux.org/title/HiDPI.

Considering the above, when SDL_GetDisplayDPI fails, the library assumes that a
screen width larger than 1920 belongs to an HiDPI display and uses a scale
factor of 2. This factor is used to scale the window size and the content.
-}
appDisableAutoScale :: Bool -> AppConfig e
appDisableAutoScale :: forall e. Bool -> AppConfig e
appDisableAutoScale Bool
disable = forall a. Default a => a
def {
  _apcDisableAutoScale :: Maybe Bool
_apcDisableAutoScale = forall a. a -> Maybe a
Just Bool
disable
}

{-|
Available fonts to the application, loaded from the specified path. 
Specifying no fonts will make it impossible to render text.
-}
appFontDef :: Text -> Text -> AppConfig e
appFontDef :: forall e. Text -> Text -> AppConfig e
appFontDef Text
name Text
path = forall a. Default a => a
def {
  _apcFonts :: [FontDef]
_apcFonts = [ Text -> Text -> FontDef
FontDefFile Text
name Text
path ]
}

{-|
Available fonts to the application, loaded from the bytes in memory. 
Specifying no fonts will make it impossible to render text.

One use case for this function is to embed fonts in the application, without the need to distribute the font files.
The [file-embed](https://hackage.haskell.org/package/file-embed-0.0.15.0/docs/Data-FileEmbed.html) library can be used for this.
@
appFontDefMemory "memoryFont" $(embedFile "dirName/fileName")
@
-}
appFontDefMem :: Text -> ByteString -> AppConfig e
appFontDefMem :: forall e. Text -> ByteString -> AppConfig e
appFontDefMem Text
name ByteString
bytes = forall a. Default a => a
def {
  _apcFonts :: [FontDef]
_apcFonts = [ Text -> ByteString -> FontDef
FontDefMem Text
name ByteString
bytes ]
}

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

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

-- | Dispose event, useful for closing resources.
appDisposeEvent :: e -> AppConfig e
appDisposeEvent :: forall e. e -> AppConfig e
appDisposeEvent e
evt = 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 :: forall e. e -> AppConfig e
appExitEvent e
evt = forall a. Default a => a
def {
  _apcExitEvent :: [e]
_apcExitEvent = [e
evt]
}

-- | Resize event handler.
appResizeEvent :: (Rect -> e) -> AppConfig e
appResizeEvent :: forall e. (Rect -> e) -> AppConfig e
appResizeEvent Rect -> e
evt = 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 :: forall e. Button -> AppConfig e
appMainButton Button
btn = forall a. Default a => a
def {
  _apcMainButton :: Maybe Button
_apcMainButton = forall a. a -> Maybe a
Just Button
btn
}

-- | Defines which mouse button is considered secondary or context button.
appContextButton :: Button -> AppConfig e
appContextButton :: forall e. Button -> AppConfig e
appContextButton Button
btn = forall a. Default a => a
def {
  _apcContextButton :: Maybe Button
_apcContextButton = 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 :: forall e. Bool -> AppConfig e
appInvertWheelX Bool
invert = forall a. Default a => a
def {
  _apcInvertWheelX :: Maybe Bool
_apcInvertWheelX = 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 :: forall e. Bool -> AppConfig e
appInvertWheelY Bool
invert = forall a. Default a => a
def {
  _apcInvertWheelY :: Maybe Bool
_apcInvertWheelY = forall a. a -> Maybe a
Just Bool
invert
}

{-|
Whether compositing should be disabled. Linux only, ignored in other platforms.
Defaults to False.

Desktop applications should leave compositing as is since disabling it may
cause visual glitches in other programs. When creating games or fullscreen
applications, disabling compositing may improve performance.
-}
appDisableCompositing :: Bool -> AppConfig e
appDisableCompositing :: forall e. Bool -> AppConfig e
appDisableCompositing Bool
disable = forall a. Default a => a
def {
  _apcDisableCompositing :: Maybe Bool
_apcDisableCompositing = forall a. a -> Maybe a
Just Bool
disable
}

{-|
Whether the screensaver should be disabled. Defaults to False.

Desktop applications should leave the screensaver as is since disabling it also
affects power saving features, including turning off the screen. When creating
games or fullscreen applications, disabling the screensaver may make sense.
-}
appDisableScreensaver :: Bool -> AppConfig e
appDisableScreensaver :: forall e. Bool -> AppConfig e
appDisableScreensaver Bool
disable = forall a. Default a => a
def {
  _apcDisableScreensaver :: Maybe Bool
_apcDisableScreensaver = forall a. a -> Maybe a
Just Bool
disable
}