{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
module Monomer.Widgets.Containers.Popup (
PopupCfg,
popupAnchor,
popupAlignToOuterH,
popupAlignToOuterH_,
popupAlignToOuterV,
popupAlignToOuterV_,
popupAlignToWindow,
popupAlignToWindow_,
popupOffset,
popupOpenAtCursor,
popupOpenAtCursor_,
popupDisableClose,
popupDisableClose_,
popup,
popup_,
popupV,
popupV_,
popupD_
) where
import Control.Applicative ((<|>))
import Control.Lens
import Control.Monad (when)
import Data.Default
import Data.Maybe
import qualified Data.Sequence as Seq
import Monomer.Widgets.Container
import Monomer.Widgets.Singles.Spacer
import qualified Monomer.Lens as L
data s e = {
forall s e. PopupCfg s e -> Maybe (WidgetNode s e)
_ppcAnchor :: Maybe (WidgetNode s e),
forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToOuterH :: Maybe Bool,
forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToOuterV :: Maybe Bool,
forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToWindow :: Maybe Bool,
forall s e. PopupCfg s e -> Maybe AlignH
_ppcAlignH :: Maybe AlignH,
forall s e. PopupCfg s e -> Maybe AlignV
_ppcAlignV :: Maybe AlignV,
forall s e. PopupCfg s e -> Maybe Point
_ppcOffset :: Maybe Point,
forall s e. PopupCfg s e -> Maybe Bool
_ppcOpenAtCursor :: Maybe Bool,
forall s e. PopupCfg s e -> Maybe Bool
_ppcDisableClose :: Maybe Bool,
forall s e. PopupCfg s e -> [Bool -> WidgetRequest s e]
_ppcOnChangeReq :: [Bool -> WidgetRequest s e]
}
instance Default (PopupCfg s e) where
def :: PopupCfg s e
def = PopupCfg {
_ppcAnchor :: Maybe (WidgetNode s e)
_ppcAnchor = forall a. Maybe a
Nothing,
_ppcAlignToOuterH :: Maybe Bool
_ppcAlignToOuterH = forall a. Maybe a
Nothing,
_ppcAlignToOuterV :: Maybe Bool
_ppcAlignToOuterV = forall a. Maybe a
Nothing,
_ppcAlignToWindow :: Maybe Bool
_ppcAlignToWindow = forall a. Maybe a
Nothing,
_ppcAlignH :: Maybe AlignH
_ppcAlignH = forall a. Maybe a
Nothing,
_ppcAlignV :: Maybe AlignV
_ppcAlignV = forall a. Maybe a
Nothing,
_ppcOffset :: Maybe Point
_ppcOffset = forall a. Maybe a
Nothing,
_ppcOpenAtCursor :: Maybe Bool
_ppcOpenAtCursor = forall a. Maybe a
Nothing,
_ppcDisableClose :: Maybe Bool
_ppcDisableClose = forall a. Maybe a
Nothing,
_ppcOnChangeReq :: [Bool -> WidgetRequest s e]
_ppcOnChangeReq = []
}
instance Semigroup (PopupCfg s e) where
<> :: PopupCfg s e -> PopupCfg s e -> PopupCfg s e
(<>) PopupCfg s e
t1 PopupCfg s e
t2 = PopupCfg {
_ppcAnchor :: Maybe (WidgetNode s e)
_ppcAnchor = forall s e. PopupCfg s e -> Maybe (WidgetNode s e)
_ppcAnchor PopupCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. PopupCfg s e -> Maybe (WidgetNode s e)
_ppcAnchor PopupCfg s e
t1,
_ppcAlignToOuterH :: Maybe Bool
_ppcAlignToOuterH = forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToOuterH PopupCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToOuterH PopupCfg s e
t1,
_ppcAlignToOuterV :: Maybe Bool
_ppcAlignToOuterV = forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToOuterV PopupCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToOuterV PopupCfg s e
t1,
_ppcAlignToWindow :: Maybe Bool
_ppcAlignToWindow = forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToWindow PopupCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToWindow PopupCfg s e
t1,
_ppcAlignH :: Maybe AlignH
_ppcAlignH = forall s e. PopupCfg s e -> Maybe AlignH
_ppcAlignH PopupCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. PopupCfg s e -> Maybe AlignH
_ppcAlignH PopupCfg s e
t1,
_ppcAlignV :: Maybe AlignV
_ppcAlignV = forall s e. PopupCfg s e -> Maybe AlignV
_ppcAlignV PopupCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. PopupCfg s e -> Maybe AlignV
_ppcAlignV PopupCfg s e
t1,
_ppcOffset :: Maybe Point
_ppcOffset = forall s e. PopupCfg s e -> Maybe Point
_ppcOffset PopupCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. PopupCfg s e -> Maybe Point
_ppcOffset PopupCfg s e
t1,
_ppcOpenAtCursor :: Maybe Bool
_ppcOpenAtCursor = forall s e. PopupCfg s e -> Maybe Bool
_ppcOpenAtCursor PopupCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. PopupCfg s e -> Maybe Bool
_ppcOpenAtCursor PopupCfg s e
t1,
_ppcDisableClose :: Maybe Bool
_ppcDisableClose = forall s e. PopupCfg s e -> Maybe Bool
_ppcDisableClose PopupCfg s e
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e. PopupCfg s e -> Maybe Bool
_ppcDisableClose PopupCfg s e
t1,
_ppcOnChangeReq :: [Bool -> WidgetRequest s e]
_ppcOnChangeReq = forall s e. PopupCfg s e -> [Bool -> WidgetRequest s e]
_ppcOnChangeReq PopupCfg s e
t1 forall a. Semigroup a => a -> a -> a
<> forall s e. PopupCfg s e -> [Bool -> WidgetRequest s e]
_ppcOnChangeReq PopupCfg s e
t2
}
instance Monoid (PopupCfg s e) where
mempty :: PopupCfg s e
mempty = forall a. Default a => a
def
instance CmbAlignLeft (PopupCfg s e) where
alignLeft_ :: Bool -> PopupCfg s e
alignLeft_ Bool
False = forall a. Default a => a
def
alignLeft_ Bool
True = forall a. Default a => a
def {
_ppcAlignH :: Maybe AlignH
_ppcAlignH = forall a. a -> Maybe a
Just AlignH
ALeft
}
instance CmbAlignCenter (PopupCfg s e) where
alignCenter_ :: Bool -> PopupCfg s e
alignCenter_ Bool
False = forall a. Default a => a
def
alignCenter_ Bool
True = forall a. Default a => a
def {
_ppcAlignH :: Maybe AlignH
_ppcAlignH = forall a. a -> Maybe a
Just AlignH
ACenter
}
instance CmbAlignRight (PopupCfg s e) where
alignRight_ :: Bool -> PopupCfg s e
alignRight_ Bool
False = forall a. Default a => a
def
alignRight_ Bool
True = forall a. Default a => a
def {
_ppcAlignH :: Maybe AlignH
_ppcAlignH = forall a. a -> Maybe a
Just AlignH
ARight
}
instance CmbAlignTop (PopupCfg s e) where
alignTop_ :: Bool -> PopupCfg s e
alignTop_ Bool
False = forall a. Default a => a
def
alignTop_ Bool
True = forall a. Default a => a
def {
_ppcAlignV :: Maybe AlignV
_ppcAlignV = forall a. a -> Maybe a
Just AlignV
ATop
}
instance CmbAlignMiddle (PopupCfg s e) where
alignMiddle_ :: Bool -> PopupCfg s e
alignMiddle_ Bool
False = forall a. Default a => a
def
alignMiddle_ Bool
True = forall a. Default a => a
def {
_ppcAlignV :: Maybe AlignV
_ppcAlignV = forall a. a -> Maybe a
Just AlignV
AMiddle
}
instance CmbAlignBottom (PopupCfg s e) where
alignBottom_ :: Bool -> PopupCfg s e
alignBottom_ Bool
False = forall a. Default a => a
def
alignBottom_ Bool
True = forall a. Default a => a
def {
_ppcAlignV :: Maybe AlignV
_ppcAlignV = forall a. a -> Maybe a
Just AlignV
ABottom
}
instance WidgetEvent e => CmbOnChange (PopupCfg s e) Bool e where
onChange :: (Bool -> e) -> PopupCfg s e
onChange Bool -> e
fn = forall a. Default a => a
def {
_ppcOnChangeReq :: [Bool -> WidgetRequest s e]
_ppcOnChangeReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> e
fn]
}
instance CmbOnChangeReq (PopupCfg s e) s e Bool where
onChangeReq :: (Bool -> WidgetRequest s e) -> PopupCfg s e
onChangeReq Bool -> WidgetRequest s e
req = forall a. Default a => a
def {
_ppcOnChangeReq :: [Bool -> WidgetRequest s e]
_ppcOnChangeReq = [Bool -> WidgetRequest s e
req]
}
popupAnchor :: WidgetNode s e -> PopupCfg s e
WidgetNode s e
node = forall a. Default a => a
def {
_ppcAnchor :: Maybe (WidgetNode s e)
_ppcAnchor = forall a. a -> Maybe a
Just WidgetNode s e
node
}
popupAlignToOuterH :: PopupCfg s e
= forall s e. Bool -> PopupCfg s e
popupAlignToOuterH_ Bool
True
popupAlignToOuterH_ :: Bool -> PopupCfg s e
Bool
align = forall a. Default a => a
def {
_ppcAlignToOuterH :: Maybe Bool
_ppcAlignToOuterH = forall a. a -> Maybe a
Just Bool
align
}
popupAlignToOuterV :: PopupCfg s e
= forall s e. Bool -> PopupCfg s e
popupAlignToOuterV_ Bool
True
popupAlignToOuterV_ :: Bool -> PopupCfg s e
Bool
align = forall a. Default a => a
def {
_ppcAlignToOuterV :: Maybe Bool
_ppcAlignToOuterV = forall a. a -> Maybe a
Just Bool
align
}
popupAlignToWindow :: PopupCfg s e
= forall s e. Bool -> PopupCfg s e
popupAlignToWindow_ Bool
True
popupAlignToWindow_ :: Bool -> PopupCfg s e
Bool
align = forall a. Default a => a
def {
_ppcAlignToWindow :: Maybe Bool
_ppcAlignToWindow = forall a. a -> Maybe a
Just Bool
align
}
popupOffset :: Point -> PopupCfg s e
Point
point = forall a. Default a => a
def {
_ppcOffset :: Maybe Point
_ppcOffset = forall a. a -> Maybe a
Just Point
point
}
popupOpenAtCursor :: PopupCfg s e
= forall s e. Bool -> PopupCfg s e
popupOpenAtCursor_ Bool
True
popupOpenAtCursor_ :: Bool -> PopupCfg s e
Bool
open = forall a. Default a => a
def {
_ppcOpenAtCursor :: Maybe Bool
_ppcOpenAtCursor = forall a. a -> Maybe a
Just Bool
open
}
popupDisableClose :: PopupCfg s e
= forall s e. Bool -> PopupCfg s e
popupDisableClose_ Bool
True
popupDisableClose_ :: Bool -> PopupCfg s e
Bool
close = forall a. Default a => a
def {
_ppcDisableClose :: Maybe Bool
_ppcDisableClose = forall a. a -> Maybe a
Just Bool
close
}
data = {
PopupState -> Point
_ppsClickPos :: Point,
PopupState -> Millisecond
_ppsReleaseMs :: Millisecond
} deriving (PopupState -> PopupState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PopupState -> PopupState -> Bool
$c/= :: PopupState -> PopupState -> Bool
== :: PopupState -> PopupState -> Bool
$c== :: PopupState -> PopupState -> Bool
Eq, Int -> PopupState -> ShowS
[PopupState] -> ShowS
PopupState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PopupState] -> ShowS
$cshowList :: [PopupState] -> ShowS
show :: PopupState -> String
$cshow :: PopupState -> String
showsPrec :: Int -> PopupState -> ShowS
$cshowsPrec :: Int -> PopupState -> ShowS
Show)
popup
:: WidgetModel s
=> ALens' s Bool
-> WidgetNode s e
-> WidgetNode s e
ALens' s Bool
field WidgetNode s e
content = forall s e.
WidgetModel s =>
ALens' s Bool -> [PopupCfg s e] -> WidgetNode s e -> WidgetNode s e
popup_ ALens' s Bool
field forall a. Default a => a
def WidgetNode s e
content
popup_
:: WidgetModel s
=> ALens' s Bool
-> [PopupCfg s e]
-> WidgetNode s e
-> WidgetNode s e
ALens' s Bool
field [PopupCfg s e]
configs WidgetNode s e
content = WidgetNode s e
newNode where
newNode :: WidgetNode s e
newNode = forall s e.
WidgetModel s =>
WidgetData s Bool
-> [PopupCfg s e] -> WidgetNode s e -> WidgetNode s e
popupD_ (forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s Bool
field) [PopupCfg s e]
configs WidgetNode s e
content
popupV
:: (WidgetModel s, WidgetEvent e)
=> Bool
-> (Bool -> e)
-> WidgetNode s e
-> WidgetNode s e
Bool
value Bool -> e
handler WidgetNode s e
content = forall s e.
(WidgetModel s, WidgetEvent e) =>
Bool
-> (Bool -> e)
-> [PopupCfg s e]
-> WidgetNode s e
-> WidgetNode s e
popupV_ Bool
value Bool -> e
handler forall a. Default a => a
def WidgetNode s e
content
popupV_
:: (WidgetModel s, WidgetEvent e)
=> Bool
-> (Bool -> e)
-> [PopupCfg s e]
-> WidgetNode s e
-> WidgetNode s e
Bool
value Bool -> e
handler [PopupCfg s e]
configs WidgetNode s e
content = WidgetNode s e
newNode where
newConfigs :: [PopupCfg s e]
newConfigs = forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange Bool -> e
handler forall a. a -> [a] -> [a]
: [PopupCfg s e]
configs
newNode :: WidgetNode s e
newNode = forall s e.
WidgetModel s =>
WidgetData s Bool
-> [PopupCfg s e] -> WidgetNode s e -> WidgetNode s e
popupD_ (forall s a. a -> WidgetData s a
WidgetValue Bool
value) [PopupCfg s e]
newConfigs WidgetNode s e
content
popupD_
:: WidgetModel s
=> WidgetData s Bool
-> [PopupCfg s e]
-> WidgetNode s e
-> WidgetNode s e
WidgetData s Bool
wdata [PopupCfg s e]
configs WidgetNode s e
content = forall s e.
Widget s e -> WidgetNode s e -> WidgetNode s e -> WidgetNode s e
makeNode Widget s e
widget WidgetNode s e
anchor WidgetNode s e
content where
config :: PopupCfg s e
config = forall a. Monoid a => [a] -> a
mconcat [PopupCfg s e]
configs
state :: PopupState
state = Point -> Millisecond -> PopupState
PopupState forall a. Default a => a
def (-Millisecond
1)
widget :: Widget s e
widget = forall s e.
WidgetModel s =>
WidgetData s Bool -> PopupCfg s e -> PopupState -> Widget s e
makePopup WidgetData s Bool
wdata PopupCfg s e
config PopupState
state
anchor :: WidgetNode s e
anchor = case forall s e. PopupCfg s e -> Maybe (WidgetNode s e)
_ppcAnchor PopupCfg s e
config of
Just WidgetNode s e
node -> WidgetNode s e
node
Maybe (WidgetNode s e)
Nothing -> forall s e. WidgetNode s e
spacer
forall t. CmbStyleBasic t => t -> [StyleState] -> t
`styleBasic` [forall t. CmbMaxWidth t => Double -> t
maxWidth Double
0.01, forall t. CmbMaxHeight t => Double -> t
maxHeight Double
0.01]
makeNode :: Widget s e -> WidgetNode s e -> WidgetNode s e -> WidgetNode s e
makeNode :: forall s e.
Widget s e -> WidgetNode s e -> WidgetNode s e -> WidgetNode s e
makeNode Widget s e
widget WidgetNode s e
anchor WidgetNode s e
content = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"popup" 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.fromList [WidgetNode s e
anchor, WidgetNode s e
content]
anchorIdx :: Int
anchorIdx :: Int
anchorIdx = Int
0
contentIdx :: Int
contentIdx :: Int
contentIdx = Int
1
makePopup
:: forall s e . WidgetModel s
=> WidgetData s Bool
-> PopupCfg s e
-> PopupState
-> Widget s e
WidgetData s Bool
field PopupCfg s e
config PopupState
state = Widget s e
widget where
container :: Container s e PopupState
container = forall a. Default a => a
def {
containerAddStyleReq :: Bool
containerAddStyleReq = Bool
False,
containerInitPost :: ContainerInitPostHandler s e PopupState
containerInitPost = forall {p}.
WidgetEnv s e
-> p -> PopupState -> WidgetResult s e -> WidgetResult s e
initPost,
containerMergePost :: ContainerMergePostHandler s e PopupState
containerMergePost = forall {p} {p} {p}.
WidgetEnv s e
-> p
-> p
-> PopupState
-> p
-> WidgetResult s e
-> WidgetResult s e
mergePost,
containerHandleEvent :: ContainerEventHandler s e
containerHandleEvent = ContainerEventHandler s e
handleEvent,
containerGetSizeReq :: ContainerGetSizeReqHandler s e
containerGetSizeReq = ContainerGetSizeReqHandler s e
getSizeReq,
containerResize :: ContainerResizeHandler s e
containerResize = ContainerResizeHandler s e
resize
}
baseWidget :: Widget s e
baseWidget = forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer PopupState
state Container s e PopupState
container
widget :: Widget s e
widget = Widget s e
baseWidget {
widgetRender :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
widgetRender = WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render
}
initPost :: WidgetEnv s e
-> p -> PopupState -> WidgetResult s e -> WidgetResult s e
initPost WidgetEnv s e
wenv p
node PopupState
newState WidgetResult s e
result = WidgetResult s e
newResult where
newResult :: WidgetResult s e
newResult = forall s e.
WidgetModel s =>
WidgetData s Bool
-> PopupCfg s e
-> PopupState
-> WidgetEnv s e
-> WidgetResult s e
-> WidgetResult s e
checkPopup WidgetData s Bool
field PopupCfg s e
config PopupState
newState WidgetEnv s e
wenv WidgetResult s e
result
mergePost :: WidgetEnv s e
-> p
-> p
-> PopupState
-> p
-> WidgetResult s e
-> WidgetResult s e
mergePost WidgetEnv s e
wenv p
node p
oldNode PopupState
oldState p
newState WidgetResult s e
result = WidgetResult s e
newResult where
newResult :: WidgetResult s e
newResult = forall s e.
WidgetModel s =>
WidgetData s Bool
-> PopupCfg s e
-> PopupState
-> WidgetEnv s e
-> WidgetResult s e
-> WidgetResult s e
checkPopup WidgetData s Bool
field PopupCfg s e
config PopupState
oldState WidgetEnv s e
wenv WidgetResult s e
result
handleEvent :: ContainerEventHandler s e
handleEvent WidgetEnv s e
wenv WidgetNode s e
node Path
target SystemEvent
evt = case SystemEvent
evt of
KeyAction KeyMod
mod KeyCode
code KeyStatus
KeyPressed
| Bool
isCloseable Bool -> Bool -> Bool
&& KeyCode -> Bool
isKeyEscape KeyCode
code -> forall a. a -> Maybe a
Just WidgetResult s e
closeResult
ButtonAction Point
point Button
button ButtonState
BtnReleased Int
clicks
| Bool
isCloseable Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Bool
insidePopup Point
point) -> forall a. a -> Maybe a
Just WidgetResult s e
closeResult
Click Point
point Button
button Int
clicks
| Bool
isCloseable Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Bool
insidePopup Point
point) -> forall a. a -> Maybe a
Just WidgetResult s e
closeResult
SystemEvent
_
| (Bool
isVisible Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isContentTarget) Bool -> Bool -> Bool
|| Bool
matchMs -> forall a. a -> Maybe a
Just WidgetResult s e
ignoreResult
| Bool
otherwise -> forall a. Maybe a
Nothing
where
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
disableClose :: Bool
disableClose = forall s e. PopupCfg s e -> Maybe Bool
_ppcDisableClose PopupCfg s e
config forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True
matchMs :: Bool
matchMs = PopupState -> Millisecond
_ppsReleaseMs PopupState
state forall a. Eq a => a -> a -> Bool
== WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasTimestamp s a => Lens' s a
L.timestamp
isVisible :: Bool
isVisible = forall s a. s -> WidgetData s a -> a
widgetDataGet (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasModel s a => Lens' s a
L.model) WidgetData s Bool
field
isContentTarget :: Bool
isContentTarget = Path -> Path -> Bool
isPathParent (Path
path forall s a. Snoc s s a a => s -> a -> s
|> Int
contentIdx) Path
target
isCloseable :: Bool
isCloseable = Bool
isVisible Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
disableClose
content :: WidgetNode s e
content = 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
contentIdx
cviewport :: Rect
cviewport = WidgetNode s e
content 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
insidePopup :: Point -> Bool
insidePopup Point
point = Point -> Rect -> Bool
pointInRect Point
point Rect
cviewport
closeResult :: WidgetResult s e
closeResult = forall s e.
WidgetModel s =>
WidgetData s Bool
-> PopupCfg s e
-> PopupState
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetResult s e
closePopup WidgetData s Bool
field PopupCfg s e
config PopupState
state WidgetEnv s e
wenv WidgetNode s e
node
ignoreResult :: WidgetResult s e
ignoreResult = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall s e. WidgetRequest s e
IgnoreChildrenEvents]
getSizeReq :: ContainerGetSizeReqHandler s e
getSizeReq :: ContainerGetSizeReqHandler s e
getSizeReq WidgetEnv s e
wenv WidgetNode s e
node Seq (WidgetNode s e)
children = (SizeReq
newReqW, SizeReq
newReqH) where
anchor :: WidgetNode s e
anchor = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
anchorIdx
newReqW :: SizeReq
newReqW = WidgetNode s e
anchor 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
anchor 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
resize :: ContainerResizeHandler s e
resize :: ContainerResizeHandler s e
resize WidgetEnv s e
wenv WidgetNode s e
node Rect
viewport Seq (WidgetNode s e)
children = (WidgetResult s e, Seq Rect)
resized where
Size Double
ww Double
wh = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasWindowSize s a => Lens' s a
L.windowSize
Rect Double
px Double
py Double
pw Double
ph = Rect
viewport
Point Double
sx Double
sy = Point -> Point -> Point
subPoint (PopupState -> Point
_ppsClickPos PopupState
state) (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasOffset s a => Lens' s a
L.offset)
Point Double
ox Double
oy = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def (forall s e. PopupCfg s e -> Maybe Point
_ppcOffset PopupCfg s e
config)
alignOuterH :: Bool
alignOuterH = forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToOuterH PopupCfg s e
config forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True
alignOuterV :: Bool
alignOuterV = forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToOuterV PopupCfg s e
config forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True
alignWin :: Bool
alignWin = forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToWindow PopupCfg s e
config forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True
alignH :: Maybe AlignH
alignH = forall s e. PopupCfg s e -> Maybe AlignH
_ppcAlignH PopupCfg s e
config
alignV :: Maybe AlignV
alignV = forall s e. PopupCfg s e -> Maybe AlignV
_ppcAlignV PopupCfg s e
config
openAtCursor :: Bool
openAtCursor = forall s e. PopupCfg s e -> Maybe Bool
_ppcOpenAtCursor PopupCfg s e
config forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True
content :: WidgetNode s e
content = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
contentIdx
cw :: Double
cw = SizeReq -> Double
sizeReqMaxBounded (WidgetNode s e
content 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)
ch :: Double
ch = SizeReq -> Double
sizeReqMaxBounded (WidgetNode s e
content 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)
(Bool
alignL, Bool
alignR) = (Maybe AlignH
alignH forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just AlignH
ALeft, Maybe AlignH
alignH forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just AlignH
ARight)
(Bool
alignT, Bool
alignB) = (Maybe AlignV
alignV forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just AlignV
ATop, Maybe AlignV
alignV forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just AlignV
ABottom)
(Bool
alignC, Bool
alignM) = (Maybe AlignH
alignH forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just AlignH
ACenter, Maybe AlignV
alignV forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just AlignV
AMiddle)
Rect Double
ax Double
ay Double
aw Double
ah
| Bool
alignWin = Double -> Double -> Double -> Double -> Rect
Rect Double
0 Double
0 Double
ww Double
wh
| Bool
otherwise = Rect
viewport
(Double
atx, Double
arx)
| Bool
alignOuterH = (Double
ax forall a. Num a => a -> a -> a
- Double
cw forall a. Num a => a -> a -> a
+ Double
ox, Double
ax forall a. Num a => a -> a -> a
+ Double
aw forall a. Num a => a -> a -> a
+ Double
ox)
| Bool
otherwise = (Double
ax forall a. Num a => a -> a -> a
+ Double
ox, Double
ax forall a. Num a => a -> a -> a
+ Double
aw forall a. Num a => a -> a -> a
- Double
cw forall a. Num a => a -> a -> a
+ Double
ox)
(Double
aty, Double
aby)
| Bool
alignOuterV = (Double
ay forall a. Num a => a -> a -> a
- Double
ch forall a. Num a => a -> a -> a
+ Double
oy, Double
ay forall a. Num a => a -> a -> a
+ Double
ah forall a. Num a => a -> a -> a
+ Double
oy)
| Bool
otherwise = (Double
ay forall a. Num a => a -> a -> a
+ Double
oy, Double
ay forall a. Num a => a -> a -> a
+ Double
ah forall a. Num a => a -> a -> a
- Double
ch forall a. Num a => a -> a -> a
+ Double
oy)
Point Double
olx Double
oty = forall s e. WidgetEnv s e -> PopupCfg s e -> Rect -> Point
calcWindowOffset WidgetEnv s e
wenv PopupCfg s e
config (Double -> Double -> Double -> Double -> Rect
Rect Double
atx Double
aty Double
cw Double
ch)
Point Double
orx Double
oby = forall s e. WidgetEnv s e -> PopupCfg s e -> Rect -> Point
calcWindowOffset WidgetEnv s e
wenv PopupCfg s e
config (Double -> Double -> Double -> Double -> Rect
Rect Double
arx Double
aby Double
cw Double
ch)
fits :: a -> Bool
fits a
offset = forall a. Num a => a -> a
abs a
offset forall a. Ord a => a -> a -> Bool
< a
0.01 Bool -> Bool -> Bool
|| Bool
alignWin
(Bool
fitL, Bool
fitR) = (forall {a}. (Ord a, Fractional a) => a -> Bool
fits Double
olx, forall {a}. (Ord a, Fractional a) => a -> Bool
fits Double
orx)
(Bool
fitT, Bool
fitB) = (forall {a}. (Ord a, Fractional a) => a -> Bool
fits Double
oty, forall {a}. (Ord a, Fractional a) => a -> Bool
fits Double
oby)
cx :: Double
cx
| Bool
openAtCursor = Double
sx
| Bool
alignC = Double
ax forall a. Num a => a -> a -> a
+ (Double
aw forall a. Num a => a -> a -> a
- Double
cw) forall a. Fractional a => a -> a -> a
/ Double
2
| Bool
alignL Bool -> Bool -> Bool
&& (Bool
fitL Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
fitR) Bool -> Bool -> Bool
|| Bool
alignR Bool -> Bool -> Bool
&& Bool
fitL Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
fitR = Double
atx forall a. Num a => a -> a -> a
- Double
ox
| Bool
alignR Bool -> Bool -> Bool
&& (Bool
fitR Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
fitL) Bool -> Bool -> Bool
|| Bool
alignL Bool -> Bool -> Bool
&& Bool
fitR Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
fitL = Double
arx forall a. Num a => a -> a -> a
- Double
ox
| Bool
otherwise = Double
ax
cy :: Double
cy
| Bool
openAtCursor = Double
sy
| Bool
alignM = Double
ay forall a. Num a => a -> a -> a
+ (Double
ah forall a. Num a => a -> a -> a
- Double
ch) forall a. Fractional a => a -> a -> a
/ Double
2
| Bool
alignT Bool -> Bool -> Bool
&& (Bool
fitT Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
fitB) Bool -> Bool -> Bool
|| Bool
alignB Bool -> Bool -> Bool
&& Bool
fitT Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
fitB = Double
aty forall a. Num a => a -> a -> a
- Double
oy
| Bool
alignB Bool -> Bool -> Bool
&& (Bool
fitB Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
fitT) Bool -> Bool -> Bool
|| Bool
alignT Bool -> Bool -> Bool
&& Bool
fitB Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
fitT = Double
aby forall a. Num a => a -> a -> a
- Double
oy
| Bool
otherwise = Double
ay
tmpArea :: Rect
tmpArea = Double -> Double -> Double -> Double -> Rect
Rect (Double
cx forall a. Num a => a -> a -> a
+ Double
ox) (Double
cy forall a. Num a => a -> a -> a
+ Double
oy) Double
cw Double
ch
winOffset :: Point
winOffset = forall s e. WidgetEnv s e -> PopupCfg s e -> Rect -> Point
calcWindowOffset WidgetEnv s e
wenv PopupCfg s e
config Rect
tmpArea
carea :: Rect
carea = Point -> Rect -> Rect
moveRect Point
winOffset Rect
tmpArea
assignedAreas :: Seq Rect
assignedAreas = forall a. [a] -> Seq a
Seq.fromList [Rect
viewport, Rect
carea]
resized :: (WidgetResult s e, Seq Rect)
resized = (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node, Seq Rect
assignedAreas)
render :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer = do
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
widgetRender (WidgetNode s e
anchor forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
awenv WidgetNode s e
anchor Renderer
renderer
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isVisible forall a b. (a -> b) -> a -> b
$
Renderer -> IO () -> IO ()
createOverlay Renderer
renderer forall a b. (a -> b) -> a -> b
$
Renderer -> Point -> IO () -> IO ()
drawInTranslation Renderer
renderer Point
scrollOffset forall a b. (a -> b) -> a -> b
$ do
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
widgetRender (WidgetNode s e
content forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget) WidgetEnv s e
cwenv WidgetNode s e
content Renderer
renderer
where
isVisible :: Bool
isVisible = forall s a. s -> WidgetData s a -> a
widgetDataGet (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasModel s a => Lens' s a
L.model) WidgetData s Bool
field
alignWin :: Bool
alignWin = forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToWindow PopupCfg s e
config forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True
scrollOffset :: Point
scrollOffset
| Bool
alignWin = forall a. Default a => a
def
| Bool
otherwise = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasOffset s a => Lens' s a
L.offset
anchor :: WidgetNode s e
anchor = 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
anchorIdx
anchorVp :: Rect
anchorVp = WidgetNode s e
anchor 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
content :: WidgetNode s e
content = 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
contentIdx
contentVp :: Rect
contentVp = WidgetNode s e
content 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
updateOverlay :: Maybe a -> Maybe a
updateOverlay Maybe a
overlay
| Bool
isVisible = forall a. a -> Maybe a
Just (WidgetNode s e
content 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)
| Bool
otherwise = Maybe a
overlay
awenv :: WidgetEnv s e
awenv = forall s e a.
Container s e a
-> WidgetEnv s e -> WidgetNode s e -> Rect -> WidgetEnv s e
updateWenvOffset Container s e PopupState
container WidgetEnv s e
wenv WidgetNode s e
node Rect
anchorVp
forall a b. a -> (a -> b) -> b
& 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
anchorVp
forall a b. a -> (a -> b) -> b
& forall s a. HasOverlayPath s a => Lens' s a
L.overlayPath forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall {a} {a}.
(HasInfo (WidgetNode s e) a, HasPath a a) =>
Maybe a -> Maybe a
updateOverlay
cwenv :: WidgetEnv s e
cwenv = forall s e a.
Container s e a
-> WidgetEnv s e -> WidgetNode s e -> Rect -> WidgetEnv s e
updateWenvOffset Container s e PopupState
container WidgetEnv s e
wenv WidgetNode s e
node Rect
contentVp
forall a b. a -> (a -> b) -> b
& 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
contentVp
calcWindowOffset :: WidgetEnv s e -> PopupCfg s e -> Rect -> Point
calcWindowOffset :: forall s e. WidgetEnv s e -> PopupCfg s e -> Rect -> Point
calcWindowOffset WidgetEnv s e
wenv PopupCfg s e
config Rect
viewport = Double -> Double -> Point
Point Double
offsetX Double
offsetY where
alignWin :: Bool
alignWin = forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToWindow PopupCfg s e
config forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True
Size Double
winW Double
winH = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasWindowSize s a => Lens' s a
L.windowSize
Rect Double
cx Double
cy Double
cw Double
ch
| Bool
alignWin = Rect
viewport
| Bool
otherwise = Point -> Rect -> Rect
moveRect (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasOffset s a => Lens' s a
L.offset) Rect
viewport
offsetX :: Double
offsetX
| Double
cx forall a. Ord a => a -> a -> Bool
< Double
0 = -Double
cx
| Double
cx forall a. Num a => a -> a -> a
+ Double
cw forall a. Ord a => a -> a -> Bool
> Double
winW = Double
winW forall a. Num a => a -> a -> a
- Double
cx forall a. Num a => a -> a -> a
- Double
cw
| Bool
otherwise = Double
0
offsetY :: Double
offsetY
| Double
cy forall a. Ord a => a -> a -> Bool
< Double
0 = -Double
cy
| Double
cy forall a. Num a => a -> a -> a
+ Double
ch forall a. Ord a => a -> a -> Bool
> Double
winH = Double
winH forall a. Num a => a -> a -> a
- Double
cy forall a. Num a => a -> a -> a
- Double
ch
| Bool
otherwise = Double
0
checkPopup
:: WidgetModel s
=> WidgetData s Bool
-> PopupCfg s e
-> PopupState
-> WidgetEnv s e
-> WidgetResult s e
-> WidgetResult s e
WidgetData s Bool
field PopupCfg s e
config PopupState
state WidgetEnv s e
wenv WidgetResult s e
result = WidgetResult s e
newResult where
node :: WidgetNode s e
node = WidgetResult s e
result forall s a. s -> Getting a s a -> a
^. forall s a. HasNode s a => Lens' s a
L.node
shouldDisplay :: Bool
shouldDisplay = forall s a. s -> WidgetData s a -> a
widgetDataGet (WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasModel s a => Lens' s a
L.model) WidgetData s Bool
field
isOverlay :: Bool
isOverlay = forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeInOverlay WidgetEnv s e
wenv WidgetNode s e
node
(WidgetNode s e
newNode, [WidgetRequest s e]
newReqs)
| Bool
shouldDisplay Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isOverlay = forall s e.
WidgetModel s =>
WidgetData s Bool
-> PopupCfg s e
-> PopupState
-> WidgetEnv s e
-> WidgetNode s e
-> (WidgetNode s e, [WidgetRequest s e])
showPopup WidgetData s Bool
field PopupCfg s e
config PopupState
state WidgetEnv s e
wenv WidgetNode s e
node
| Bool -> Bool
not Bool
shouldDisplay Bool -> Bool -> Bool
&& Bool
isOverlay = forall s e.
PopupCfg s e
-> WidgetNode s e -> (WidgetNode s e, [WidgetRequest s e])
hidePopup PopupCfg s e
config WidgetNode s e
node
| Bool
otherwise = (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 =>
WidgetData s Bool -> PopupCfg s e -> PopupState -> Widget s e
makePopup WidgetData s Bool
field PopupCfg s e
config PopupState
state, [])
newResult :: WidgetResult s e
newResult = WidgetResult s e
result
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. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetNode s e
newNode forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget
forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ forall a. [a] -> Seq a
Seq.fromList [WidgetRequest s e]
newReqs
showPopup
:: WidgetModel s
=> WidgetData s Bool
-> PopupCfg s e
-> PopupState
-> WidgetEnv s e
-> WidgetNode s e
-> (WidgetNode s e, [WidgetRequest s e])
WidgetData s Bool
field PopupCfg s e
config PopupState
state WidgetEnv s e
wenv WidgetNode s e
node = (WidgetNode s e
newNode, [WidgetRequest s e]
newReqs) where
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
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
mousePos :: Point
mousePos = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasInputStatus s a => Lens' s a
L.inputStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasMousePos s a => Lens' s a
L.mousePos
anchor :: WidgetNode s e
anchor = 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
anchorIdx
awidgetId :: WidgetId
awidgetId = WidgetNode s e
anchor 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
onChangeReqs :: [WidgetRequest s e]
onChangeReqs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ Bool
True) (forall s e. PopupCfg s e -> [Bool -> WidgetRequest s e]
_ppcOnChangeReq PopupCfg s e
config)
showReqs :: [WidgetRequest s e]
showReqs = [
forall s e. WidgetId -> WidgetRequest s e
ResizeWidgets WidgetId
widgetId,
forall s e. WidgetId -> Path -> WidgetRequest s e
SetOverlay WidgetId
widgetId Path
path,
forall s e. Maybe WidgetId -> FocusDirection -> WidgetRequest s e
MoveFocus (forall a. a -> Maybe a
Just WidgetId
awidgetId) FocusDirection
FocusFwd
]
newState :: PopupState
newState = PopupState
state {
_ppsClickPos :: Point
_ppsClickPos = Point
mousePos
}
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 =>
WidgetData s Bool -> PopupCfg s e -> PopupState -> Widget s e
makePopup WidgetData s Bool
field PopupCfg s e
config PopupState
newState
newReqs :: [WidgetRequest s e]
newReqs = forall a. Monoid a => [a] -> a
mconcat [forall {s} {e}. [WidgetRequest s e]
showReqs, [WidgetRequest s e]
onChangeReqs]
hidePopup
:: PopupCfg s e -> WidgetNode s e -> (WidgetNode s e, [WidgetRequest s e])
PopupCfg s e
config WidgetNode s e
node = (WidgetNode s e
node, [WidgetRequest s e]
onChangeReqs forall a. Semigroup a => a -> a -> a
<> forall {s} {e}. [WidgetRequest s e]
hideReqs) where
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
content :: WidgetNode s e
content = 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
contentIdx
cwidgetId :: WidgetId
cwidgetId = WidgetNode s e
content 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
onChangeReqs :: [WidgetRequest s e]
onChangeReqs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ Bool
False) (forall s e. PopupCfg s e -> [Bool -> WidgetRequest s e]
_ppcOnChangeReq PopupCfg s e
config)
hideReqs :: [WidgetRequest s e]
hideReqs = [
forall s e. WidgetId -> WidgetRequest s e
ResetOverlay WidgetId
widgetId,
forall s e. Maybe WidgetId -> FocusDirection -> WidgetRequest s e
MoveFocus (forall a. a -> Maybe a
Just WidgetId
cwidgetId) FocusDirection
FocusBwd
]
closePopup
:: WidgetModel s
=> WidgetData s Bool
-> PopupCfg s e
-> PopupState
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetResult s e
WidgetData s Bool
field PopupCfg s e
config PopupState
state WidgetEnv s e
wenv WidgetNode s e
node = WidgetResult s e
result where
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
toggleShow :: [WidgetRequest s e]
toggleShow = forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet WidgetData s Bool
field Bool
False
isOverlay :: Bool
isOverlay = forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeInOverlay WidgetEnv s e
wenv WidgetNode s e
node
content :: WidgetNode s e
content = 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
contentIdx
cwidgetId :: WidgetId
cwidgetId = WidgetNode s e
content 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
onChangeReqs :: [WidgetRequest s e]
onChangeReqs
| Bool
isOverlay = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ Bool
False) (forall s e. PopupCfg s e -> [Bool -> WidgetRequest s e]
_ppcOnChangeReq PopupCfg s e
config)
| Bool
otherwise = []
closeReqs :: [WidgetRequest s e]
closeReqs = [
forall s e. WidgetRequest s e
IgnoreChildrenEvents,
forall s e. WidgetId -> WidgetRequest s e
ResetOverlay WidgetId
widgetId,
forall s e. Maybe WidgetId -> FocusDirection -> WidgetRequest s e
MoveFocus (forall a. a -> Maybe a
Just WidgetId
cwidgetId) FocusDirection
FocusBwd
]
newState :: PopupState
newState = PopupState
state {
_ppsReleaseMs :: Millisecond
_ppsReleaseMs = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasTimestamp s a => Lens' s a
L.timestamp
}
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 =>
WidgetData s Bool -> PopupCfg s e -> PopupState -> Widget s e
makePopup WidgetData s Bool
field PopupCfg s e
config PopupState
newState
reqs :: [WidgetRequest s e]
reqs = forall a. Monoid a => [a] -> a
mconcat [forall {s} {e}. [WidgetRequest s e]
closeReqs, forall {e}. [WidgetRequest s e]
toggleShow, [WidgetRequest s e]
onChangeReqs]
result :: WidgetResult s e
result = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e]
reqs