{-|
Module      : Monomer.Widgets.Containers.Popup
Copyright   : (c) 2018 Francisco Vallarino
License     : BSD-3-Clause (see the LICENSE file)
Maintainer  : fjvallarino@gmail.com
Stability   : experimental
Portability : non-portable

Popup widget, used to display content overlaid on top of the active widget tree.
When the popup is open, events will not reach the widgets below it.

In addition to the content that is displayed when open, a popup requires a
boolean lens or value to indicate if the content should be visible. This flag
can be used to programmatically open/close the popup. The popup can also be
closed by clicking outside its content.

In general, it is a good idea to set a background color to the top level content
widget, since by default most widgets have a transparent background; this is
true in particular for containers.

@
popup visiblePopup $  -- visiblePopup is a lens to a Bool field in the model
  label "This will appear on top of the widget tree"
    `styleBasic` [bgColor gray, padding 10]
@

By default the popup will be open at the top-left location the widget would be
if it was directly embedded in the widget tree. One common pattern is having a
popup open when clicking a button, and the expectation is it will open below the
button. This can be achieved with:

@
vstack [
  button "Open" OpenPopup,
  popup visiblePopup (label "Content")
]
@

The popup's content can be aligned relative to the location of the popup widget
in the widget tree:

@
popup_ visiblePopup [alignTop, alignCenter] $
  label "This will appear on top of the widget tree, aligned to the top-center"
    `styleBasic` [bgColor gray, padding 10]
@

Alternatively, aligning relative to the application's window is possible. This
can be useful for displaying notifications:

@
popup_ visiblePopup [popupAlignToWindow, alignTop, alignCenter] $
  label "This will appear centered at the top of the main window"
    `styleBasic` [bgColor gray, padding 10]
@

It's possible to add an offset to the location of the popup, and also combine it
with alignment options:

@
cfgs = [popupAlignToWindow, alignTop, alignCenter, popupOffset (Point 0 5)]

popup_ visiblePopup cfgs $
  label "This will appear centered almost at the top of the main window"
    `styleBasic` [bgColor gray, padding 10]
@

Alternatively, a widget can be provided as an anchor. This is not too different
than the previous examples but opens up more alignment options, since the
popup's content can now be aligned relative to the outer side of the edges of
the anchor widget.

@
anchor = toggleButton "Show popup" visiblePopup
cfgs = [popupAnchor anchor, popupAlignToOuterV, alignTop, alignCenter]

popup_ visiblePopup cfgs $
  label "The bottom of the content will be aligned to the top of the anchor"
    `styleBasic` [bgColor gray, padding 10]
@

For an example of popup's use, check 'Monomer.Widgets.Singles.ColorPopup'.

Note: style settings will be ignored by this widget. The content and anchor need
to be styled independently.
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}

module Monomer.Widgets.Containers.Popup (
  -- * Configuration
  PopupCfg,
  popupAnchor,
  popupAlignToOuterH,
  popupAlignToOuterH_,
  popupAlignToOuterV,
  popupAlignToOuterV_,
  popupAlignToWindow,
  popupAlignToWindow_,
  popupOffset,
  popupOpenAtCursor,
  popupOpenAtCursor_,
  popupDisableClose,
  popupDisableClose_,

  -- * Constructors
  popup,
  popup_,
  popupV,
  popupV_,
  popupD_
) where

import Control.Applicative ((<|>))
import Control.Lens -- ((&), (^.), (^?!), (.~), ALens', ix)
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

{-|
Configuration options for popup:

- 'popupAnchor': a widget to be used as a reference for positioning the popup.
- 'popupAlignToOuter': align the popup to the anchor's outer borders.
- 'popupAlignToWindow': align the popup to the application's window.
- 'popupOffset': offset to add to the default location of the popup.
- 'popupOpenAtCursor': whether to open the content at the cursor position.
- 'popupDisableClose': do not close the popup when clicking outside the content.
- 'alignLeft': left align relative to the widget location or main window.
- 'alignRight': right align relative to the widget location or main window.
- 'alignCenter': horizontal center align relative to the widget location or main window.
- 'alignTop': top align relative to the widget location or main window.
- 'alignMiddle': vertical middle align relative to the widget location or main window.
- 'alignBottom': bottom align relative to the widget location or main window.
- 'onChange': event to raise when the popup is opened/closed.
- 'onChangeReq': 'WidgetRequest' to generate when the popup is opened/closed.
-}
data PopupCfg s e = PopupCfg {
  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]
  }

{-|
Sets the widget that will be used as the anchor for the popup. In general, this
anchor will also act as the trigger to open the popup (e.g. a button). When the
popup is open, the anchor will be used to position the content, taking scroll
and window size into consideration.
-}
popupAnchor :: WidgetNode s e -> PopupCfg s e
popupAnchor :: forall s e. WidgetNode s e -> PopupCfg s e
popupAnchor WidgetNode s e
node = PopupCfg s e
forall a. Default a => a
def {
  _ppcAnchor = Just node
}

{-|
Align the popup to the horizontal outer edges of the anchor. It only works with
'alignLeft' and 'alignRight', which need to be specified separately.

This option only works when 'popupAnchor' is set.
-}
popupAlignToOuterH :: PopupCfg s e
popupAlignToOuterH :: forall s e. PopupCfg s e
popupAlignToOuterH = Bool -> PopupCfg s e
forall s e. Bool -> PopupCfg s e
popupAlignToOuterH_ Bool
True

{-|
Sets whether to align the popup to the horizontal outer edges of the anchor. It
only works with 'alignLeft' and 'alignRight', which need to be specified
separately.

This option only works when 'popupAnchor' is set.
-}
popupAlignToOuterH_ :: Bool -> PopupCfg s e
popupAlignToOuterH_ :: forall s e. Bool -> PopupCfg s e
popupAlignToOuterH_ Bool
align = PopupCfg s e
forall a. Default a => a
def {
  _ppcAlignToOuterH = Just align
}

{-|
Align the popup vertically to the outer edges of the anchor. It only works with
'alignTop' and 'alignBottom', which need to be specified separately.

This option only works when 'popupAnchor' is set.
-}
popupAlignToOuterV :: PopupCfg s e
popupAlignToOuterV :: forall s e. PopupCfg s e
popupAlignToOuterV = Bool -> PopupCfg s e
forall s e. Bool -> PopupCfg s e
popupAlignToOuterV_ Bool
True

{-|
Sets whether to align the popup vertically to the outer edges of the anchor. It
only works with 'alignTop' and 'alignBottom', which need to be specified
separately.

This option only works when 'popupAnchor' is set.
-}
popupAlignToOuterV_ :: Bool -> PopupCfg s e
popupAlignToOuterV_ :: forall s e. Bool -> PopupCfg s e
popupAlignToOuterV_ Bool
align = PopupCfg s e
forall a. Default a => a
def {
  _ppcAlignToOuterV = Just align
}

-- | Alignment will be relative to the application's main window.
popupAlignToWindow :: PopupCfg s e
popupAlignToWindow :: forall s e. PopupCfg s e
popupAlignToWindow = Bool -> PopupCfg s e
forall s e. Bool -> PopupCfg s e
popupAlignToWindow_ Bool
True

-- | Sets whether alignment will be relative to the application's main window.
popupAlignToWindow_ :: Bool -> PopupCfg s e
popupAlignToWindow_ :: forall s e. Bool -> PopupCfg s e
popupAlignToWindow_ Bool
align = PopupCfg s e
forall a. Default a => a
def {
  _ppcAlignToWindow = Just align
}

{-|
Offset to be applied to the location of the popup. It is applied after alignment
options but before adjusting for screen boundaries.
-}
popupOffset :: Point -> PopupCfg s e
popupOffset :: forall s e. Point -> PopupCfg s e
popupOffset Point
point = PopupCfg s e
forall a. Default a => a
def {
  _ppcOffset = Just point
}

-- | The popup will open at the current cursor position.
popupOpenAtCursor :: PopupCfg s e
popupOpenAtCursor :: forall s e. PopupCfg s e
popupOpenAtCursor = Bool -> PopupCfg s e
forall s e. Bool -> PopupCfg s e
popupOpenAtCursor_ Bool
True

-- | Sets whether the popup will open at the current cursor position.
popupOpenAtCursor_ :: Bool -> PopupCfg s e
popupOpenAtCursor_ :: forall s e. Bool -> PopupCfg s e
popupOpenAtCursor_ Bool
open = PopupCfg s e
forall a. Default a => a
def {
  _ppcOpenAtCursor = Just open
}

-- | Clicking outside the popup's content will not close it.
popupDisableClose :: PopupCfg s e
popupDisableClose :: forall s e. PopupCfg s e
popupDisableClose = Bool -> PopupCfg s e
forall s e. Bool -> PopupCfg s e
popupDisableClose_ Bool
True

-- | Sets whether clicking outside the popup's content will not close it.
popupDisableClose_ :: Bool -> PopupCfg s e
popupDisableClose_ :: forall s e. Bool -> PopupCfg s e
popupDisableClose_ Bool
close = PopupCfg s e
forall a. Default a => a
def {
  _ppcDisableClose = Just close
}

data PopupState = PopupState {
  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)

-- | Creates a popup with the given lens to determine its visibility.
popup
  :: WidgetModel s
  => ALens' s Bool   -- ^ The lens into the model.
  -> WidgetNode s e  -- ^ The child node.
  -> WidgetNode s e  -- ^ The created popup.
popup :: forall s e.
WidgetModel s =>
ALens' s Bool -> WidgetNode s e -> WidgetNode s e
popup 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

{-|
Creates a popup with the given lens to determine its visibility. Accepts config.
-}
popup_
  :: WidgetModel s
  => ALens' s Bool   -- ^ The lens into the model.
  -> [PopupCfg s e]  -- ^ The config options.
  -> WidgetNode s e  -- ^ The child node.
  -> WidgetNode s e  -- ^ The created popup.
popup_ :: 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]
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

{-|
Creates a popup using the given value to determine its visibility and 'onChange'
event handler.
-}
popupV
  :: (WidgetModel s, WidgetEvent e)
  => Bool            -- ^ The current value.
  -> (Bool -> e)     -- ^ The event to raise on change.
  -> WidgetNode s e  -- ^ The child node.
  -> WidgetNode s e  -- ^ The created popup.
popupV :: forall s e.
(WidgetModel s, WidgetEvent e) =>
Bool -> (Bool -> e) -> WidgetNode s e -> WidgetNode s e
popupV 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

{-|
Creates a popup using the given value to determine its visibility and 'onChange'
event handler. Accepts config.
-}
popupV_
  :: (WidgetModel s, WidgetEvent e)
  => Bool            -- ^ The current value.
  -> (Bool -> e)     -- ^ The event to raise on change.
  -> [PopupCfg s e]  -- ^ The config options.
  -> WidgetNode s e  -- ^ The child node.
  -> WidgetNode s e  -- ^ The created popup.
popupV_ :: 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]
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

{-|
Creates a popup providing a 'WidgetData' instance to determine its visibility
and config.
-}
popupD_
  :: WidgetModel s
  => WidgetData s Bool  -- ^ The 'WidgetData' to retrieve the value from.
  -> [PopupCfg s e]     -- ^ The config options.
  -> WidgetNode s e     -- ^ The child node.
  -> WidgetNode s e     -- ^ The created popup.
popupD_ :: forall s e.
WidgetModel s =>
WidgetData s Bool
-> [PopupCfg s e] -> WidgetNode s e -> WidgetNode s e
popupD_ 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
makePopup :: 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 = 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

    {-
    This check is needed because the anchor is inside the overlay, and otherwise
    it would receive events when the popup is open.
    -}
    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

      -- Hacky solution to avoid the anchor acting as if it were top-level.
      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
      -- Update viewports to avoid clipping/scissoring issues.
      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
checkPopup :: 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
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])
showPopup :: 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 = (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])
hidePopup :: forall s e.
PopupCfg s e
-> WidgetNode s e -> (WidgetNode s e, [WidgetRequest s e])
hidePopup 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
closePopup :: 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 = 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