{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Strict #-}
module Monomer.Widgets.Containers.Box (
BoxCfg,
box,
box_,
expandContent,
boxFilterEvent
) where
import Control.Applicative ((<|>))
import Control.Lens ((&), (^.), (.~))
import Data.Default
import Data.Maybe
import qualified Data.Sequence as Seq
import Monomer.Helper (applyFnList)
import Monomer.Widgets.Container
import Monomer.Widgets.Containers.Stack
import qualified Monomer.Lens as L
data BoxCfg s e = BoxCfg {
forall s e. BoxCfg s e -> Maybe Bool
_boxExpandContent :: Maybe Bool,
forall s e. BoxCfg s e -> Maybe Bool
_boxIgnoreEmptyArea :: Maybe Bool,
forall s e. BoxCfg s e -> [SizeReqUpdater]
_boxSizeReqUpdater :: [SizeReqUpdater],
forall s e. BoxCfg s e -> Maybe (ContainerFilterHandler s e)
_boxFilterEvent :: Maybe (ContainerFilterHandler s e),
forall s e. BoxCfg s e -> Maybe (WidgetEnv s e -> s -> s -> Bool)
_boxMergeRequired :: Maybe (WidgetEnv s e -> s -> s -> Bool),
forall s e. BoxCfg s e -> Maybe AlignH
_boxAlignH :: Maybe AlignH,
forall s e. BoxCfg s e -> Maybe AlignV
_boxAlignV :: Maybe AlignV,
forall s e. BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnFocusReq :: [Path -> WidgetRequest s e],
forall s e. BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnBlurReq :: [Path -> WidgetRequest s e],
forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnEnterReq :: [WidgetRequest s e],
forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnLeaveReq :: [WidgetRequest s e],
forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickReq :: [WidgetRequest s e],
forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickEmptyReq :: [WidgetRequest s e],
forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq :: [Button -> Int -> WidgetRequest s e],
forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq :: [Button -> Int -> WidgetRequest s e]
}
instance Default (BoxCfg s e) where
def :: BoxCfg s e
def = BoxCfg {
_boxExpandContent :: Maybe Bool
_boxExpandContent = forall a. Maybe a
Nothing,
_boxIgnoreEmptyArea :: Maybe Bool
_boxIgnoreEmptyArea = forall a. Maybe a
Nothing,
_boxSizeReqUpdater :: [SizeReqUpdater]
_boxSizeReqUpdater = [],
_boxFilterEvent :: Maybe (ContainerFilterHandler s e)
_boxFilterEvent = forall a. Maybe a
Nothing,
_boxMergeRequired :: Maybe (WidgetEnv s e -> s -> s -> Bool)
_boxMergeRequired = forall a. Maybe a
Nothing,
_boxAlignH :: Maybe AlignH
_boxAlignH = forall a. Maybe a
Nothing,
_boxAlignV :: Maybe AlignV
_boxAlignV = forall a. Maybe a
Nothing,
_boxOnFocusReq :: [Path -> WidgetRequest s e]
_boxOnFocusReq = [],
_boxOnBlurReq :: [Path -> WidgetRequest s e]
_boxOnBlurReq = [],
_boxOnEnterReq :: [WidgetRequest s e]
_boxOnEnterReq = [],
_boxOnLeaveReq :: [WidgetRequest s e]
_boxOnLeaveReq = [],
_boxOnClickReq :: [WidgetRequest s e]
_boxOnClickReq = [],
_boxOnClickEmptyReq :: [WidgetRequest s e]
_boxOnClickEmptyReq = [],
_boxOnBtnPressedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq = [],
_boxOnBtnReleasedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq = []
}
instance Semigroup (BoxCfg s e) where
<> :: BoxCfg s e -> BoxCfg s e -> BoxCfg s e
(<>) BoxCfg s e
t1 BoxCfg s e
t2 = BoxCfg {
_boxExpandContent :: Maybe Bool
_boxExpandContent = forall s e. BoxCfg s e -> Maybe Bool
_boxExpandContent BoxCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. BoxCfg s e -> Maybe Bool
_boxExpandContent BoxCfg s e
t1,
_boxIgnoreEmptyArea :: Maybe Bool
_boxIgnoreEmptyArea = forall s e. BoxCfg s e -> Maybe Bool
_boxIgnoreEmptyArea BoxCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. BoxCfg s e -> Maybe Bool
_boxIgnoreEmptyArea BoxCfg s e
t1,
_boxSizeReqUpdater :: [SizeReqUpdater]
_boxSizeReqUpdater = forall s e. BoxCfg s e -> [SizeReqUpdater]
_boxSizeReqUpdater BoxCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. BoxCfg s e -> [SizeReqUpdater]
_boxSizeReqUpdater BoxCfg s e
t2,
_boxFilterEvent :: Maybe (ContainerFilterHandler s e)
_boxFilterEvent = forall s e. BoxCfg s e -> Maybe (ContainerFilterHandler s e)
_boxFilterEvent BoxCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. BoxCfg s e -> Maybe (ContainerFilterHandler s e)
_boxFilterEvent BoxCfg s e
t1,
_boxMergeRequired :: Maybe (WidgetEnv s e -> s -> s -> Bool)
_boxMergeRequired = forall s e. BoxCfg s e -> Maybe (WidgetEnv s e -> s -> s -> Bool)
_boxMergeRequired BoxCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. BoxCfg s e -> Maybe (WidgetEnv s e -> s -> s -> Bool)
_boxMergeRequired BoxCfg s e
t1,
_boxAlignH :: Maybe AlignH
_boxAlignH = forall s e. BoxCfg s e -> Maybe AlignH
_boxAlignH BoxCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. BoxCfg s e -> Maybe AlignH
_boxAlignH BoxCfg s e
t1,
_boxAlignV :: Maybe AlignV
_boxAlignV = forall s e. BoxCfg s e -> Maybe AlignV
_boxAlignV BoxCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. BoxCfg s e -> Maybe AlignV
_boxAlignV BoxCfg s e
t1,
_boxOnFocusReq :: [Path -> WidgetRequest s e]
_boxOnFocusReq = forall s e. BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnFocusReq BoxCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnFocusReq BoxCfg s e
t2,
_boxOnBlurReq :: [Path -> WidgetRequest s e]
_boxOnBlurReq = forall s e. BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnBlurReq BoxCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnBlurReq BoxCfg s e
t2,
_boxOnEnterReq :: [WidgetRequest s e]
_boxOnEnterReq = forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnEnterReq BoxCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnEnterReq BoxCfg s e
t2,
_boxOnLeaveReq :: [WidgetRequest s e]
_boxOnLeaveReq = forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnLeaveReq BoxCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnLeaveReq BoxCfg s e
t2,
_boxOnClickReq :: [WidgetRequest s e]
_boxOnClickReq = forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickReq BoxCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickReq BoxCfg s e
t2,
_boxOnClickEmptyReq :: [WidgetRequest s e]
_boxOnClickEmptyReq = forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickEmptyReq BoxCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickEmptyReq BoxCfg s e
t2,
_boxOnBtnPressedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq = forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq BoxCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq BoxCfg s e
t2,
_boxOnBtnReleasedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq = forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq BoxCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq BoxCfg s e
t2
}
instance Monoid (BoxCfg s e) where
mempty :: BoxCfg s e
mempty = forall a. Default a => a
def
instance CmbIgnoreEmptyArea (BoxCfg s e) where
ignoreEmptyArea_ :: Bool -> BoxCfg s e
ignoreEmptyArea_ Bool
ignore = forall a. Default a => a
def {
_boxIgnoreEmptyArea :: Maybe Bool
_boxIgnoreEmptyArea = forall a. a -> Maybe a
Just Bool
ignore
}
instance CmbSizeReqUpdater (BoxCfg s e) where
sizeReqUpdater :: SizeReqUpdater -> BoxCfg s e
sizeReqUpdater SizeReqUpdater
updater = forall a. Default a => a
def {
_boxSizeReqUpdater :: [SizeReqUpdater]
_boxSizeReqUpdater = [SizeReqUpdater
updater]
}
instance CmbMergeRequired (BoxCfg s e) (WidgetEnv s e) s where
mergeRequired :: (WidgetEnv s e -> s -> s -> Bool) -> BoxCfg s e
mergeRequired WidgetEnv s e -> s -> s -> Bool
fn = forall a. Default a => a
def {
_boxMergeRequired :: Maybe (WidgetEnv s e -> s -> s -> Bool)
_boxMergeRequired = forall a. a -> Maybe a
Just WidgetEnv s e -> s -> s -> Bool
fn
}
instance CmbAlignLeft (BoxCfg s e) where
alignLeft_ :: Bool -> BoxCfg s e
alignLeft_ Bool
False = forall a. Default a => a
def
alignLeft_ Bool
True = forall a. Default a => a
def {
_boxAlignH :: Maybe AlignH
_boxAlignH = forall a. a -> Maybe a
Just AlignH
ALeft
}
instance CmbAlignCenter (BoxCfg s e) where
alignCenter_ :: Bool -> BoxCfg s e
alignCenter_ Bool
False = forall a. Default a => a
def
alignCenter_ Bool
True = forall a. Default a => a
def {
_boxAlignH :: Maybe AlignH
_boxAlignH = forall a. a -> Maybe a
Just AlignH
ACenter
}
instance CmbAlignRight (BoxCfg s e) where
alignRight_ :: Bool -> BoxCfg s e
alignRight_ Bool
False = forall a. Default a => a
def
alignRight_ Bool
True = forall a. Default a => a
def {
_boxAlignH :: Maybe AlignH
_boxAlignH = forall a. a -> Maybe a
Just AlignH
ARight
}
instance CmbAlignTop (BoxCfg s e) where
alignTop_ :: Bool -> BoxCfg s e
alignTop_ Bool
False = forall a. Default a => a
def
alignTop_ Bool
True = forall a. Default a => a
def {
_boxAlignV :: Maybe AlignV
_boxAlignV = forall a. a -> Maybe a
Just AlignV
ATop
}
instance CmbAlignMiddle (BoxCfg s e) where
alignMiddle_ :: Bool -> BoxCfg s e
alignMiddle_ Bool
False = forall a. Default a => a
def
alignMiddle_ Bool
True = forall a. Default a => a
def {
_boxAlignV :: Maybe AlignV
_boxAlignV = forall a. a -> Maybe a
Just AlignV
AMiddle
}
instance CmbAlignBottom (BoxCfg s e) where
alignBottom_ :: Bool -> BoxCfg s e
alignBottom_ Bool
False = forall a. Default a => a
def
alignBottom_ Bool
True = forall a. Default a => a
def {
_boxAlignV :: Maybe AlignV
_boxAlignV = forall a. a -> Maybe a
Just AlignV
ABottom
}
instance WidgetEvent e => CmbOnFocus (BoxCfg s e) e Path where
onFocus :: (Path -> e) -> BoxCfg s e
onFocus Path -> e
handler = forall a. Default a => a
def {
_boxOnFocusReq :: [Path -> WidgetRequest s e]
_boxOnFocusReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> e
handler]
}
instance CmbOnFocusReq (BoxCfg s e) s e Path where
onFocusReq :: (Path -> WidgetRequest s e) -> BoxCfg s e
onFocusReq Path -> WidgetRequest s e
req = forall a. Default a => a
def {
_boxOnFocusReq :: [Path -> WidgetRequest s e]
_boxOnFocusReq = [Path -> WidgetRequest s e
req]
}
instance WidgetEvent e => CmbOnBlur (BoxCfg s e) e Path where
onBlur :: (Path -> e) -> BoxCfg s e
onBlur Path -> e
handler = forall a. Default a => a
def {
_boxOnBlurReq :: [Path -> WidgetRequest s e]
_boxOnBlurReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> e
handler]
}
instance CmbOnBlurReq (BoxCfg s e) s e Path where
onBlurReq :: (Path -> WidgetRequest s e) -> BoxCfg s e
onBlurReq Path -> WidgetRequest s e
req = forall a. Default a => a
def {
_boxOnBlurReq :: [Path -> WidgetRequest s e]
_boxOnBlurReq = [Path -> WidgetRequest s e
req]
}
instance WidgetEvent e => CmbOnBtnPressed (BoxCfg s e) e where
onBtnPressed :: (Button -> Int -> e) -> BoxCfg s e
onBtnPressed Button -> Int -> e
handler = forall a. Default a => a
def {
_boxOnBtnPressedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq = [(forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Button -> Int -> e
handler]
}
instance CmbOnBtnPressedReq (BoxCfg s e) s e where
onBtnPressedReq :: (Button -> Int -> WidgetRequest s e) -> BoxCfg s e
onBtnPressedReq Button -> Int -> WidgetRequest s e
req = forall a. Default a => a
def {
_boxOnBtnPressedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq = [Button -> Int -> WidgetRequest s e
req]
}
instance WidgetEvent e => CmbOnBtnReleased (BoxCfg s e) e where
onBtnReleased :: (Button -> Int -> e) -> BoxCfg s e
onBtnReleased Button -> Int -> e
handler = forall a. Default a => a
def {
_boxOnBtnReleasedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq = [(forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Button -> Int -> e
handler]
}
instance CmbOnBtnReleasedReq (BoxCfg s e) s e where
onBtnReleasedReq :: (Button -> Int -> WidgetRequest s e) -> BoxCfg s e
onBtnReleasedReq Button -> Int -> WidgetRequest s e
req = forall a. Default a => a
def {
_boxOnBtnReleasedReq :: [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq = [Button -> Int -> WidgetRequest s e
req]
}
instance WidgetEvent e => CmbOnClick (BoxCfg s e) e where
onClick :: e -> BoxCfg s e
onClick e
handler = forall a. Default a => a
def {
_boxOnClickReq :: [WidgetRequest s e]
_boxOnClickReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent e
handler]
}
instance CmbOnClickReq (BoxCfg s e) s e where
onClickReq :: WidgetRequest s e -> BoxCfg s e
onClickReq WidgetRequest s e
req = forall a. Default a => a
def {
_boxOnClickReq :: [WidgetRequest s e]
_boxOnClickReq = [WidgetRequest s e
req]
}
instance WidgetEvent e => CmbOnClickEmpty (BoxCfg s e) e where
onClickEmpty :: e -> BoxCfg s e
onClickEmpty e
handler = forall a. Default a => a
def {
_boxOnClickEmptyReq :: [WidgetRequest s e]
_boxOnClickEmptyReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent e
handler]
}
instance CmbOnClickEmptyReq (BoxCfg s e) s e where
onClickEmptyReq :: WidgetRequest s e -> BoxCfg s e
onClickEmptyReq WidgetRequest s e
req = forall a. Default a => a
def {
_boxOnClickEmptyReq :: [WidgetRequest s e]
_boxOnClickEmptyReq = [WidgetRequest s e
req]
}
instance WidgetEvent e => CmbOnEnter (BoxCfg s e) e where
onEnter :: e -> BoxCfg s e
onEnter e
handler = forall a. Default a => a
def {
_boxOnEnterReq :: [WidgetRequest s e]
_boxOnEnterReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent e
handler]
}
instance CmbOnEnterReq (BoxCfg s e) s e where
onEnterReq :: WidgetRequest s e -> BoxCfg s e
onEnterReq WidgetRequest s e
req = forall a. Default a => a
def {
_boxOnEnterReq :: [WidgetRequest s e]
_boxOnEnterReq = [WidgetRequest s e
req]
}
instance WidgetEvent e => CmbOnLeave (BoxCfg s e) e where
onLeave :: e -> BoxCfg s e
onLeave e
handler = forall a. Default a => a
def {
_boxOnLeaveReq :: [WidgetRequest s e]
_boxOnLeaveReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent e
handler]
}
instance CmbOnLeaveReq (BoxCfg s e) s e where
onLeaveReq :: WidgetRequest s e -> BoxCfg s e
onLeaveReq WidgetRequest s e
req = forall a. Default a => a
def {
_boxOnLeaveReq :: [WidgetRequest s e]
_boxOnLeaveReq = [WidgetRequest s e
req]
}
expandContent :: BoxCfg s e
expandContent :: forall s e. BoxCfg s e
expandContent = forall a. Default a => a
def {
_boxExpandContent :: Maybe Bool
_boxExpandContent = forall a. a -> Maybe a
Just Bool
True
}
boxFilterEvent :: ContainerFilterHandler s e -> BoxCfg s e
boxFilterEvent :: forall s e. ContainerFilterHandler s e -> BoxCfg s e
boxFilterEvent ContainerFilterHandler s e
handler = forall a. Default a => a
def {
_boxFilterEvent :: Maybe (ContainerFilterHandler s e)
_boxFilterEvent = forall a. a -> Maybe a
Just ContainerFilterHandler s e
handler
}
newtype BoxState s = BoxState {
forall s. BoxState s -> Maybe s
_bxsModel :: Maybe s
}
box :: (WidgetModel s, WidgetEvent e) => WidgetNode s e -> WidgetNode s e
box :: forall s e.
(WidgetModel s, WidgetEvent e) =>
WidgetNode s e -> WidgetNode s e
box WidgetNode s e
managed = forall s e.
(WidgetModel s, WidgetEvent e) =>
[BoxCfg s e] -> WidgetNode s e -> WidgetNode s e
box_ forall a. Default a => a
def WidgetNode s e
managed
box_
:: (WidgetModel s, WidgetEvent e)
=> [BoxCfg s e]
-> WidgetNode s e
-> WidgetNode s e
box_ :: forall s e.
(WidgetModel s, WidgetEvent e) =>
[BoxCfg s e] -> WidgetNode s e -> WidgetNode s e
box_ [BoxCfg s e]
configs WidgetNode s e
managed = forall s e. Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode (forall s e.
(WidgetModel s, WidgetEvent e) =>
BoxCfg s e -> BoxState s -> Widget s e
makeBox BoxCfg s e
config forall {s}. BoxState s
state) WidgetNode s e
managed where
config :: BoxCfg s e
config = forall a. Monoid a => [a] -> a
mconcat [BoxCfg s e]
configs
state :: BoxState s
state = forall s. Maybe s -> BoxState s
BoxState forall a. Maybe a
Nothing
makeNode :: Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode :: forall s e. Widget s e -> WidgetNode s e -> WidgetNode s e
makeNode Widget s e
widget WidgetNode s e
managedWidget = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"box" Widget s e
widget
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. HasFocusable s a => Lens' s a
L.focusable forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
forall a b. a -> (a -> b) -> b
& forall s a. HasChildren s a => Lens' s a
L.children forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Seq a
Seq.singleton WidgetNode s e
managedWidget
makeBox
:: (WidgetModel s, WidgetEvent e)
=> BoxCfg s e
-> BoxState s
-> Widget s e
makeBox :: forall s e.
(WidgetModel s, WidgetEvent e) =>
BoxCfg s e -> BoxState s -> Widget s e
makeBox BoxCfg s e
config BoxState s
state = Widget s e
widget where
widget :: Widget s e
widget = forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer BoxState s
state forall a. Default a => a
def {
containerIgnoreEmptyArea :: Bool
containerIgnoreEmptyArea = Bool
ignoreEmptyArea Bool -> Bool -> Bool
&& Int
emptyHandlersCount forall a. Eq a => a -> a -> Bool
== Int
0,
containerGetCurrentStyle :: ContainerGetCurrentStyle s e
containerGetCurrentStyle = forall {s} {e}. WidgetEnv s e -> WidgetNode s e -> StyleState
getCurrentStyle,
containerInit :: ContainerInitHandler s e
containerInit = forall {p}. HasModel p s => p -> WidgetNode s e -> WidgetResult s e
init,
containerMergeChildrenReq :: ContainerMergeChildrenReqHandler s e (BoxState s)
containerMergeChildrenReq = forall {p} {p}. WidgetEnv s e -> p -> p -> BoxState s -> Bool
mergeRequired,
containerMerge :: ContainerMergeHandler s e (BoxState s)
containerMerge = forall {p} {p} {p}.
HasModel p s =>
p -> WidgetNode s e -> p -> p -> WidgetResult s e
merge,
containerFilterEvent :: ContainerFilterHandler s e
containerFilterEvent = ContainerFilterHandler s e
filterEvent,
containerHandleEvent :: ContainerEventHandler s e
containerHandleEvent = forall {p} {p}.
p -> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
containerGetSizeReq :: ContainerGetSizeReqHandler s e
containerGetSizeReq = forall s e. ContainerGetSizeReqHandler s e
getSizeReq,
containerResize :: ContainerResizeHandler s e
containerResize = forall {s} {e} {s} {e}.
WidgetEnv s e
-> WidgetNode s e
-> Rect
-> Seq (WidgetNode s e)
-> (WidgetResult s e, Seq Rect)
resize
}
ignoreEmptyArea :: Bool
ignoreEmptyArea = forall a. a -> Maybe a
Just Bool
True forall a. Eq a => a -> a -> Bool
== forall s e. BoxCfg s e -> Maybe Bool
_boxIgnoreEmptyArea BoxCfg s e
config
emptyHandlersCount :: Int
emptyHandlersCount = forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickEmptyReq BoxCfg s e
config)
init :: p -> WidgetNode s e -> WidgetResult s e
init p
wenv WidgetNode s e
node = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
newState :: BoxState s
newState = forall s. Maybe s -> BoxState s
BoxState (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ p
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasModel s a => Lens' s a
L.model)
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e.
(WidgetModel s, WidgetEvent e) =>
BoxCfg s e -> BoxState s -> Widget s e
makeBox BoxCfg s e
config BoxState s
newState
mergeRequired :: WidgetEnv s e -> p -> p -> BoxState s -> Bool
mergeRequired WidgetEnv s e
wenv p
node p
oldNode BoxState s
oldState = Bool
required where
newModel :: s
newModel = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasModel s a => Lens' s a
L.model
required :: Bool
required = case (forall s e. BoxCfg s e -> Maybe (WidgetEnv s e -> s -> s -> Bool)
_boxMergeRequired BoxCfg s e
config, forall s. BoxState s -> Maybe s
_bxsModel BoxState s
oldState) of
(Just WidgetEnv s e -> s -> s -> Bool
mergeReqFn, Just s
oldModel) -> WidgetEnv s e -> s -> s -> Bool
mergeReqFn WidgetEnv s e
wenv s
oldModel s
newModel
(Maybe (WidgetEnv s e -> s -> s -> Bool), Maybe s)
_ -> Bool
True
merge :: p -> WidgetNode s e -> p -> p -> WidgetResult s e
merge p
wenv WidgetNode s e
node p
oldNode p
oldState = forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
newNode where
newState :: BoxState s
newState = forall s. Maybe s -> BoxState s
BoxState (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ p
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasModel s a => Lens' s a
L.model)
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e.
(WidgetModel s, WidgetEvent e) =>
BoxCfg s e -> BoxState s -> Widget s e
makeBox BoxCfg s e
config BoxState s
newState
getCurrentStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
getCurrentStyle = forall s e.
CurrentStyleCfg s e
-> WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle_ CurrentStyleCfg s e
currentStyleConfig where
currentStyleConfig :: CurrentStyleCfg s e
currentStyleConfig = forall a. Default a => a
def
forall a b. a -> (a -> b) -> b
& forall s a. HasIsActive s a => Lens' s a
L.isActive forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeTreeActive
filterEvent :: ContainerFilterHandler s e
filterEvent = case forall s e. BoxCfg s e -> Maybe (ContainerFilterHandler s e)
_boxFilterEvent BoxCfg s e
config of
Just ContainerFilterHandler s e
handler -> ContainerFilterHandler s e
handler
Maybe (ContainerFilterHandler s e)
_ -> \WidgetEnv s e
wenv WidgetNode s e
node Path
target SystemEvent
evt -> forall a. a -> Maybe a
Just (Path
target, SystemEvent
evt)
handleEvent :: p -> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent p
wenv WidgetNode s e
node p
target SystemEvent
evt = case SystemEvent
evt of
Focus Path
prev -> forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
prev (forall s e. BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnFocusReq BoxCfg s e
config)
Blur Path
next -> forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
next (forall s e. BoxCfg s e -> [Path -> WidgetRequest s e]
_boxOnBlurReq BoxCfg s e
config)
Enter Point
point
| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) Bool -> Bool -> Bool
&& Point -> Bool
inChildVp Point
point -> Maybe (WidgetResult s e)
result where
reqs :: [WidgetRequest s e]
reqs = forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnEnterReq BoxCfg s e
config
result :: Maybe (WidgetResult s e)
result = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)
Leave Point
point
| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) -> Maybe (WidgetResult s e)
result where
reqs :: [WidgetRequest s e]
reqs = forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnLeaveReq BoxCfg s e
config
result :: Maybe (WidgetResult s e)
result = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)
Click Point
point Button
btn Int
_
| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) Bool -> Bool -> Bool
&& Point -> Bool
inChildVp Point
point -> Maybe (WidgetResult s e)
result where
reqs :: [WidgetRequest s e]
reqs = forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickReq BoxCfg s e
config
result :: Maybe (WidgetResult s e)
result = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)
Click Point
point Button
btn Int
_
| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Bool
inChildVp Point
point) -> Maybe (WidgetResult s e)
result where
reqs :: [WidgetRequest s e]
reqs = forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickEmptyReq BoxCfg s e
config
result :: Maybe (WidgetResult s e)
result = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)
ButtonAction Point
point Button
btn ButtonState
BtnPressed Int
clicks
| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) Bool -> Bool -> Bool
&& Point -> Bool
inChildVp Point
point -> Maybe (WidgetResult s e)
result where
reqs :: [WidgetRequest s e]
reqs = forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnPressedReq BoxCfg s e
config forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Button
btn forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
clicks
result :: Maybe (WidgetResult s e)
result = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)
ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
| Int
clicks forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) Bool -> Bool -> Bool
&& Point -> Bool
inChildVp Point
point -> Maybe (WidgetResult s e)
result where
reqs :: [WidgetRequest s e]
reqs = forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq BoxCfg s e
config forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Button
btn forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
clicks
result :: Maybe (WidgetResult s e)
result = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)
ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
| Int
clicks forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) Bool -> Bool -> Bool
&& Point -> Bool
inChildVp Point
point -> Maybe (WidgetResult s e)
result where
reqsA :: [WidgetRequest s e]
reqsA = forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickReq BoxCfg s e
config
reqsB :: [WidgetRequest s e]
reqsB = forall s e. BoxCfg s e -> [Button -> Int -> WidgetRequest s e]
_boxOnBtnReleasedReq BoxCfg s e
config forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Button
btn forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
clicks
reqs :: [WidgetRequest s e]
reqs = [WidgetRequest s e]
reqsA forall a. Semigroup a => a -> a -> a
<> [WidgetRequest s e]
reqsB
result :: Maybe (WidgetResult s e)
result = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)
ButtonAction Point
point Button
btn ButtonState
BtnReleased Int
clicks
| Int
clicks forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WidgetRequest s e]
reqs) Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Bool
inChildVp Point
point) -> Maybe (WidgetResult s e)
result where
reqs :: [WidgetRequest s e]
reqs = forall s e. BoxCfg s e -> [WidgetRequest s e]
_boxOnClickEmptyReq BoxCfg s e
config
result :: Maybe (WidgetResult s e)
result = forall a. a -> Maybe a
Just (forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs)
SystemEvent
_ -> forall a. Maybe a
Nothing
where
child :: WidgetNode s e
child = forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children) Int
0
inChildVp :: Point -> Bool
inChildVp Point
point = Point -> Rect -> Bool
pointInRect Point
point (WidgetNode s e
child 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)
getSizeReq :: ContainerGetSizeReqHandler s e
getSizeReq :: forall s e. ContainerGetSizeReqHandler s e
getSizeReq WidgetEnv s e
wenv WidgetNode s e
node Seq (WidgetNode s e)
children = (SizeReq, SizeReq)
newSizeReq where
sizeReqFns :: [SizeReqUpdater]
sizeReqFns = forall s e. BoxCfg s e -> [SizeReqUpdater]
_boxSizeReqUpdater BoxCfg s e
config
child :: WidgetNode s e
child = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
newReqW :: SizeReq
newReqW = WidgetNode s e
child 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. HasSizeReqW s a => Lens' s a
L.sizeReqW
newReqH :: SizeReq
newReqH = WidgetNode s e
child 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. HasSizeReqH s a => Lens' s a
L.sizeReqH
newSizeReq :: (SizeReq, SizeReq)
newSizeReq = forall a. [a -> a] -> a -> a
applyFnList [SizeReqUpdater]
sizeReqFns (SizeReq
newReqW, SizeReq
newReqH)
resize :: WidgetEnv s e
-> WidgetNode s e
-> Rect
-> Seq (WidgetNode s e)
-> (WidgetResult s e, Seq Rect)
resize WidgetEnv s e
wenv WidgetNode s e
node Rect
viewport Seq (WidgetNode s e)
children = (WidgetResult s e, Seq Rect)
resized where
style :: StyleState
style = forall {s} {e}. WidgetEnv s e -> WidgetNode s e -> StyleState
getCurrentStyle WidgetEnv s e
wenv WidgetNode s e
node
child :: WidgetNode s e
child = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
contentArea :: Rect
contentArea = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (StyleState -> Rect -> Maybe Rect
removeOuterBounds StyleState
style Rect
viewport)
Rect Double
cx Double
cy Double
cw Double
ch = Rect
contentArea
contentW :: Double
contentW = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall s e.
Bool
-> Rect -> Double -> Seq (WidgetNode s e) -> (Seq Rect, Double)
assignStackAreas Bool
True Rect
contentArea Double
0 Seq (WidgetNode s e)
children
contentH :: Double
contentH = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall s e.
Bool
-> Rect -> Double -> Seq (WidgetNode s e) -> (Seq Rect, Double)
assignStackAreas Bool
False Rect
contentArea Double
0 Seq (WidgetNode s e)
children
raChild :: Rect
raChild = Double -> Double -> Double -> Double -> Rect
Rect Double
cx Double
cy (forall a. Ord a => a -> a -> a
min Double
cw Double
contentW) (forall a. Ord a => a -> a -> a
min Double
ch Double
contentH)
ah :: AlignH
ah = forall a. a -> Maybe a -> a
fromMaybe AlignH
ACenter (forall s e. BoxCfg s e -> Maybe AlignH
_boxAlignH BoxCfg s e
config)
av :: AlignV
av = forall a. a -> Maybe a -> a
fromMaybe AlignV
AMiddle (forall s e. BoxCfg s e -> Maybe AlignV
_boxAlignV BoxCfg s e
config)
raAligned :: Rect
raAligned = Rect -> Rect -> AlignH -> AlignV -> Rect
alignInRect Rect
contentArea Rect
raChild AlignH
ah AlignV
av
expand :: Bool
expand = forall a. a -> Maybe a -> a
fromMaybe Bool
False (forall s e. BoxCfg s e -> Maybe Bool
_boxExpandContent BoxCfg s e
config)
resized :: (WidgetResult s e, Seq Rect)
resized
| Bool
expand = (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node, forall a. a -> Seq a
Seq.singleton Rect
contentArea)
| Bool
otherwise = (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node, forall a. a -> Seq a
Seq.singleton Rect
raAligned)