{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Strict #-}
module Monomer.Widgets.Single (
module Monomer.Core,
module Monomer.Core.Combinators,
module Monomer.Event,
module Monomer.Graphics,
module Monomer.Widgets.Util,
SingleGetBaseStyle,
SingleGetCurrentStyle,
SingleInitHandler,
SingleMergeHandler,
SingleDisposeHandler,
SingleFindNextFocusHandler,
SingleFindByPointHandler,
SingleEventHandler,
SingleMessageHandler,
SingleGetSizeReqHandler,
SingleResizeHandler,
SingleRenderHandler,
Single(..),
createSingle
) where
import Control.Exception (AssertionFailed(..), throw)
import Control.Lens ((&), (^.), (^?), (.~), (%~), _Just)
import Control.Monad (when)
import Data.Default
import Data.Maybe
import Data.Sequence (Seq(..), (|>))
import Data.Typeable (Typeable, cast)
import qualified Data.Sequence as Seq
import Monomer.Core
import Monomer.Core.Combinators
import Monomer.Event
import Monomer.Graphics
import Monomer.Helper
import Monomer.Widgets.Util
import qualified Monomer.Core.Lens as L
type SingleGetBaseStyle s e
= GetBaseStyle s e
type SingleGetCurrentStyle s e
= WidgetEnv s e
-> WidgetNode s e
-> StyleState
type SingleInitHandler s e
= WidgetEnv s e
-> WidgetNode s e
-> WidgetResult s e
type SingleMergeHandler s e a
= WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> a
-> WidgetResult s e
type SingleDisposeHandler s e
= WidgetEnv s e
-> WidgetNode s e
-> WidgetResult s e
type SingleFindNextFocusHandler s e
= WidgetEnv s e
-> WidgetNode s e
-> FocusDirection
-> Path
-> Maybe WidgetNodeInfo
type SingleFindByPointHandler s e
= WidgetEnv s e
-> WidgetNode s e
-> Path
-> Point
-> Maybe WidgetNodeInfo
type SingleEventHandler s e
= WidgetEnv s e
-> WidgetNode s e
-> Path
-> SystemEvent
-> Maybe (WidgetResult s e)
type SingleMessageHandler s e
= forall i . Typeable i
=> WidgetEnv s e
-> WidgetNode s e
-> Path
-> i
-> Maybe (WidgetResult s e)
type SingleGetSizeReqHandler s e
= WidgetEnv s e
-> WidgetNode s e
-> (SizeReq, SizeReq)
type SingleResizeHandler s e
= WidgetEnv s e
-> WidgetNode s e
-> Rect
-> WidgetResult s e
type SingleRenderHandler s e
= WidgetEnv s e
-> WidgetNode s e
-> Renderer
-> IO ()
data Single s e a = Single {
forall s e a. Single s e a -> Bool
singleAddStyleReq :: Bool,
forall s e a. Single s e a -> Bool
singleDrawDecorations :: Bool,
forall s e a. Single s e a -> Bool
singleFocusOnBtnPressed :: Bool,
forall s e a. Single s e a -> Bool
singleUseCustomCursor :: Bool,
forall s e a. Single s e a -> Bool
singleUseCustomSize :: Bool,
forall s e a. Single s e a -> Bool
singleUseScissor :: Bool,
forall s e a. Single s e a -> SingleGetBaseStyle s e
singleGetBaseStyle :: SingleGetBaseStyle s e,
forall s e a. Single s e a -> SingleGetCurrentStyle s e
singleGetCurrentStyle :: SingleGetCurrentStyle s e,
forall s e a. Single s e a -> SingleInitHandler s e
singleInit :: SingleInitHandler s e,
forall s e a. Single s e a -> SingleMergeHandler s e a
singleMerge :: SingleMergeHandler s e a,
forall s e a. Single s e a -> SingleInitHandler s e
singleDispose :: SingleDisposeHandler s e,
forall s e a. Single s e a -> SingleFindNextFocusHandler s e
singleFindNextFocus :: SingleFindNextFocusHandler s e,
forall s e a. Single s e a -> SingleFindByPointHandler s e
singleFindByPoint :: SingleFindByPointHandler s e,
forall s e a. Single s e a -> SingleEventHandler s e
singleHandleEvent :: SingleEventHandler s e,
forall s e a. Single s e a -> SingleMessageHandler s e
singleHandleMessage :: SingleMessageHandler s e,
forall s e a. Single s e a -> SingleGetSizeReqHandler s e
singleGetSizeReq :: SingleGetSizeReqHandler s e,
forall s e a. Single s e a -> SingleResizeHandler s e
singleResize :: SingleResizeHandler s e,
forall s e a. Single s e a -> SingleRenderHandler s e
singleRender :: SingleRenderHandler s e
}
instance Default (Single s e a) where
def :: Single s e a
def = Single {
singleAddStyleReq :: Bool
singleAddStyleReq = Bool
True,
singleFocusOnBtnPressed :: Bool
singleFocusOnBtnPressed = Bool
True,
singleDrawDecorations :: Bool
singleDrawDecorations = Bool
True,
singleUseCustomCursor :: Bool
singleUseCustomCursor = Bool
False,
singleUseCustomSize :: Bool
singleUseCustomSize = Bool
False,
singleUseScissor :: Bool
singleUseScissor = Bool
False,
singleGetBaseStyle :: SingleGetBaseStyle s e
singleGetBaseStyle = forall s e. SingleGetBaseStyle s e
defaultGetBaseStyle,
singleGetCurrentStyle :: SingleGetCurrentStyle s e
singleGetCurrentStyle = forall s e. SingleGetCurrentStyle s e
defaultGetCurrentStyle,
singleInit :: SingleInitHandler s e
singleInit = forall s e. SingleInitHandler s e
defaultInit,
singleMerge :: SingleMergeHandler s e a
singleMerge = forall s e a. SingleMergeHandler s e a
defaultMerge,
singleDispose :: SingleInitHandler s e
singleDispose = forall s e. SingleInitHandler s e
defaultDispose,
singleFindNextFocus :: SingleFindNextFocusHandler s e
singleFindNextFocus = forall s e. SingleFindNextFocusHandler s e
defaultFindNextFocus,
singleFindByPoint :: SingleFindByPointHandler s e
singleFindByPoint = forall s e. SingleFindByPointHandler s e
defaultFindByPoint,
singleHandleEvent :: SingleEventHandler s e
singleHandleEvent = forall s e. SingleEventHandler s e
defaultHandleEvent,
singleHandleMessage :: SingleMessageHandler s e
singleHandleMessage = forall s e. SingleMessageHandler s e
defaultHandleMessage,
singleGetSizeReq :: SingleGetSizeReqHandler s e
singleGetSizeReq = forall s e. SingleGetSizeReqHandler s e
defaultGetSizeReq,
singleResize :: SingleResizeHandler s e
singleResize = forall s e. SingleResizeHandler s e
defaultResize,
singleRender :: SingleRenderHandler s e
singleRender = forall s e. SingleRenderHandler s e
defaultRender
}
createSingle :: WidgetModel a => a -> Single s e a -> Widget s e
createSingle :: forall a s e. WidgetModel a => a -> Single s e a -> Widget s e
createSingle a
state Single s e a
single = Widget {
widgetInit :: WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
widgetInit = forall a s e.
WidgetModel a =>
Single s e a -> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
initWrapper Single s e a
single,
widgetMerge :: WidgetEnv s e
-> WidgetNode s e -> WidgetNode s e -> WidgetResult s e
widgetMerge = forall a s e.
WidgetModel a =>
Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> WidgetResult s e
mergeWrapper Single s e a
single,
widgetDispose :: WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
widgetDispose = forall s e a. Single s e a -> SingleInitHandler s e
disposeWrapper Single s e a
single,
widgetGetState :: WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
widgetGetState = forall i s e.
WidgetModel i =>
i -> WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
makeState a
state,
widgetGetInstanceTree :: WidgetEnv s e -> WidgetNode s e -> WidgetInstanceNode
widgetGetInstanceTree = forall a s e.
WidgetModel a =>
Single s e a
-> WidgetEnv s e -> WidgetNode s e -> WidgetInstanceNode
getInstanceTreeWrapper Single s e a
single,
widgetFindNextFocus :: WidgetEnv s e
-> WidgetNode s e -> FocusDirection -> Path -> Maybe WidgetNodeInfo
widgetFindNextFocus = forall s e a. Single s e a -> SingleFindNextFocusHandler s e
singleFindNextFocus Single s e a
single,
widgetFindByPoint :: WidgetEnv s e
-> WidgetNode s e -> Path -> Point -> Maybe WidgetNodeInfo
widgetFindByPoint = forall s e a. Single s e a -> SingleFindByPointHandler s e
singleFindByPoint Single s e a
single,
widgetFindBranchByPath :: WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
widgetFindBranchByPath = forall s e.
WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
singleFindBranchByPath,
widgetHandleEvent :: WidgetEnv s e
-> WidgetNode s e
-> Path
-> SystemEvent
-> Maybe (WidgetResult s e)
widgetHandleEvent = forall a s e.
WidgetModel a =>
Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> SystemEvent
-> Maybe (WidgetResult s e)
handleEventWrapper Single s e a
single,
widgetHandleMessage :: forall i.
Typeable i =>
WidgetEnv s e
-> WidgetNode s e -> Path -> i -> Maybe (WidgetResult s e)
widgetHandleMessage = forall s e a i.
(WidgetModel a, Typeable i) =>
Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> i
-> Maybe (WidgetResult s e)
handleMessageWrapper Single s e a
single,
widgetGetSizeReq :: WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
widgetGetSizeReq = forall a s e.
WidgetModel a =>
Single s e a
-> WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
getSizeReqWrapper Single s e a
single,
widgetResize :: WidgetEnv s e
-> WidgetNode s e -> Rect -> (Path -> Bool) -> WidgetResult s e
widgetResize = forall a s e.
WidgetModel a =>
Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Rect
-> (Path -> Bool)
-> WidgetResult s e
resizeHandlerWrapper Single s e a
single,
widgetRender :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
widgetRender = forall s e a. Single s e a -> SingleRenderHandler s e
renderWrapper Single s e a
single
}
defaultGetBaseStyle :: SingleGetBaseStyle s e
defaultGetBaseStyle :: forall s e. SingleGetBaseStyle s e
defaultGetBaseStyle WidgetEnv s e
wenv WidgetNode s e
node = forall a. Maybe a
Nothing
defaultGetCurrentStyle :: SingleGetCurrentStyle s e
defaultGetCurrentStyle :: forall s e. SingleGetCurrentStyle s e
defaultGetCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node = forall s e. SingleGetCurrentStyle s e
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
defaultInit :: SingleInitHandler s e
defaultInit :: forall s e. SingleInitHandler s e
defaultInit WidgetEnv s e
wenv WidgetNode s e
node = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node
initWrapper
:: WidgetModel a
=> Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetResult s e
initWrapper :: forall a s e.
WidgetModel a =>
Single s e a -> WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
initWrapper Single s e a
single WidgetEnv s e
wenv WidgetNode s e
node = WidgetResult s e
newResult where
initHandler :: SingleInitHandler s e
initHandler = forall s e a. Single s e a -> SingleInitHandler s e
singleInit Single s e a
single
getBaseStyle :: SingleGetBaseStyle s e
getBaseStyle = forall s e a. Single s e a -> SingleGetBaseStyle s e
singleGetBaseStyle Single s e a
single
styledNode :: WidgetNode s e
styledNode = forall s e.
GetBaseStyle s e
-> WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
initNodeStyle SingleGetBaseStyle s e
getBaseStyle WidgetEnv s e
wenv WidgetNode s e
node
tmpResult :: WidgetResult s e
tmpResult = SingleInitHandler s e
initHandler WidgetEnv s e
wenv WidgetNode s e
styledNode
newResult :: WidgetResult s e
newResult = WidgetResult s e
tmpResult
forall a b. a -> (a -> b) -> b
& forall s a. HasNode s a => Lens' s a
L.node forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e. WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
updateSizeReq WidgetEnv s e
wenv (WidgetResult s e
tmpResult forall s a. s -> Getting a s a -> a
^. forall s a. HasNode s a => Lens' s a
L.node)
defaultMerge :: SingleMergeHandler s e a
defaultMerge :: forall s e a. SingleMergeHandler s e a
defaultMerge WidgetEnv s e
wenv WidgetNode s e
newNode WidgetNode s e
oldState a
oldNode = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode
mergeWrapper
:: WidgetModel a
=> Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> WidgetResult s e
mergeWrapper :: forall a s e.
WidgetModel a =>
Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> WidgetResult s e
mergeWrapper Single s e a
single WidgetEnv s e
wenv WidgetNode s e
newNode WidgetNode s e
oldNode = WidgetResult s e
newResult where
mergeHandler :: SingleMergeHandler s e a
mergeHandler = forall s e a. Single s e a -> SingleMergeHandler s e a
singleMerge Single s e a
single
oldState :: Maybe WidgetState
oldState = forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
widgetGetState (WidgetNode s e
oldNode forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
oldNode
oldInfo :: WidgetNodeInfo
oldInfo = WidgetNode s e
oldNode forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info
nodeHandler :: WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
nodeHandler WidgetEnv s e
wenv WidgetNode s e
styledNode = case forall i. WidgetModel i => Maybe WidgetState -> Maybe i
useState Maybe WidgetState
oldState of
Just a
state -> SingleMergeHandler s e a
mergeHandler WidgetEnv s e
wenv WidgetNode s e
styledNode WidgetNode s e
oldNode a
state
Maybe a
_ -> forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
styledNode
tmpResult :: WidgetResult s e
tmpResult = forall a s e.
WidgetModel a =>
Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> (WidgetEnv s e -> WidgetNode s e -> WidgetResult s e)
-> WidgetResult s e
runNodeHandler Single s e a
single WidgetEnv s e
wenv WidgetNode s e
newNode WidgetNode s e
oldNode WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
nodeHandler
newResult :: WidgetResult s e
newResult = forall s e. WidgetNode s e -> WidgetResult s e -> WidgetResult s e
handleWidgetIdChange WidgetNode s e
oldNode WidgetResult s e
tmpResult
runNodeHandler
:: WidgetModel a
=> Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> (WidgetEnv s e -> WidgetNode s e -> WidgetResult s e)
-> WidgetResult s e
runNodeHandler :: forall a s e.
WidgetModel a =>
Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
-> (WidgetEnv s e -> WidgetNode s e -> WidgetResult s e)
-> WidgetResult s e
runNodeHandler Single s e a
single WidgetEnv s e
wenv WidgetNode s e
newNode WidgetNode s e
oldNode WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
nodeHandler = WidgetResult s e
newResult where
oldInfo :: WidgetNodeInfo
oldInfo = WidgetNode s e
oldNode forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info
getBaseStyle :: SingleGetBaseStyle s e
getBaseStyle = forall s e a. Single s e a -> SingleGetBaseStyle s e
singleGetBaseStyle Single s e a
single
tempNode :: WidgetNode s e
tempNode = WidgetNode s e
newNode
forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetNodeInfo
oldInfo forall s a. s -> Getting a s a -> a
^. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetNodeInfo
oldInfo forall s a. s -> Getting a s a -> a
^. forall s a. HasViewport s a => Lens' s a
L.viewport
forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetNodeInfo
oldInfo forall s a. s -> Getting a s a -> a
^. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW
forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetNodeInfo
oldInfo forall s a. s -> Getting a s a -> a
^. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH
styledNode :: WidgetNode s e
styledNode = forall s e.
GetBaseStyle s e
-> WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
initNodeStyle SingleGetBaseStyle s e
getBaseStyle WidgetEnv s e
wenv WidgetNode s e
tempNode
tmpResult :: WidgetResult s e
tmpResult = WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
nodeHandler WidgetEnv s e
wenv WidgetNode s e
styledNode
forall a b. a -> (a -> b) -> b
& forall s e.
WidgetEnv s e
-> WidgetNode s e -> WidgetResult s e -> WidgetResult s e
handleUserSizeReqChange WidgetEnv s e
wenv WidgetNode s e
oldNode
forall a b. a -> (a -> b) -> b
& forall s e. WidgetNode s e -> WidgetResult s e -> WidgetResult s e
handleWidgetIdChange WidgetNode s e
oldNode
newResult :: WidgetResult s e
newResult
| forall s e. Maybe (WidgetResult s e) -> Bool
isResizeAnyResult (forall a. a -> Maybe a
Just WidgetResult s e
tmpResult) = WidgetResult s e
tmpResult
forall a b. a -> (a -> b) -> b
& forall s a. HasNode s a => Lens' s a
L.node forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e. WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
updateSizeReq WidgetEnv s e
wenv (WidgetResult s e
tmpResult forall s a. s -> Getting a s a -> a
^. forall s a. HasNode s a => Lens' s a
L.node)
| Bool
otherwise = WidgetResult s e
tmpResult
getInstanceTreeWrapper
:: WidgetModel a
=> Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetInstanceNode
getInstanceTreeWrapper :: forall a s e.
WidgetModel a =>
Single s e a
-> WidgetEnv s e -> WidgetNode s e -> WidgetInstanceNode
getInstanceTreeWrapper Single s e a
container WidgetEnv s e
wenv WidgetNode s e
node = WidgetInstanceNode
instNode where
instNode :: WidgetInstanceNode
instNode = WidgetInstanceNode {
_winInfo :: WidgetNodeInfo
_winInfo = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info,
_winState :: Maybe WidgetState
_winState = forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Maybe WidgetState
widgetGetState (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
node,
_winChildren :: Seq WidgetInstanceNode
_winChildren = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {s} {e}.
WidgetEnv s e -> WidgetNode s e -> WidgetInstanceNode
getChildTree WidgetEnv s e
wenv) (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children)
}
getChildTree :: WidgetEnv s e -> WidgetNode s e -> WidgetInstanceNode
getChildTree WidgetEnv s e
wenv WidgetNode s e
child = forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> WidgetInstanceNode
widgetGetInstanceTree (WidgetNode s e
child forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
child
defaultDispose :: SingleDisposeHandler s e
defaultDispose :: forall s e. SingleInitHandler s e
defaultDispose WidgetEnv s e
wenv WidgetNode s e
node = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node
disposeWrapper
:: Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetResult s e
disposeWrapper :: forall s e a. Single s e a -> SingleInitHandler s e
disposeWrapper Single s e a
single WidgetEnv s e
wenv WidgetNode s e
node = WidgetResult s e
result where
disposeHandler :: SingleDisposeHandler s e
disposeHandler = forall s e a. Single s e a -> SingleInitHandler s e
singleDispose Single s e a
single
WidgetResult WidgetNode s e
newNode Seq (WidgetRequest s e)
reqs = SingleDisposeHandler s e
disposeHandler WidgetEnv s e
wenv WidgetNode s e
node
widgetId :: WidgetId
widgetId = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
newReqs :: Seq (WidgetRequest s e)
newReqs = Seq (WidgetRequest s e)
reqs forall a. Seq a -> a -> Seq a
|> forall s e. WidgetId -> WidgetRequest s e
ResetWidgetPath WidgetId
widgetId
result :: WidgetResult s e
result = forall s e.
WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
WidgetResult WidgetNode s e
newNode Seq (WidgetRequest s e)
newReqs
defaultFindNextFocus :: SingleFindNextFocusHandler s e
defaultFindNextFocus :: forall s e. SingleFindNextFocusHandler s e
defaultFindNextFocus WidgetEnv s e
wenv WidgetNode s e
node FocusDirection
direction Path
startFrom
| forall s e. WidgetNode s e -> Path -> FocusDirection -> Bool
isFocusCandidate WidgetNode s e
node Path
startFrom FocusDirection
direction = forall a. a -> Maybe a
Just (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info)
| Bool
otherwise = forall a. Maybe a
Nothing
defaultFindByPoint :: SingleFindByPointHandler s e
defaultFindByPoint :: forall s e. SingleFindByPointHandler s e
defaultFindByPoint WidgetEnv s e
wenv WidgetNode s e
node Path
start Point
point
| Bool
visible Bool -> Bool -> Bool
&& Bool
validPath Bool -> Bool -> Bool
&& forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
node Point
point = forall a. a -> Maybe a
Just WidgetNodeInfo
info
| Bool
otherwise = forall a. Maybe a
Nothing
where
info :: WidgetNodeInfo
info = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info
visible :: Bool
visible = WidgetNodeInfo
info forall s a. s -> Getting a s a -> a
^. forall s a. HasVisible s a => Lens' s a
L.visible
path :: Path
path = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasPath s a => Lens' s a
L.path
validPath :: Bool
validPath = forall a. Eq a => Seq a -> Seq a -> Bool
seqStartsWith Path
start Path
path
singleFindBranchByPath
:: WidgetEnv s e
-> WidgetNode s e
-> Path
-> Seq WidgetNodeInfo
singleFindBranchByPath :: forall s e.
WidgetEnv s e -> WidgetNode s e -> Path -> Seq WidgetNodeInfo
singleFindBranchByPath WidgetEnv s e
wenv WidgetNode s e
node Path
path
| WidgetNodeInfo
info forall s a. s -> Getting a s a -> a
^. forall s a. HasPath s a => Lens' s a
L.path forall a. Eq a => a -> a -> Bool
== Path
path = forall a. a -> Seq a
Seq.singleton WidgetNodeInfo
info
| Bool
otherwise = forall a. Seq a
Seq.empty
where
info :: WidgetNodeInfo
info = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info
defaultHandleEvent :: SingleEventHandler s e
defaultHandleEvent :: forall s e. SingleEventHandler s e
defaultHandleEvent WidgetEnv s e
wenv WidgetNode s e
node Path
target SystemEvent
evt = forall a. Maybe a
Nothing
handleEventWrapper
:: WidgetModel a
=> Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> SystemEvent
-> Maybe (WidgetResult s e)
handleEventWrapper :: forall a s e.
WidgetModel a =>
Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> SystemEvent
-> Maybe (WidgetResult s e)
handleEventWrapper Single s e a
single WidgetEnv s e
wenv WidgetNode s e
node Path
target SystemEvent
evt
| Bool -> Bool
not (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasVisible s a => Lens' s a
L.visible) = forall a. Maybe a
Nothing
| Bool
otherwise = forall s e.
WidgetEnv s e
-> Path
-> StyleState
-> Bool
-> WidgetNode s e
-> SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleStyleChange WidgetEnv s e
wenv Path
target StyleState
style Bool
handleCursor WidgetNode s e
node SystemEvent
evt Maybe (WidgetResult s e)
result
where
style :: StyleState
style = forall s e a. Single s e a -> SingleGetCurrentStyle s e
singleGetCurrentStyle Single s e a
single WidgetEnv s e
wenv WidgetNode s e
node
handleCursor :: Bool
handleCursor = Bool -> Bool
not (forall s e a. Single s e a -> Bool
singleUseCustomCursor Single s e a
single)
focusOnPressed :: Bool
focusOnPressed = forall s e a. Single s e a -> Bool
singleFocusOnBtnPressed Single s e a
single
handler :: SingleEventHandler s e
handler = forall s e a. Single s e a -> SingleEventHandler s e
singleHandleEvent Single s e a
single
handlerRes :: Maybe (WidgetResult s e)
handlerRes = SingleEventHandler s e
handler WidgetEnv s e
wenv WidgetNode s e
node Path
target SystemEvent
evt
sizeResult :: Maybe (WidgetResult s e)
sizeResult = forall a s e.
WidgetModel a =>
Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Maybe SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleSizeReqChange Single s e a
single WidgetEnv s e
wenv WidgetNode s e
node (forall a. a -> Maybe a
Just SystemEvent
evt) Maybe (WidgetResult s e)
handlerRes
result :: Maybe (WidgetResult s e)
result
| Bool
focusOnPressed = forall s e.
WidgetEnv s e
-> WidgetNode s e
-> SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleFocusRequest WidgetEnv s e
wenv WidgetNode s e
node SystemEvent
evt Maybe (WidgetResult s e)
sizeResult
| Bool
otherwise = Maybe (WidgetResult s e)
sizeResult
handleFocusRequest
:: WidgetEnv s e
-> WidgetNode s e
-> SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleFocusRequest :: forall s e.
WidgetEnv s e
-> WidgetNode s e
-> SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleFocusRequest WidgetEnv s e
wenv WidgetNode s e
oldNode SystemEvent
evt Maybe (WidgetResult s e)
mResult = Maybe (WidgetResult s e)
newResult where
node :: WidgetNode s e
node = forall b a. b -> (a -> b) -> Maybe a -> b
maybe WidgetNode s e
oldNode (forall s a. s -> Getting a s a -> a
^. forall s a. HasNode s a => Lens' s a
L.node) Maybe (WidgetResult s e)
mResult
prevReqs :: Seq (WidgetRequest s e)
prevReqs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Seq a
Empty (forall s a. s -> Getting a s a -> a
^. forall s a. HasRequests s a => Lens' s a
L.requests) Maybe (WidgetResult s e)
mResult
isFocusable :: Bool
isFocusable = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFocusable s a => Lens' s a
L.focusable
btnPressed :: Maybe Button
btnPressed = case SystemEvent
evt of
ButtonAction Point
_ Button
btn ButtonState
BtnPressed PathStep
_ -> forall a. a -> Maybe a
Just Button
btn
SystemEvent
_ -> forall a. Maybe a
Nothing
isFocusReq :: Bool
isFocusReq = Maybe Button
btnPressed forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasMainButton s a => Lens' s a
L.mainButton)
Bool -> Bool -> Bool
&& Bool
isFocusable
Bool -> Bool -> Bool
&& Bool -> Bool
not (forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused WidgetEnv s e
wenv WidgetNode s e
node)
Bool -> Bool -> Bool
&& forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeTopLevel WidgetEnv s e
wenv WidgetNode s e
node
Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing (forall a. (a -> Bool) -> Seq a -> Maybe PathStep
Seq.findIndexL forall s e. WidgetRequest s e -> Bool
isFocusRequest Seq (WidgetRequest s e)
prevReqs)
newReq :: WidgetRequest s e
newReq = forall s e. WidgetId -> WidgetRequest s e
SetFocus (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId)
newResult :: Maybe (WidgetResult s e)
newResult
| Bool
isFocusReq Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe (WidgetResult s e)
mResult = (forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Seq a -> a -> Seq a
|> forall {s} {e}. WidgetRequest s e
newReq)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (WidgetResult s e)
mResult
| Bool
isFocusReq = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall {s} {e}. WidgetRequest s e
newReq]
| Bool
otherwise = Maybe (WidgetResult s e)
mResult
defaultHandleMessage :: SingleMessageHandler s e
defaultHandleMessage :: forall s e. SingleMessageHandler s e
defaultHandleMessage WidgetEnv s e
wenv WidgetNode s e
node Path
target i
message = forall a. Maybe a
Nothing
handleMessageWrapper :: forall s e a i . (WidgetModel a, Typeable i)
=> Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> i
-> Maybe (WidgetResult s e)
handleMessageWrapper :: forall s e a i.
(WidgetModel a, Typeable i) =>
Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Path
-> i
-> Maybe (WidgetResult s e)
handleMessageWrapper Single s e a
single WidgetEnv s e
wenv WidgetNode s e
node Path
target i
msg = Maybe (WidgetResult s e)
result where
handler :: WidgetEnv s e
-> WidgetNode s e -> Path -> i -> Maybe (WidgetResult s e)
handler = forall s e a. Single s e a -> SingleMessageHandler s e
singleHandleMessage Single s e a
single
result :: Maybe (WidgetResult s e)
result = forall a s e.
WidgetModel a =>
Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Maybe SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleSizeReqChange Single s e a
single WidgetEnv s e
wenv WidgetNode s e
node forall a. Maybe a
Nothing
forall a b. (a -> b) -> a -> b
$ WidgetEnv s e
-> WidgetNode s e -> Path -> i -> Maybe (WidgetResult s e)
handler WidgetEnv s e
wenv WidgetNode s e
node Path
target i
msg
defaultGetSizeReq :: SingleGetSizeReqHandler s e
defaultGetSizeReq :: forall s e. SingleGetSizeReqHandler s e
defaultGetSizeReq WidgetEnv s e
wenv WidgetNode s e
node = forall a. Default a => a
def
getSizeReqWrapper
:: WidgetModel a
=> Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> (SizeReq, SizeReq)
getSizeReqWrapper :: forall a s e.
WidgetModel a =>
Single s e a
-> WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
getSizeReqWrapper Single s e a
single WidgetEnv s e
wenv WidgetNode s e
node = (SizeReq
newReqW, SizeReq
newReqH) where
addStyleReq :: Bool
addStyleReq = forall s e a. Single s e a -> Bool
singleAddStyleReq Single s e a
single
handler :: SingleGetSizeReqHandler s e
handler = forall s e a. Single s e a -> SingleGetSizeReqHandler s e
singleGetSizeReq Single s e a
single
style :: StyleState
style = forall s e a. Single s e a -> SingleGetCurrentStyle s e
singleGetCurrentStyle Single s e a
single WidgetEnv s e
wenv WidgetNode s e
node
reqs :: (SizeReq, SizeReq)
reqs = SingleGetSizeReqHandler s e
handler WidgetEnv s e
wenv WidgetNode s e
node
(SizeReq
tmpReqW, SizeReq
tmpReqH)
| Bool
addStyleReq = StyleState -> (SizeReq, SizeReq) -> (SizeReq, SizeReq)
sizeReqAddStyle StyleState
style (SizeReq, SizeReq)
reqs
| Bool
otherwise = (SizeReq, SizeReq)
reqs
newReqW :: SizeReq
newReqW = forall a. a -> Maybe a -> a
fromMaybe SizeReq
tmpReqW (StyleState
style forall s a. s -> Getting a s a -> a
^. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW)
newReqH :: SizeReq
newReqH = forall a. a -> Maybe a -> a
fromMaybe SizeReq
tmpReqH (StyleState
style forall s a. s -> Getting a s a -> a
^. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH)
updateSizeReq
:: WidgetEnv s e
-> WidgetNode s e
-> WidgetNode s e
updateSizeReq :: forall s e. WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
updateSizeReq WidgetEnv s e
wenv WidgetNode s e
node = WidgetNode s e
newNode where
(SizeReq
newReqW, SizeReq
newReqH) = forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> (SizeReq, SizeReq)
widgetGetSizeReq (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
wenv WidgetNode s e
node
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW forall s t a b. ASetter s t a b -> b -> s -> t
.~ SizeReq
newReqW
forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH forall s t a b. ASetter s t a b -> b -> s -> t
.~ SizeReq
newReqH
handleSizeReqChange
:: WidgetModel a
=> Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Maybe SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleSizeReqChange :: forall a s e.
WidgetModel a =>
Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Maybe SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleSizeReqChange Single s e a
single WidgetEnv s e
wenv WidgetNode s e
node Maybe SystemEvent
evt Maybe (WidgetResult s e)
mResult = Maybe (WidgetResult s e)
result where
baseResult :: WidgetResult s e
baseResult = forall a. a -> Maybe a -> a
fromMaybe (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node) Maybe (WidgetResult s e)
mResult
newNode :: WidgetNode s e
newNode = WidgetResult s e
baseResult forall s a. s -> Getting a s a -> a
^. forall s a. HasNode s a => Lens' s a
L.node
resizeReq :: Bool
resizeReq = forall s e. Maybe (WidgetResult s e) -> Bool
isResizeAnyResult Maybe (WidgetResult s e)
mResult
styleChanged :: Bool
styleChanged = forall a. Maybe a -> Bool
isJust Maybe SystemEvent
evt Bool -> Bool -> Bool
&& forall s e. WidgetEnv s e -> WidgetNode s e -> SystemEvent -> Bool
styleStateChanged WidgetEnv s e
wenv WidgetNode s e
newNode (forall a. HasCallStack => Maybe a -> a
fromJust Maybe SystemEvent
evt)
result :: Maybe (WidgetResult s e)
result
| Bool
styleChanged Bool -> Bool -> Bool
|| Bool
resizeReq = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WidgetResult s e
baseResult
forall a b. a -> (a -> b) -> b
& forall s a. HasNode s a => Lens' s a
L.node forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e. WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
updateSizeReq WidgetEnv s e
wenv WidgetNode s e
newNode
| Bool
otherwise = Maybe (WidgetResult s e)
mResult
defaultResize :: SingleResizeHandler s e
defaultResize :: forall s e. SingleResizeHandler s e
defaultResize WidgetEnv s e
wenv WidgetNode s e
node Rect
viewport = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node
resizeHandlerWrapper
:: WidgetModel a
=> Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Rect
-> (Path -> Bool)
-> WidgetResult s e
resizeHandlerWrapper :: forall a s e.
WidgetModel a =>
Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Rect
-> (Path -> Bool)
-> WidgetResult s e
resizeHandlerWrapper Single s e a
single WidgetEnv s e
wenv WidgetNode s e
node Rect
viewport Path -> Bool
resizeReq = WidgetResult s e
result where
useCustomSize :: Bool
useCustomSize = forall s e a. Single s e a -> Bool
singleUseCustomSize Single s e a
single
handler :: SingleResizeHandler s e
handler = forall s e a. Single s e a -> SingleResizeHandler s e
singleResize Single s e a
single
tmpRes :: WidgetResult s e
tmpRes = SingleResizeHandler s e
handler WidgetEnv s e
wenv WidgetNode s e
node Rect
viewport
lensVp :: (Rect -> Const Rect Rect)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
lensVp = forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport
newVp :: Rect
newVp
| Bool
useCustomSize = WidgetResult s e
tmpRes forall s a. s -> Getting a s a -> a
^. forall s a. HasNode s a => Lens' s a
L.node forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
lensVp
| Bool
otherwise = Rect
viewport
tmpResult :: Maybe (WidgetResult s e)
tmpResult = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WidgetResult s e
tmpRes
forall a b. a -> (a -> b) -> b
& forall s a. HasNode s a => Lens' s a
L.node forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rect
newVp
newNode :: WidgetNode s e
newNode = WidgetResult s e
tmpRes forall s a. s -> Getting a s a -> a
^. forall s a. HasNode s a => Lens' s a
L.node
result :: WidgetResult s e
result = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a s e.
WidgetModel a =>
Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Maybe SystemEvent
-> Maybe (WidgetResult s e)
-> Maybe (WidgetResult s e)
handleSizeReqChange Single s e a
single WidgetEnv s e
wenv WidgetNode s e
newNode forall a. Maybe a
Nothing Maybe (WidgetResult s e)
tmpResult
defaultRender :: SingleRenderHandler s e
defaultRender :: forall s e. SingleRenderHandler s e
defaultRender WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer = forall (m :: * -> *) a. Monad m => a -> m a
return ()
renderWrapper
:: Single s e a
-> WidgetEnv s e
-> WidgetNode s e
-> Renderer
-> IO ()
renderWrapper :: forall s e a. Single s e a -> SingleRenderHandler s e
renderWrapper Single s e a
single WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer =
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isWidgetVisible WidgetEnv s e
wenv WidgetNode s e
node) forall a b. (a -> b) -> a -> b
$
Renderer -> Bool -> Rect -> IO () -> IO ()
drawInScissor Renderer
renderer Bool
useScissor Rect
viewport forall a b. (a -> b) -> a -> b
$
Renderer -> Bool -> Rect -> StyleState -> (Rect -> IO ()) -> IO ()
drawStyledAction_ Renderer
renderer Bool
drawDecorations Rect
viewport StyleState
style forall a b. (a -> b) -> a -> b
$ \Rect
_ ->
SingleRenderHandler s e
handler WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer
where
handler :: SingleRenderHandler s e
handler = forall s e a. Single s e a -> SingleRenderHandler s e
singleRender Single s e a
single
drawDecorations :: Bool
drawDecorations = forall s e a. Single s e a -> Bool
singleDrawDecorations Single s e a
single
useScissor :: Bool
useScissor = forall s e a. Single s e a -> Bool
singleUseScissor Single s e a
single
style :: StyleState
style = forall s e a. Single s e a -> SingleGetCurrentStyle s e
singleGetCurrentStyle Single s e a
single WidgetEnv s e
wenv WidgetNode s e
node
viewport :: Rect
viewport = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport