{-# 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 = Maybe (WidgetNode s e)
forall a. Maybe a
Nothing,
_ppcAlignToOuterH :: Maybe Bool
_ppcAlignToOuterH = Maybe Bool
forall a. Maybe a
Nothing,
_ppcAlignToOuterV :: Maybe Bool
_ppcAlignToOuterV = Maybe Bool
forall a. Maybe a
Nothing,
_ppcAlignToWindow :: Maybe Bool
_ppcAlignToWindow = Maybe Bool
forall a. Maybe a
Nothing,
_ppcAlignH :: Maybe AlignH
_ppcAlignH = Maybe AlignH
forall a. Maybe a
Nothing,
_ppcAlignV :: Maybe AlignV
_ppcAlignV = Maybe AlignV
forall a. Maybe a
Nothing,
_ppcOffset :: Maybe Point
_ppcOffset = Maybe Point
forall a. Maybe a
Nothing,
_ppcOpenAtCursor :: Maybe Bool
_ppcOpenAtCursor = Maybe Bool
forall a. Maybe a
Nothing,
_ppcDisableClose :: Maybe Bool
_ppcDisableClose = Maybe Bool
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 = PopupCfg s e -> Maybe (WidgetNode s e)
forall s e. PopupCfg s e -> Maybe (WidgetNode s e)
_ppcAnchor PopupCfg s e
t2 Maybe (WidgetNode s e)
-> Maybe (WidgetNode s e) -> Maybe (WidgetNode s e)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PopupCfg s e -> Maybe (WidgetNode s e)
forall s e. PopupCfg s e -> Maybe (WidgetNode s e)
_ppcAnchor PopupCfg s e
t1,
_ppcAlignToOuterH :: Maybe Bool
_ppcAlignToOuterH = PopupCfg s e -> Maybe Bool
forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToOuterH PopupCfg s e
t2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PopupCfg s e -> Maybe Bool
forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToOuterH PopupCfg s e
t1,
_ppcAlignToOuterV :: Maybe Bool
_ppcAlignToOuterV = PopupCfg s e -> Maybe Bool
forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToOuterV PopupCfg s e
t2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PopupCfg s e -> Maybe Bool
forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToOuterV PopupCfg s e
t1,
_ppcAlignToWindow :: Maybe Bool
_ppcAlignToWindow = PopupCfg s e -> Maybe Bool
forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToWindow PopupCfg s e
t2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PopupCfg s e -> Maybe Bool
forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToWindow PopupCfg s e
t1,
_ppcAlignH :: Maybe AlignH
_ppcAlignH = PopupCfg s e -> Maybe AlignH
forall s e. PopupCfg s e -> Maybe AlignH
_ppcAlignH PopupCfg s e
t2 Maybe AlignH -> Maybe AlignH -> Maybe AlignH
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PopupCfg s e -> Maybe AlignH
forall s e. PopupCfg s e -> Maybe AlignH
_ppcAlignH PopupCfg s e
t1,
_ppcAlignV :: Maybe AlignV
_ppcAlignV = PopupCfg s e -> Maybe AlignV
forall s e. PopupCfg s e -> Maybe AlignV
_ppcAlignV PopupCfg s e
t2 Maybe AlignV -> Maybe AlignV -> Maybe AlignV
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PopupCfg s e -> Maybe AlignV
forall s e. PopupCfg s e -> Maybe AlignV
_ppcAlignV PopupCfg s e
t1,
_ppcOffset :: Maybe Point
_ppcOffset = PopupCfg s e -> Maybe Point
forall s e. PopupCfg s e -> Maybe Point
_ppcOffset PopupCfg s e
t2 Maybe Point -> Maybe Point -> Maybe Point
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PopupCfg s e -> Maybe Point
forall s e. PopupCfg s e -> Maybe Point
_ppcOffset PopupCfg s e
t1,
_ppcOpenAtCursor :: Maybe Bool
_ppcOpenAtCursor = PopupCfg s e -> Maybe Bool
forall s e. PopupCfg s e -> Maybe Bool
_ppcOpenAtCursor PopupCfg s e
t2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PopupCfg s e -> Maybe Bool
forall s e. PopupCfg s e -> Maybe Bool
_ppcOpenAtCursor PopupCfg s e
t1,
_ppcDisableClose :: Maybe Bool
_ppcDisableClose = PopupCfg s e -> Maybe Bool
forall s e. PopupCfg s e -> Maybe Bool
_ppcDisableClose PopupCfg s e
t2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PopupCfg s e -> Maybe Bool
forall s e. PopupCfg s e -> Maybe Bool
_ppcDisableClose PopupCfg s e
t1,
_ppcOnChangeReq :: [Bool -> WidgetRequest s e]
_ppcOnChangeReq = PopupCfg s e -> [Bool -> WidgetRequest s e]
forall s e. PopupCfg s e -> [Bool -> WidgetRequest s e]
_ppcOnChangeReq PopupCfg s e
t1 [Bool -> WidgetRequest s e]
-> [Bool -> WidgetRequest s e] -> [Bool -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> PopupCfg s e -> [Bool -> WidgetRequest s e]
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 = PopupCfg s e
forall a. Default a => a
def
instance CmbAlignLeft (PopupCfg s e) where
alignLeft_ :: Bool -> PopupCfg s e
alignLeft_ Bool
False = PopupCfg s e
forall a. Default a => a
def
alignLeft_ Bool
True = PopupCfg s e
forall a. Default a => a
def {
_ppcAlignH = Just ALeft
}
instance CmbAlignCenter (PopupCfg s e) where
alignCenter_ :: Bool -> PopupCfg s e
alignCenter_ Bool
False = PopupCfg s e
forall a. Default a => a
def
alignCenter_ Bool
True = PopupCfg s e
forall a. Default a => a
def {
_ppcAlignH = Just ACenter
}
instance CmbAlignRight (PopupCfg s e) where
alignRight_ :: Bool -> PopupCfg s e
alignRight_ Bool
False = PopupCfg s e
forall a. Default a => a
def
alignRight_ Bool
True = PopupCfg s e
forall a. Default a => a
def {
_ppcAlignH = Just ARight
}
instance CmbAlignTop (PopupCfg s e) where
alignTop_ :: Bool -> PopupCfg s e
alignTop_ Bool
False = PopupCfg s e
forall a. Default a => a
def
alignTop_ Bool
True = PopupCfg s e
forall a. Default a => a
def {
_ppcAlignV = Just ATop
}
instance CmbAlignMiddle (PopupCfg s e) where
alignMiddle_ :: Bool -> PopupCfg s e
alignMiddle_ Bool
False = PopupCfg s e
forall a. Default a => a
def
alignMiddle_ Bool
True = PopupCfg s e
forall a. Default a => a
def {
_ppcAlignV = Just AMiddle
}
instance CmbAlignBottom (PopupCfg s e) where
alignBottom_ :: Bool -> PopupCfg s e
alignBottom_ Bool
False = PopupCfg s e
forall a. Default a => a
def
alignBottom_ Bool
True = PopupCfg s e
forall a. Default a => a
def {
_ppcAlignV = Just ABottom
}
instance WidgetEvent e => CmbOnChange (PopupCfg s e) Bool e where
onChange :: (Bool -> e) -> PopupCfg s e
onChange Bool -> e
fn = PopupCfg s e
forall a. Default a => a
def {
_ppcOnChangeReq = [RaiseEvent . fn]
}
instance CmbOnChangeReq (PopupCfg s e) s e Bool where
onChangeReq :: (Bool -> WidgetRequest s e) -> PopupCfg s e
onChangeReq Bool -> WidgetRequest s e
req = PopupCfg s e
forall a. Default a => a
def {
_ppcOnChangeReq = [req]
}
popupAnchor :: WidgetNode s e -> PopupCfg s e
WidgetNode s e
node = PopupCfg s e
forall a. Default a => a
def {
_ppcAnchor = Just node
}
popupAlignToOuterH :: PopupCfg s e
= Bool -> PopupCfg s e
forall s e. Bool -> PopupCfg s e
popupAlignToOuterH_ Bool
True
popupAlignToOuterH_ :: Bool -> PopupCfg s e
Bool
align = PopupCfg s e
forall a. Default a => a
def {
_ppcAlignToOuterH = Just align
}
popupAlignToOuterV :: PopupCfg s e
= Bool -> PopupCfg s e
forall s e. Bool -> PopupCfg s e
popupAlignToOuterV_ Bool
True
popupAlignToOuterV_ :: Bool -> PopupCfg s e
Bool
align = PopupCfg s e
forall a. Default a => a
def {
_ppcAlignToOuterV = Just align
}
popupAlignToWindow :: PopupCfg s e
= Bool -> PopupCfg s e
forall s e. Bool -> PopupCfg s e
popupAlignToWindow_ Bool
True
popupAlignToWindow_ :: Bool -> PopupCfg s e
Bool
align = PopupCfg s e
forall a. Default a => a
def {
_ppcAlignToWindow = Just align
}
popupOffset :: Point -> PopupCfg s e
Point
point = PopupCfg s e
forall a. Default a => a
def {
_ppcOffset = Just point
}
popupOpenAtCursor :: PopupCfg s e
= Bool -> PopupCfg s e
forall s e. Bool -> PopupCfg s e
popupOpenAtCursor_ Bool
True
popupOpenAtCursor_ :: Bool -> PopupCfg s e
Bool
open = PopupCfg s e
forall a. Default a => a
def {
_ppcOpenAtCursor = Just open
}
popupDisableClose :: PopupCfg s e
= Bool -> PopupCfg s e
forall s e. Bool -> PopupCfg s e
popupDisableClose_ Bool
True
popupDisableClose_ :: Bool -> PopupCfg s e
Bool
close = PopupCfg s e
forall a. Default a => a
def {
_ppcDisableClose = Just close
}
data = {
PopupState -> Point
_ppsClickPos :: Point,
PopupState -> Millisecond
_ppsReleaseMs :: Millisecond
} deriving (PopupState -> PopupState -> Bool
(PopupState -> PopupState -> Bool)
-> (PopupState -> PopupState -> Bool) -> Eq PopupState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PopupState -> PopupState -> Bool
== :: PopupState -> PopupState -> Bool
$c/= :: PopupState -> PopupState -> Bool
/= :: PopupState -> PopupState -> Bool
Eq, Int -> PopupState -> ShowS
[PopupState] -> ShowS
PopupState -> String
(Int -> PopupState -> ShowS)
-> (PopupState -> String)
-> ([PopupState] -> ShowS)
-> Show PopupState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PopupState -> ShowS
showsPrec :: Int -> PopupState -> ShowS
$cshow :: PopupState -> String
show :: PopupState -> String
$cshowList :: [PopupState] -> ShowS
showList :: [PopupState] -> ShowS
Show)
popup
:: WidgetModel s
=> ALens' s Bool
-> WidgetNode s e
-> WidgetNode s e
ALens' s Bool
field WidgetNode s e
content = ALens' s Bool -> [PopupCfg s e] -> WidgetNode s e -> WidgetNode s e
forall s e.
WidgetModel s =>
ALens' s Bool -> [PopupCfg s e] -> WidgetNode s e -> WidgetNode s e
popup_ ALens' s Bool
field [PopupCfg s e]
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 = WidgetData s Bool
-> [PopupCfg s e] -> WidgetNode s e -> WidgetNode s e
forall s e.
WidgetModel s =>
WidgetData s Bool
-> [PopupCfg s e] -> WidgetNode s e -> WidgetNode s e
popupD_ (ALens' s Bool -> WidgetData s Bool
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 = Bool
-> (Bool -> e)
-> [PopupCfg s e]
-> WidgetNode s e
-> WidgetNode s e
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 [PopupCfg s e]
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 = (Bool -> e) -> PopupCfg s e
forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange Bool -> e
handler PopupCfg s e -> [PopupCfg s e] -> [PopupCfg s e]
forall a. a -> [a] -> [a]
: [PopupCfg s e]
configs
newNode :: WidgetNode s e
newNode = WidgetData s Bool
-> [PopupCfg s e] -> WidgetNode s e -> WidgetNode s e
forall s e.
WidgetModel s =>
WidgetData s Bool
-> [PopupCfg s e] -> WidgetNode s e -> WidgetNode s e
popupD_ (Bool -> WidgetData s Bool
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 = Widget s e -> WidgetNode s e -> WidgetNode s e -> WidgetNode s e
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 = [PopupCfg s e] -> PopupCfg s e
forall a. Monoid a => [a] -> a
mconcat [PopupCfg s e]
configs
state :: PopupState
state = Point -> Millisecond -> PopupState
PopupState Point
forall a. Default a => a
def (-Millisecond
1)
widget :: Widget s e
widget = WidgetData s Bool -> PopupCfg s e -> PopupState -> Widget s e
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 PopupCfg s e -> Maybe (WidgetNode s e)
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 -> WidgetNode s e
forall s e. WidgetNode s e
spacer
WidgetNode s e -> [StyleState] -> WidgetNode s e
forall t. CmbStyleBasic t => t -> [StyleState] -> t
`styleBasic` [Double -> StyleState
forall t. CmbMaxWidth t => Double -> t
maxWidth Double
0.01, Double -> StyleState
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 = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"popup" Widget s e
widget
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Bool -> Identity Bool)
-> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Bool -> Identity Bool)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasFocusable s a => Lens' s a
Lens' WidgetNodeInfo Bool
L.focusable ((Bool -> Identity Bool)
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Bool -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasChildren s a => Lens' s a
Lens' (WidgetNode s e) (Seq (WidgetNode s e))
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Seq (WidgetNode s e) -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [WidgetNode s e] -> Seq (WidgetNode s e)
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 = Container s e PopupState
forall a. Default a => a
def {
containerAddStyleReq = False,
containerInitPost = initPost,
containerMergePost = mergePost,
containerHandleEvent = handleEvent,
containerGetSizeReq = getSizeReq,
containerResize = resize
}
baseWidget :: Widget s e
baseWidget = PopupState -> Container s e PopupState -> Widget s e
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 = 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 = WidgetData s Bool
-> PopupCfg s e
-> PopupState
-> WidgetEnv s e
-> WidgetResult s e
-> WidgetResult s e
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 = WidgetData s Bool
-> PopupCfg s e
-> PopupState
-> WidgetEnv s e
-> WidgetResult s e
-> WidgetResult s e
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 :: WidgetEnv s e
-> WidgetNode s e
-> Seq Int
-> SystemEvent
-> Maybe (WidgetResult s e)
handleEvent WidgetEnv s e
wenv WidgetNode s e
node Seq Int
target SystemEvent
evt = case SystemEvent
evt of
KeyAction KeyMod
mod KeyCode
code KeyStatus
KeyPressed
| Bool
isCloseable Bool -> Bool -> Bool
&& KeyCode -> Bool
isKeyEscape KeyCode
code -> WidgetResult s e -> Maybe (WidgetResult s e)
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) -> WidgetResult s e -> Maybe (WidgetResult s e)
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) -> WidgetResult s e -> Maybe (WidgetResult s e)
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 -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
ignoreResult
| Bool
otherwise -> Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
where
path :: Seq Int
path = WidgetNode s e
node WidgetNode s e
-> Getting (Seq Int) (WidgetNode s e) (Seq Int) -> Seq Int
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const (Seq Int) WidgetNodeInfo)
-> WidgetNode s e -> Const (Seq Int) (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const (Seq Int) WidgetNodeInfo)
-> WidgetNode s e -> Const (Seq Int) (WidgetNode s e))
-> ((Seq Int -> Const (Seq Int) (Seq Int))
-> WidgetNodeInfo -> Const (Seq Int) WidgetNodeInfo)
-> Getting (Seq Int) (WidgetNode s e) (Seq Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq Int -> Const (Seq Int) (Seq Int))
-> WidgetNodeInfo -> Const (Seq Int) WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
Lens' WidgetNodeInfo (Seq Int)
L.path
disableClose :: Bool
disableClose = PopupCfg s e -> Maybe Bool
forall s e. PopupCfg s e -> Maybe Bool
_ppcDisableClose PopupCfg s e
config Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
matchMs :: Bool
matchMs = PopupState -> Millisecond
_ppsReleaseMs PopupState
state Millisecond -> Millisecond -> Bool
forall a. Eq a => a -> a -> Bool
== WidgetEnv s e
wenv WidgetEnv s e
-> Getting Millisecond (WidgetEnv s e) Millisecond -> Millisecond
forall s a. s -> Getting a s a -> a
^. Getting Millisecond (WidgetEnv s e) Millisecond
forall s a. HasTimestamp s a => Lens' s a
Lens' (WidgetEnv s e) Millisecond
L.timestamp
isVisible :: Bool
isVisible = s -> WidgetData s Bool -> Bool
forall s a. s -> WidgetData s a -> a
widgetDataGet (WidgetEnv s e
wenv WidgetEnv s e -> Getting s (WidgetEnv s e) s -> s
forall s a. s -> Getting a s a -> a
^. Getting s (WidgetEnv s e) s
forall s a. HasModel s a => Lens' s a
Lens' (WidgetEnv s e) s
L.model) WidgetData s Bool
field
isContentTarget :: Bool
isContentTarget = Seq Int -> Seq Int -> Bool
isPathParent (Seq Int
path Seq Int -> Int -> Seq Int
forall s a. Snoc s s a a => s -> a -> s
|> Int
contentIdx) Seq Int
target
isCloseable :: Bool
isCloseable = Bool
isVisible Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
disableClose
content :: WidgetNode s e
content = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node WidgetNode s e
-> Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
Lens' (WidgetNode s e) (Seq (WidgetNode s e))
L.children) Int
contentIdx
cviewport :: Rect
cviewport = WidgetNode s e
content WidgetNode s e -> Getting Rect (WidgetNode s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e))
-> ((Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> Getting Rect (WidgetNode s e) Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
Lens' WidgetNodeInfo Rect
L.viewport
insidePopup :: Point -> Bool
insidePopup Point
point = Point -> Rect -> Bool
pointInRect Point
point Rect
cviewport
closeResult :: WidgetResult s e
closeResult = WidgetData s Bool
-> PopupCfg s e
-> PopupState
-> WidgetEnv s e
-> WidgetNode s e
-> WidgetResult s e
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 = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e
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 = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
anchorIdx
newReqW :: SizeReq
newReqW = WidgetNode s e
anchor WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqW s a => Lens' s a
Lens' WidgetNodeInfo SizeReq
L.sizeReqW
newReqH :: SizeReq
newReqH = WidgetNode s e
anchor WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqH s a => Lens' s a
Lens' WidgetNodeInfo SizeReq
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 WidgetEnv s e -> Getting Size (WidgetEnv s e) Size -> Size
forall s a. s -> Getting a s a -> a
^. Getting Size (WidgetEnv s e) Size
forall s a. HasWindowSize s a => Lens' s a
Lens' (WidgetEnv s e) Size
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 WidgetEnv s e -> Getting Point (WidgetEnv s e) Point -> Point
forall s a. s -> Getting a s a -> a
^. Getting Point (WidgetEnv s e) Point
forall s a. HasOffset s a => Lens' s a
Lens' (WidgetEnv s e) Point
L.offset)
Point Double
ox Double
oy = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe Point
forall a. Default a => a
def (PopupCfg s e -> Maybe Point
forall s e. PopupCfg s e -> Maybe Point
_ppcOffset PopupCfg s e
config)
alignOuterH :: Bool
alignOuterH = PopupCfg s e -> Maybe Bool
forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToOuterH PopupCfg s e
config Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
alignOuterV :: Bool
alignOuterV = PopupCfg s e -> Maybe Bool
forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToOuterV PopupCfg s e
config Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
alignWin :: Bool
alignWin = PopupCfg s e -> Maybe Bool
forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToWindow PopupCfg s e
config Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
alignH :: Maybe AlignH
alignH = PopupCfg s e -> Maybe AlignH
forall s e. PopupCfg s e -> Maybe AlignH
_ppcAlignH PopupCfg s e
config
alignV :: Maybe AlignV
alignV = PopupCfg s e -> Maybe AlignV
forall s e. PopupCfg s e -> Maybe AlignV
_ppcAlignV PopupCfg s e
config
openAtCursor :: Bool
openAtCursor = PopupCfg s e -> Maybe Bool
forall s e. PopupCfg s e -> Maybe Bool
_ppcOpenAtCursor PopupCfg s e
config Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
content :: WidgetNode s e
content = Seq (WidgetNode s e) -> Int -> WidgetNode s e
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 WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqW s a => Lens' s a
Lens' WidgetNodeInfo SizeReq
L.sizeReqW)
ch :: Double
ch = SizeReq -> Double
sizeReqMaxBounded (WidgetNode s e
content WidgetNode s e
-> Getting SizeReq (WidgetNode s e) SizeReq -> SizeReq
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> WidgetNode s e -> Const SizeReq (WidgetNode s e))
-> ((SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo)
-> Getting SizeReq (WidgetNode s e) SizeReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeReq -> Const SizeReq SizeReq)
-> WidgetNodeInfo -> Const SizeReq WidgetNodeInfo
forall s a. HasSizeReqH s a => Lens' s a
Lens' WidgetNodeInfo SizeReq
L.sizeReqH)
(Bool
alignL, Bool
alignR) = (Maybe AlignH
alignH Maybe AlignH -> Maybe AlignH -> Bool
forall a. Eq a => a -> a -> Bool
== AlignH -> Maybe AlignH
forall a. a -> Maybe a
Just AlignH
ALeft, Maybe AlignH
alignH Maybe AlignH -> Maybe AlignH -> Bool
forall a. Eq a => a -> a -> Bool
== AlignH -> Maybe AlignH
forall a. a -> Maybe a
Just AlignH
ARight)
(Bool
alignT, Bool
alignB) = (Maybe AlignV
alignV Maybe AlignV -> Maybe AlignV -> Bool
forall a. Eq a => a -> a -> Bool
== AlignV -> Maybe AlignV
forall a. a -> Maybe a
Just AlignV
ATop, Maybe AlignV
alignV Maybe AlignV -> Maybe AlignV -> Bool
forall a. Eq a => a -> a -> Bool
== AlignV -> Maybe AlignV
forall a. a -> Maybe a
Just AlignV
ABottom)
(Bool
alignC, Bool
alignM) = (Maybe AlignH
alignH Maybe AlignH -> Maybe AlignH -> Bool
forall a. Eq a => a -> a -> Bool
== AlignH -> Maybe AlignH
forall a. a -> Maybe a
Just AlignH
ACenter, Maybe AlignV
alignV Maybe AlignV -> Maybe AlignV -> Bool
forall a. Eq a => a -> a -> Bool
== AlignV -> Maybe AlignV
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
cw Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ox, Double
ax Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
aw Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ox)
| Bool
otherwise = (Double
ax Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ox, Double
ax Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
aw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
cw Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ox)
(Double
aty, Double
aby)
| Bool
alignOuterV = (Double
ay Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ch Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
oy, Double
ay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ah Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
oy)
| Bool
otherwise = (Double
ay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
oy, Double
ay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ah Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ch Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
oy)
Point Double
olx Double
oty = WidgetEnv s e -> PopupCfg s e -> Rect -> Point
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 = WidgetEnv s e -> PopupCfg s e -> Rect -> Point
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 = a -> a
forall a. Num a => a -> a
abs a
offset a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0.01 Bool -> Bool -> Bool
|| Bool
alignWin
(Bool
fitL, Bool
fitR) = (Double -> Bool
forall {a}. (Ord a, Fractional a) => a -> Bool
fits Double
olx, Double -> Bool
forall {a}. (Ord a, Fractional a) => a -> Bool
fits Double
orx)
(Bool
fitT, Bool
fitB) = (Double -> Bool
forall {a}. (Ord a, Fractional a) => a -> Bool
fits Double
oty, Double -> Bool
forall {a}. (Ord a, Fractional a) => a -> Bool
fits Double
oby)
cx :: Double
cx
| Bool
openAtCursor = Double
sx
| Bool
alignC = Double
ax Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
aw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
cw) Double -> Double -> Double
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 Double -> Double -> Double
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ox
| Bool
otherwise = Double
ax
cy :: Double
cy
| Bool
openAtCursor = Double
sy
| Bool
alignM = Double
ay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
ah Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ch) Double -> Double -> Double
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 Double -> Double -> Double
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
oy
| Bool
otherwise = Double
ay
tmpArea :: Rect
tmpArea = Double -> Double -> Double -> Double -> Rect
Rect (Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ox) (Double
cy Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
oy) Double
cw Double
ch
winOffset :: Point
winOffset = WidgetEnv s e -> PopupCfg s e -> Rect -> Point
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 = [Rect] -> Seq Rect
forall a. [a] -> Seq a
Seq.fromList [Rect
viewport, Rect
carea]
resized :: (WidgetResult s e, Seq Rect)
resized = (WidgetNode s e -> WidgetResult s e
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
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
widgetRender (WidgetNode s e
anchor WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget) WidgetEnv s e
awenv WidgetNode s e
anchor Renderer
renderer
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isVisible (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Renderer -> IO () -> IO ()
createOverlay Renderer
renderer (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Renderer -> Point -> IO () -> IO ()
drawInTranslation Renderer
renderer Point
scrollOffset (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
widgetRender (WidgetNode s e
content WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget) WidgetEnv s e
cwenv WidgetNode s e
content Renderer
renderer
where
isVisible :: Bool
isVisible = s -> WidgetData s Bool -> Bool
forall s a. s -> WidgetData s a -> a
widgetDataGet (WidgetEnv s e
wenv WidgetEnv s e -> Getting s (WidgetEnv s e) s -> s
forall s a. s -> Getting a s a -> a
^. Getting s (WidgetEnv s e) s
forall s a. HasModel s a => Lens' s a
Lens' (WidgetEnv s e) s
L.model) WidgetData s Bool
field
alignWin :: Bool
alignWin = PopupCfg s e -> Maybe Bool
forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToWindow PopupCfg s e
config Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
scrollOffset :: Point
scrollOffset
| Bool
alignWin = Point
forall a. Default a => a
def
| Bool
otherwise = WidgetEnv s e
wenv WidgetEnv s e -> Getting Point (WidgetEnv s e) Point -> Point
forall s a. s -> Getting a s a -> a
^. Getting Point (WidgetEnv s e) Point
forall s a. HasOffset s a => Lens' s a
Lens' (WidgetEnv s e) Point
L.offset
anchor :: WidgetNode s e
anchor = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node WidgetNode s e
-> Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
Lens' (WidgetNode s e) (Seq (WidgetNode s e))
L.children) Int
anchorIdx
anchorVp :: Rect
anchorVp = WidgetNode s e
anchor WidgetNode s e -> Getting Rect (WidgetNode s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e))
-> ((Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> Getting Rect (WidgetNode s e) Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
Lens' WidgetNodeInfo Rect
L.viewport
content :: WidgetNode s e
content = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node WidgetNode s e
-> Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
Lens' (WidgetNode s e) (Seq (WidgetNode s e))
L.children) Int
contentIdx
contentVp :: Rect
contentVp = WidgetNode s e
content WidgetNode s e -> Getting Rect (WidgetNode s e) Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> WidgetNode s e -> Const Rect (WidgetNode s e))
-> ((Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo)
-> Getting Rect (WidgetNode s e) Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect)
-> WidgetNodeInfo -> Const Rect WidgetNodeInfo
forall s a. HasViewport s a => Lens' s a
Lens' WidgetNodeInfo Rect
L.viewport
updateOverlay :: Maybe (Seq Int) -> Maybe (Seq Int)
updateOverlay Maybe (Seq Int)
overlay
| Bool
isVisible = Seq Int -> Maybe (Seq Int)
forall a. a -> Maybe a
Just (WidgetNode s e
content WidgetNode s e
-> Getting (Seq Int) (WidgetNode s e) (Seq Int) -> Seq Int
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const (Seq Int) WidgetNodeInfo)
-> WidgetNode s e -> Const (Seq Int) (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const (Seq Int) WidgetNodeInfo)
-> WidgetNode s e -> Const (Seq Int) (WidgetNode s e))
-> ((Seq Int -> Const (Seq Int) (Seq Int))
-> WidgetNodeInfo -> Const (Seq Int) WidgetNodeInfo)
-> Getting (Seq Int) (WidgetNode s e) (Seq Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq Int -> Const (Seq Int) (Seq Int))
-> WidgetNodeInfo -> Const (Seq Int) WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
Lens' WidgetNodeInfo (Seq Int)
L.path)
| Bool
otherwise = Maybe (Seq Int)
overlay
awenv :: WidgetEnv s e
awenv = Container s e PopupState
-> WidgetEnv s e -> WidgetNode s e -> Rect -> WidgetEnv s e
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
WidgetEnv s e -> (WidgetEnv s e -> WidgetEnv s e) -> WidgetEnv s e
forall a b. a -> (a -> b) -> b
& (Rect -> Identity Rect)
-> WidgetEnv s e -> Identity (WidgetEnv s e)
forall s a. HasViewport s a => Lens' s a
Lens' (WidgetEnv s e) Rect
L.viewport ((Rect -> Identity Rect)
-> WidgetEnv s e -> Identity (WidgetEnv s e))
-> Rect -> WidgetEnv s e -> WidgetEnv s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rect
anchorVp
WidgetEnv s e -> (WidgetEnv s e -> WidgetEnv s e) -> WidgetEnv s e
forall a b. a -> (a -> b) -> b
& (Maybe (Seq Int) -> Identity (Maybe (Seq Int)))
-> WidgetEnv s e -> Identity (WidgetEnv s e)
forall s a. HasOverlayPath s a => Lens' s a
Lens' (WidgetEnv s e) (Maybe (Seq Int))
L.overlayPath ((Maybe (Seq Int) -> Identity (Maybe (Seq Int)))
-> WidgetEnv s e -> Identity (WidgetEnv s e))
-> (Maybe (Seq Int) -> Maybe (Seq Int))
-> WidgetEnv s e
-> WidgetEnv s e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Maybe (Seq Int) -> Maybe (Seq Int)
updateOverlay
cwenv :: WidgetEnv s e
cwenv = Container s e PopupState
-> WidgetEnv s e -> WidgetNode s e -> Rect -> WidgetEnv s e
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
WidgetEnv s e -> (WidgetEnv s e -> WidgetEnv s e) -> WidgetEnv s e
forall a b. a -> (a -> b) -> b
& (Rect -> Identity Rect)
-> WidgetEnv s e -> Identity (WidgetEnv s e)
forall s a. HasViewport s a => Lens' s a
Lens' (WidgetEnv s e) Rect
L.viewport ((Rect -> Identity Rect)
-> WidgetEnv s e -> Identity (WidgetEnv s e))
-> Rect -> WidgetEnv s e -> WidgetEnv s e
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 = PopupCfg s e -> Maybe Bool
forall s e. PopupCfg s e -> Maybe Bool
_ppcAlignToWindow PopupCfg s e
config Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
Size Double
winW Double
winH = WidgetEnv s e
wenv WidgetEnv s e -> Getting Size (WidgetEnv s e) Size -> Size
forall s a. s -> Getting a s a -> a
^. Getting Size (WidgetEnv s e) Size
forall s a. HasWindowSize s a => Lens' s a
Lens' (WidgetEnv s e) Size
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 WidgetEnv s e -> Getting Point (WidgetEnv s e) Point -> Point
forall s a. s -> Getting a s a -> a
^. Getting Point (WidgetEnv s e) Point
forall s a. HasOffset s a => Lens' s a
Lens' (WidgetEnv s e) Point
L.offset) Rect
viewport
offsetX :: Double
offsetX
| Double
cx Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 = -Double
cx
| Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
cw Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
winW = Double
winW Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
cw
| Bool
otherwise = Double
0
offsetY :: Double
offsetY
| Double
cy Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 = -Double
cy
| Double
cy Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ch Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
winH = Double
winH Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
cy Double -> Double -> Double
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 WidgetResult s e
-> Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
-> WidgetNode s e
forall s a. s -> Getting a s a -> a
^. Getting (WidgetNode s e) (WidgetResult s e) (WidgetNode s e)
forall s a. HasNode s a => Lens' s a
Lens' (WidgetResult s e) (WidgetNode s e)
L.node
shouldDisplay :: Bool
shouldDisplay = s -> WidgetData s Bool -> Bool
forall s a. s -> WidgetData s a -> a
widgetDataGet (WidgetEnv s e
wenv WidgetEnv s e -> Getting s (WidgetEnv s e) s -> s
forall s a. s -> Getting a s a -> a
^. Getting s (WidgetEnv s e) s
forall s a. HasModel s a => Lens' s a
Lens' (WidgetEnv s e) s
L.model) WidgetData s Bool
field
isOverlay :: Bool
isOverlay = WidgetEnv s e -> WidgetNode s e -> Bool
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 = WidgetData s Bool
-> PopupCfg s e
-> PopupState
-> WidgetEnv s e
-> WidgetNode s e
-> (WidgetNode s e, [WidgetRequest s e])
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 = PopupCfg s e
-> WidgetNode s e -> (WidgetNode s e, [WidgetRequest s e])
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 WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s Bool -> PopupCfg s e -> PopupState -> Widget s e
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
WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (WidgetNode s e -> Identity (WidgetNode s e))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasNode s a => Lens' s a
Lens' (WidgetResult s e) (WidgetNode s e)
L.node ((WidgetNode s e -> Identity (WidgetNode s e))
-> WidgetResult s e -> Identity (WidgetResult s e))
-> ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> (Widget s e -> Identity (Widget s e))
-> WidgetResult s e
-> Identity (WidgetResult s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetResult s e -> Identity (WidgetResult s e))
-> Widget s e -> WidgetResult s e -> WidgetResult s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetNode s e
newNode WidgetNode s e
-> Getting (Widget s e) (WidgetNode s e) (Widget s e) -> Widget s e
forall s a. s -> Getting a s a -> a
^. Getting (Widget s e) (WidgetNode s e) (Widget s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget
WidgetResult s e
-> (WidgetResult s e -> WidgetResult s e) -> WidgetResult s e
forall a b. a -> (a -> b) -> b
& (Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e)
forall s a. HasRequests s a => Lens' s a
Lens' (WidgetResult s e) (Seq (WidgetRequest s e))
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e))
-> Seq (WidgetRequest s e) -> WidgetResult s e -> WidgetResult s e
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [WidgetRequest s e] -> Seq (WidgetRequest s e)
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 WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
Lens' WidgetNodeInfo WidgetId
L.widgetId
path :: Seq Int
path = WidgetNode s e
node WidgetNode s e
-> Getting (Seq Int) (WidgetNode s e) (Seq Int) -> Seq Int
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const (Seq Int) WidgetNodeInfo)
-> WidgetNode s e -> Const (Seq Int) (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const (Seq Int) WidgetNodeInfo)
-> WidgetNode s e -> Const (Seq Int) (WidgetNode s e))
-> ((Seq Int -> Const (Seq Int) (Seq Int))
-> WidgetNodeInfo -> Const (Seq Int) WidgetNodeInfo)
-> Getting (Seq Int) (WidgetNode s e) (Seq Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq Int -> Const (Seq Int) (Seq Int))
-> WidgetNodeInfo -> Const (Seq Int) WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
Lens' WidgetNodeInfo (Seq Int)
L.path
mousePos :: Point
mousePos = WidgetEnv s e
wenv WidgetEnv s e -> Getting Point (WidgetEnv s e) Point -> Point
forall s a. s -> Getting a s a -> a
^. (InputStatus -> Const Point InputStatus)
-> WidgetEnv s e -> Const Point (WidgetEnv s e)
forall s a. HasInputStatus s a => Lens' s a
Lens' (WidgetEnv s e) InputStatus
L.inputStatus ((InputStatus -> Const Point InputStatus)
-> WidgetEnv s e -> Const Point (WidgetEnv s e))
-> ((Point -> Const Point Point)
-> InputStatus -> Const Point InputStatus)
-> Getting Point (WidgetEnv s e) Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point -> Const Point Point)
-> InputStatus -> Const Point InputStatus
forall s a. HasMousePos s a => Lens' s a
Lens' InputStatus Point
L.mousePos
anchor :: WidgetNode s e
anchor = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node WidgetNode s e
-> Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
Lens' (WidgetNode s e) (Seq (WidgetNode s e))
L.children) Int
anchorIdx
awidgetId :: WidgetId
awidgetId = WidgetNode s e
anchor WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
Lens' WidgetNodeInfo WidgetId
L.widgetId
onChangeReqs :: [WidgetRequest s e]
onChangeReqs = ((Bool -> WidgetRequest s e) -> WidgetRequest s e)
-> [Bool -> WidgetRequest s e] -> [WidgetRequest s e]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Bool -> WidgetRequest s e) -> Bool -> WidgetRequest s e
forall a b. (a -> b) -> a -> b
$ Bool
True) (PopupCfg s e -> [Bool -> WidgetRequest s e]
forall s e. PopupCfg s e -> [Bool -> WidgetRequest s e]
_ppcOnChangeReq PopupCfg s e
config)
showReqs :: [WidgetRequest s e]
showReqs = [
WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
ResizeWidgets WidgetId
widgetId,
WidgetId -> Seq Int -> WidgetRequest s e
forall s e. WidgetId -> Seq Int -> WidgetRequest s e
SetOverlay WidgetId
widgetId Seq Int
path,
Maybe WidgetId -> FocusDirection -> WidgetRequest s e
forall s e. Maybe WidgetId -> FocusDirection -> WidgetRequest s e
MoveFocus (WidgetId -> Maybe WidgetId
forall a. a -> Maybe a
Just WidgetId
awidgetId) FocusDirection
FocusFwd
]
newState :: PopupState
newState = PopupState
state {
_ppsClickPos = mousePos
}
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s Bool -> PopupCfg s e -> PopupState -> Widget s e
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 = [[WidgetRequest s e]] -> [WidgetRequest s e]
forall a. Monoid a => [a] -> a
mconcat [[WidgetRequest s e]
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 [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> [WidgetRequest s e]
forall {s} {e}. [WidgetRequest s e]
hideReqs) where
widgetId :: WidgetId
widgetId = WidgetNode s e
node WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
Lens' WidgetNodeInfo WidgetId
L.widgetId
content :: WidgetNode s e
content = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node WidgetNode s e
-> Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
Lens' (WidgetNode s e) (Seq (WidgetNode s e))
L.children) Int
contentIdx
cwidgetId :: WidgetId
cwidgetId = WidgetNode s e
content WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
Lens' WidgetNodeInfo WidgetId
L.widgetId
onChangeReqs :: [WidgetRequest s e]
onChangeReqs = ((Bool -> WidgetRequest s e) -> WidgetRequest s e)
-> [Bool -> WidgetRequest s e] -> [WidgetRequest s e]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Bool -> WidgetRequest s e) -> Bool -> WidgetRequest s e
forall a b. (a -> b) -> a -> b
$ Bool
False) (PopupCfg s e -> [Bool -> WidgetRequest s e]
forall s e. PopupCfg s e -> [Bool -> WidgetRequest s e]
_ppcOnChangeReq PopupCfg s e
config)
hideReqs :: [WidgetRequest s e]
hideReqs = [
WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
ResetOverlay WidgetId
widgetId,
Maybe WidgetId -> FocusDirection -> WidgetRequest s e
forall s e. Maybe WidgetId -> FocusDirection -> WidgetRequest s e
MoveFocus (WidgetId -> Maybe WidgetId
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 WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
Lens' WidgetNodeInfo WidgetId
L.widgetId
toggleShow :: [WidgetRequest s e]
toggleShow = WidgetData s Bool -> Bool -> [WidgetRequest s e]
forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet WidgetData s Bool
field Bool
False
isOverlay :: Bool
isOverlay = WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeInOverlay WidgetEnv s e
wenv WidgetNode s e
node
content :: WidgetNode s e
content = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node WidgetNode s e
-> Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting
(Seq (WidgetNode s e)) (WidgetNode s e) (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
Lens' (WidgetNode s e) (Seq (WidgetNode s e))
L.children) Int
contentIdx
cwidgetId :: WidgetId
cwidgetId = WidgetNode s e
content WidgetNode s e
-> Getting WidgetId (WidgetNode s e) WidgetId -> WidgetId
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
Lens' (WidgetNode s e) WidgetNodeInfo
L.info ((WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> WidgetNode s e -> Const WidgetId (WidgetNode s e))
-> ((WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo)
-> Getting WidgetId (WidgetNode s e) WidgetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WidgetId -> Const WidgetId WidgetId)
-> WidgetNodeInfo -> Const WidgetId WidgetNodeInfo
forall s a. HasWidgetId s a => Lens' s a
Lens' WidgetNodeInfo WidgetId
L.widgetId
onChangeReqs :: [WidgetRequest s e]
onChangeReqs
| Bool
isOverlay = ((Bool -> WidgetRequest s e) -> WidgetRequest s e)
-> [Bool -> WidgetRequest s e] -> [WidgetRequest s e]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Bool -> WidgetRequest s e) -> Bool -> WidgetRequest s e
forall a b. (a -> b) -> a -> b
$ Bool
False) (PopupCfg s e -> [Bool -> WidgetRequest s e]
forall s e. PopupCfg s e -> [Bool -> WidgetRequest s e]
_ppcOnChangeReq PopupCfg s e
config)
| Bool
otherwise = []
closeReqs :: [WidgetRequest s e]
closeReqs = [
WidgetRequest s e
forall s e. WidgetRequest s e
IgnoreChildrenEvents,
WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
ResetOverlay WidgetId
widgetId,
Maybe WidgetId -> FocusDirection -> WidgetRequest s e
forall s e. Maybe WidgetId -> FocusDirection -> WidgetRequest s e
MoveFocus (WidgetId -> Maybe WidgetId
forall a. a -> Maybe a
Just WidgetId
cwidgetId) FocusDirection
FocusBwd
]
newState :: PopupState
newState = PopupState
state {
_ppsReleaseMs = wenv ^. L.timestamp
}
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasWidget s a => Lens' s a
Lens' (WidgetNode s e) (Widget s e)
L.widget ((Widget s e -> Identity (Widget s e))
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Widget s e -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetData s Bool -> PopupCfg s e -> PopupState -> Widget s e
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 = [[WidgetRequest s e]] -> [WidgetRequest s e]
forall a. Monoid a => [a] -> a
mconcat [[WidgetRequest s e]
forall {s} {e}. [WidgetRequest s e]
closeReqs, [WidgetRequest s e]
forall {e}. [WidgetRequest s e]
toggleShow, [WidgetRequest s e]
onChangeReqs]
result :: WidgetResult s e
result = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode [WidgetRequest s e]
reqs