Copyright | (c) 2018 Francisco Vallarino |
---|---|
License | BSD-3-Clause (see the LICENSE file) |
Maintainer | fjvallarino@gmail.com |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
Basic types for Main module.
Synopsis
- type MonomerM s e m = (Eq s, MonadState (MonomerCtx s e) m, MonadCatch m, MonadIO m)
- data RenderMsg s e
- = MsgRender (WidgetEnv s e) (WidgetNode s e)
- | MsgResize Size
- | MsgRemoveImage Text
- data RenderSchedule = RenderSchedule {}
- data DragAction = DragAction {}
- data WidgetTask
- = forall i.Typeable i => WidgetTask WidgetId (Async i)
- | forall i.Typeable i => WidgetProducer WidgetId (TChan i) (Async ())
- data MonomerCtx s e = MonomerCtx {
- _mcMainModel :: s
- _mcWindow :: Window
- _mcWindowSize :: Size
- _mcDpr :: Double
- _mcEpr :: Double
- _mcRenderChannel :: TChan (RenderMsg s e)
- _mcInputStatus :: InputStatus
- _mcCursorStack :: [(WidgetId, CursorIcon)]
- _mcFocusedWidgetId :: WidgetId
- _mcHoveredWidgetId :: Maybe WidgetId
- _mcOverlayWidgetId :: Maybe WidgetId
- _mcDragAction :: Maybe DragAction
- _mcMainBtnPress :: Maybe (Path, Point)
- _mcWidgetTasks :: Seq WidgetTask
- _mcWidgetPaths :: Map WidgetId Path
- _mcCursorIcons :: Map CursorIcon Cursor
- _mcLeaveEnterPair :: Bool
- _mcResizeRequests :: Seq WidgetId
- _mcRenderRequested :: Bool
- _mcRenderSchedule :: Map WidgetId RenderSchedule
- _mcExitApplication :: Bool
- data MainWindowState
- data AppConfig e = AppConfig {
- _apcWindowState :: Maybe MainWindowState
- _apcWindowTitle :: Maybe Text
- _apcWindowResizable :: Maybe Bool
- _apcWindowBorder :: Maybe Bool
- _apcMaxFps :: Maybe Int
- _apcScaleFactor :: Maybe Double
- _apcFonts :: [FontDef]
- _apcTheme :: Maybe Theme
- _apcInitEvent :: [e]
- _apcDisposeEvent :: [e]
- _apcExitEvent :: [e]
- _apcResizeEvent :: [Rect -> e]
- _apcMainButton :: Maybe Button
- _apcContextButton :: Maybe Button
- appWindowState :: MainWindowState -> AppConfig e
- appWindowTitle :: Text -> AppConfig e
- appWindowResizable :: Bool -> AppConfig e
- appWindowBorder :: Bool -> AppConfig e
- appMaxFps :: Int -> AppConfig e
- appScaleFactor :: Double -> AppConfig e
- appFontDef :: Text -> Text -> AppConfig e
- appTheme :: Theme -> AppConfig e
- appInitEvent :: e -> AppConfig e
- appDisposeEvent :: e -> AppConfig e
- appExitEvent :: e -> AppConfig e
- appResizeEvent :: (Rect -> e) -> AppConfig e
- appMainButton :: Button -> AppConfig e
- appContextButton :: Button -> AppConfig e
Documentation
type MonomerM s e m = (Eq s, MonadState (MonomerCtx s e) m, MonadCatch m, MonadIO m) Source #
Main Monomer monad.
Messages received by the rendering thread.
MsgRender (WidgetEnv s e) (WidgetNode s e) | |
MsgResize Size | |
MsgRemoveImage Text |
Instances
Show (RenderMsg s e) Source # | |
HasRenderChannel (MonomerCtx s e) (TChan (RenderMsg s e)) Source # | |
Defined in Monomer.Main.Lens renderChannel :: Lens' (MonomerCtx s e) (TChan (RenderMsg s e)) Source # |
data RenderSchedule Source #
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.
Instances
data DragAction Source #
Drag action started by WidgetId, with an associated message.
Instances
Eq DragAction Source # | |
Defined in Monomer.Main.Types (==) :: DragAction -> DragAction -> Bool # (/=) :: DragAction -> DragAction -> Bool # | |
Show DragAction Source # | |
Defined in Monomer.Main.Types showsPrec :: Int -> DragAction -> ShowS # show :: DragAction -> String # showList :: [DragAction] -> ShowS # | |
HasWidgetId DragAction WidgetId Source # | |
Defined in Monomer.Main.Lens | |
HasDragData DragAction WidgetDragMsg Source # | |
Defined in Monomer.Main.Lens | |
HasDragAction (MonomerCtx s e) (Maybe DragAction) Source # | |
Defined in Monomer.Main.Lens dragAction :: Lens' (MonomerCtx s e) (Maybe DragAction) Source # |
data WidgetTask Source #
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.
forall i.Typeable i => WidgetTask WidgetId (Async i) | Task generating a single result (for example, an HTTP request). |
forall i.Typeable i => WidgetProducer WidgetId (TChan i) (Async ()) | Task generating a multiple result (for example, a Socket). |
Instances
HasWidgetTasks (MonomerCtx s e) (Seq WidgetTask) Source # | |
Defined in Monomer.Main.Lens widgetTasks :: Lens' (MonomerCtx s e) (Seq WidgetTask) Source # |
data MonomerCtx s e Source #
Current state of the Monomer runtime.
MonomerCtx | |
|
Instances
data MainWindowState Source #
Requests for main window size.
MainWindowNormal (Int, Int) | Normal window with a given size. |
MainWindowMaximized | Maximized window. |
MainWindowFullScreen | Full screen window. |
Instances
Eq MainWindowState Source # | |
Defined in Monomer.Main.Types (==) :: MainWindowState -> MainWindowState -> Bool # (/=) :: MainWindowState -> MainWindowState -> Bool # | |
Show MainWindowState Source # | |
Defined in Monomer.Main.Types showsPrec :: Int -> MainWindowState -> ShowS # show :: MainWindowState -> String # showList :: [MainWindowState] -> ShowS # | |
HasWindowState (AppConfig e) (Maybe MainWindowState) Source # | |
Defined in Monomer.Main.Lens windowState :: Lens' (AppConfig e) (Maybe MainWindowState) Source # |
Main application config.
AppConfig | |
|
Instances
appWindowState :: MainWindowState -> AppConfig e Source #
Initial size of the main window.
appWindowTitle :: Text -> AppConfig e Source #
Title of the main window.
appWindowResizable :: Bool -> AppConfig e Source #
Whether the main window is resizable.
appWindowBorder :: Bool -> AppConfig e Source #
Whether the main window has a border.
appMaxFps :: Int -> AppConfig e Source #
Max number of FPS the application will run. It does not necessarily mean rendering will happen every frame, but events and schedules will be checked at this rate and may cause it.
appScaleFactor :: Double -> AppConfig e Source #
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).
appFontDef :: Text -> Text -> AppConfig e Source #
Available fonts to the application. An empty list will make it impossible to render text.
appInitEvent :: e -> AppConfig e Source #
Initial event, useful for loading resources.
appDisposeEvent :: e -> AppConfig e Source #
Dispose event, useful for closing resources.
appExitEvent :: e -> AppConfig e Source #
Exit event, useful for cancelling an application close event.
appResizeEvent :: (Rect -> e) -> AppConfig e Source #
Resize event handler.
appMainButton :: Button -> AppConfig e Source #
Defines which mouse button is considered main.
appContextButton :: Button -> AppConfig e Source #
Defines which mouse button is considered secondary or context button.