{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StrictData #-}
module Monomer.Widgets.Containers.Dropdown (
DropdownCfg,
DropdownItem,
dropdown,
dropdown_,
dropdownV,
dropdownV_,
dropdownD_
) where
import Control.Applicative ((<|>))
import Control.Lens (ALens', (&), (^.), (^?), (^?!), (.~), (%~), (<>~), _Just, ix, non)
import Control.Monad
import Data.Default
import Data.List (foldl')
import Data.Maybe
import Data.Sequence (Seq(..), (<|), (|>))
import Data.Text (Text)
import Data.Typeable (cast)
import GHC.Generics
import qualified Data.Sequence as Seq
import Monomer.Helper
import Monomer.Widgets.Container
import Monomer.Widgets.Containers.SelectList
import Monomer.Widgets.Singles.Label
import qualified Monomer.Lens as L
type DropdownItem a = SelectListItem a
data DropdownCfg s e a = DropdownCfg {
DropdownCfg s e a -> Maybe Double
_ddcMaxHeight :: Maybe Double,
DropdownCfg s e a -> Maybe Style
_ddcItemStyle :: Maybe Style,
DropdownCfg s e a -> Maybe Style
_ddcItemSelectedStyle :: Maybe Style,
DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnFocusReq :: [Path -> WidgetRequest s e],
DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnBlurReq :: [Path -> WidgetRequest s e],
DropdownCfg s e a -> [a -> WidgetRequest s e]
_ddcOnChangeReq :: [a -> WidgetRequest s e],
DropdownCfg s e a -> [Int -> a -> WidgetRequest s e]
_ddcOnChangeIdxReq :: [Int -> a -> WidgetRequest s e]
}
instance Default (DropdownCfg s e a) where
def :: DropdownCfg s e a
def = DropdownCfg :: forall s e a.
Maybe Double
-> Maybe Style
-> Maybe Style
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [a -> WidgetRequest s e]
-> [Int -> a -> WidgetRequest s e]
-> DropdownCfg s e a
DropdownCfg {
_ddcMaxHeight :: Maybe Double
_ddcMaxHeight = Maybe Double
forall a. Maybe a
Nothing,
_ddcItemStyle :: Maybe Style
_ddcItemStyle = Maybe Style
forall a. Maybe a
Nothing,
_ddcItemSelectedStyle :: Maybe Style
_ddcItemSelectedStyle = Maybe Style
forall a. Maybe a
Nothing,
_ddcOnFocusReq :: [Path -> WidgetRequest s e]
_ddcOnFocusReq = [],
_ddcOnBlurReq :: [Path -> WidgetRequest s e]
_ddcOnBlurReq = [],
_ddcOnChangeReq :: [a -> WidgetRequest s e]
_ddcOnChangeReq = [],
_ddcOnChangeIdxReq :: [Int -> a -> WidgetRequest s e]
_ddcOnChangeIdxReq = []
}
instance Semigroup (DropdownCfg s e a) where
<> :: DropdownCfg s e a -> DropdownCfg s e a -> DropdownCfg s e a
(<>) DropdownCfg s e a
t1 DropdownCfg s e a
t2 = DropdownCfg :: forall s e a.
Maybe Double
-> Maybe Style
-> Maybe Style
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [a -> WidgetRequest s e]
-> [Int -> a -> WidgetRequest s e]
-> DropdownCfg s e a
DropdownCfg {
_ddcMaxHeight :: Maybe Double
_ddcMaxHeight = DropdownCfg s e a -> Maybe Double
forall s e a. DropdownCfg s e a -> Maybe Double
_ddcMaxHeight DropdownCfg s e a
t2 Maybe Double -> Maybe Double -> Maybe Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DropdownCfg s e a -> Maybe Double
forall s e a. DropdownCfg s e a -> Maybe Double
_ddcMaxHeight DropdownCfg s e a
t1,
_ddcItemStyle :: Maybe Style
_ddcItemStyle = DropdownCfg s e a -> Maybe Style
forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemStyle DropdownCfg s e a
t2 Maybe Style -> Maybe Style -> Maybe Style
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DropdownCfg s e a -> Maybe Style
forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemStyle DropdownCfg s e a
t1,
_ddcItemSelectedStyle :: Maybe Style
_ddcItemSelectedStyle = DropdownCfg s e a -> Maybe Style
forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemSelectedStyle DropdownCfg s e a
t2 Maybe Style -> Maybe Style -> Maybe Style
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DropdownCfg s e a -> Maybe Style
forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemSelectedStyle DropdownCfg s e a
t1,
_ddcOnFocusReq :: [Path -> WidgetRequest s e]
_ddcOnFocusReq = DropdownCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnFocusReq DropdownCfg s e a
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> DropdownCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnFocusReq DropdownCfg s e a
t2,
_ddcOnBlurReq :: [Path -> WidgetRequest s e]
_ddcOnBlurReq = DropdownCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnBlurReq DropdownCfg s e a
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> DropdownCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnBlurReq DropdownCfg s e a
t2,
_ddcOnChangeReq :: [a -> WidgetRequest s e]
_ddcOnChangeReq = DropdownCfg s e a -> [a -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [a -> WidgetRequest s e]
_ddcOnChangeReq DropdownCfg s e a
t1 [a -> WidgetRequest s e]
-> [a -> WidgetRequest s e] -> [a -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> DropdownCfg s e a -> [a -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [a -> WidgetRequest s e]
_ddcOnChangeReq DropdownCfg s e a
t2,
_ddcOnChangeIdxReq :: [Int -> a -> WidgetRequest s e]
_ddcOnChangeIdxReq = DropdownCfg s e a -> [Int -> a -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Int -> a -> WidgetRequest s e]
_ddcOnChangeIdxReq DropdownCfg s e a
t1 [Int -> a -> WidgetRequest s e]
-> [Int -> a -> WidgetRequest s e]
-> [Int -> a -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> DropdownCfg s e a -> [Int -> a -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Int -> a -> WidgetRequest s e]
_ddcOnChangeIdxReq DropdownCfg s e a
t2
}
instance Monoid (DropdownCfg s e a) where
mempty :: DropdownCfg s e a
mempty = DropdownCfg s e a
forall a. Default a => a
def
instance WidgetEvent e => CmbOnFocus (DropdownCfg s e a) e Path where
onFocus :: (Path -> e) -> DropdownCfg s e a
onFocus Path -> e
fn = DropdownCfg s e a
forall a. Default a => a
def {
_ddcOnFocusReq :: [Path -> WidgetRequest s e]
_ddcOnFocusReq = [e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e)
-> (Path -> e) -> Path -> WidgetRequest s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> e
fn]
}
instance CmbOnFocusReq (DropdownCfg s e a) s e Path where
onFocusReq :: (Path -> WidgetRequest s e) -> DropdownCfg s e a
onFocusReq Path -> WidgetRequest s e
req = DropdownCfg s e a
forall a. Default a => a
def {
_ddcOnFocusReq :: [Path -> WidgetRequest s e]
_ddcOnFocusReq = [Path -> WidgetRequest s e
req]
}
instance WidgetEvent e => CmbOnBlur (DropdownCfg s e a) e Path where
onBlur :: (Path -> e) -> DropdownCfg s e a
onBlur Path -> e
fn = DropdownCfg s e a
forall a. Default a => a
def {
_ddcOnBlurReq :: [Path -> WidgetRequest s e]
_ddcOnBlurReq = [e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e)
-> (Path -> e) -> Path -> WidgetRequest s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> e
fn]
}
instance CmbOnBlurReq (DropdownCfg s e a) s e Path where
onBlurReq :: (Path -> WidgetRequest s e) -> DropdownCfg s e a
onBlurReq Path -> WidgetRequest s e
req = DropdownCfg s e a
forall a. Default a => a
def {
_ddcOnBlurReq :: [Path -> WidgetRequest s e]
_ddcOnBlurReq = [Path -> WidgetRequest s e
req]
}
instance WidgetEvent e => CmbOnChange (DropdownCfg s e a) a e where
onChange :: (a -> e) -> DropdownCfg s e a
onChange a -> e
fn = DropdownCfg s e a
forall a. Default a => a
def {
_ddcOnChangeReq :: [a -> WidgetRequest s e]
_ddcOnChangeReq = [e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e) -> (a -> e) -> a -> WidgetRequest s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> e
fn]
}
instance CmbOnChangeReq (DropdownCfg s e a) s e a where
onChangeReq :: (a -> WidgetRequest s e) -> DropdownCfg s e a
onChangeReq a -> WidgetRequest s e
req = DropdownCfg s e a
forall a. Default a => a
def {
_ddcOnChangeReq :: [a -> WidgetRequest s e]
_ddcOnChangeReq = [a -> WidgetRequest s e
req]
}
instance WidgetEvent e => CmbOnChangeIdx (DropdownCfg s e a) e a where
onChangeIdx :: (Int -> a -> e) -> DropdownCfg s e a
onChangeIdx Int -> a -> e
fn = DropdownCfg s e a
forall a. Default a => a
def {
_ddcOnChangeIdxReq :: [Int -> a -> WidgetRequest s e]
_ddcOnChangeIdxReq = [(e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent (e -> WidgetRequest s e) -> (a -> e) -> a -> WidgetRequest s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> e) -> a -> WidgetRequest s e)
-> (Int -> a -> e) -> Int -> a -> WidgetRequest s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> e
fn]
}
instance CmbOnChangeIdxReq (DropdownCfg s e a) s e a where
onChangeIdxReq :: (Int -> a -> WidgetRequest s e) -> DropdownCfg s e a
onChangeIdxReq Int -> a -> WidgetRequest s e
req = DropdownCfg s e a
forall a. Default a => a
def {
_ddcOnChangeIdxReq :: [Int -> a -> WidgetRequest s e]
_ddcOnChangeIdxReq = [Int -> a -> WidgetRequest s e
req]
}
instance CmbMaxHeight (DropdownCfg s e a) where
maxHeight :: Double -> DropdownCfg s e a
maxHeight Double
h = DropdownCfg s e a
forall a. Default a => a
def {
_ddcMaxHeight :: Maybe Double
_ddcMaxHeight = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
h
}
instance CmbItemBasicStyle (DropdownCfg s e a) Style where
itemBasicStyle :: Style -> DropdownCfg s e a
itemBasicStyle Style
style = DropdownCfg s e a
forall a. Default a => a
def {
_ddcItemStyle :: Maybe Style
_ddcItemStyle = Style -> Maybe Style
forall a. a -> Maybe a
Just Style
style
}
instance CmbItemSelectedStyle (DropdownCfg s e a) Style where
itemSelectedStyle :: Style -> DropdownCfg s e a
itemSelectedStyle Style
style = DropdownCfg s e a
forall a. Default a => a
def {
_ddcItemSelectedStyle :: Maybe Style
_ddcItemSelectedStyle = Style -> Maybe Style
forall a. a -> Maybe a
Just Style
style
}
data DropdownState = DropdownState {
DropdownState -> Bool
_ddsOpen :: Bool,
DropdownState -> Point
_ddsOffset :: Point
} deriving (DropdownState -> DropdownState -> Bool
(DropdownState -> DropdownState -> Bool)
-> (DropdownState -> DropdownState -> Bool) -> Eq DropdownState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DropdownState -> DropdownState -> Bool
$c/= :: DropdownState -> DropdownState -> Bool
== :: DropdownState -> DropdownState -> Bool
$c== :: DropdownState -> DropdownState -> Bool
Eq, Int -> DropdownState -> ShowS
[DropdownState] -> ShowS
DropdownState -> String
(Int -> DropdownState -> ShowS)
-> (DropdownState -> String)
-> ([DropdownState] -> ShowS)
-> Show DropdownState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DropdownState] -> ShowS
$cshowList :: [DropdownState] -> ShowS
show :: DropdownState -> String
$cshow :: DropdownState -> String
showsPrec :: Int -> DropdownState -> ShowS
$cshowsPrec :: Int -> DropdownState -> ShowS
Show, (forall x. DropdownState -> Rep DropdownState x)
-> (forall x. Rep DropdownState x -> DropdownState)
-> Generic DropdownState
forall x. Rep DropdownState x -> DropdownState
forall x. DropdownState -> Rep DropdownState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DropdownState x -> DropdownState
$cfrom :: forall x. DropdownState -> Rep DropdownState x
Generic)
data DropdownMessage
= forall a . DropdownItem a => OnChangeMessage Int a
| OnListBlur
dropdown
:: (WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a)
=> ALens' s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> WidgetNode s e
dropdown :: ALens' s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> WidgetNode s e
dropdown ALens' s a
field t a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow = WidgetNode s e
newNode where
newNode :: WidgetNode s e
newNode = ALens' s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a) =>
ALens' s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
dropdown_ ALens' s a
field t a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow [DropdownCfg s e a]
forall a. Default a => a
def
dropdown_
:: (WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a)
=> ALens' s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
dropdown_ :: ALens' s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
dropdown_ ALens' s a
field t a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow [DropdownCfg s e a]
configs = WidgetNode s e
newNode where
widgetData :: WidgetData s a
widgetData = ALens' s a -> WidgetData s a
forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s a
field
newNode :: WidgetNode s e
newNode = WidgetData s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a) =>
WidgetData s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
dropdownD_ WidgetData s a
widgetData t a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow [DropdownCfg s e a]
configs
dropdownV
:: (WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a)
=> a
-> (Int -> a -> e)
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> WidgetNode s e
dropdownV :: a
-> (Int -> a -> e)
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> WidgetNode s e
dropdownV a
value Int -> a -> e
handler t a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow = WidgetNode s e
newNode where
newNode :: WidgetNode s e
newNode = a
-> (Int -> a -> e)
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a) =>
a
-> (Int -> a -> e)
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
dropdownV_ a
value Int -> a -> e
handler t a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow [DropdownCfg s e a]
forall a. Default a => a
def
dropdownV_
:: (WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a)
=> a
-> (Int -> a -> e)
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
dropdownV_ :: a
-> (Int -> a -> e)
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
dropdownV_ a
value Int -> a -> e
handler t a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow [DropdownCfg s e a]
configs = WidgetNode s e
newNode where
newConfigs :: [DropdownCfg s e a]
newConfigs = (Int -> a -> e) -> DropdownCfg s e a
forall t e a. CmbOnChangeIdx t e a => (Int -> a -> e) -> t
onChangeIdx Int -> a -> e
handler DropdownCfg s e a -> [DropdownCfg s e a] -> [DropdownCfg s e a]
forall a. a -> [a] -> [a]
: [DropdownCfg s e a]
configs
newNode :: WidgetNode s e
newNode = WidgetData s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a) =>
WidgetData s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
dropdownD_ (a -> WidgetData s a
forall s a. a -> WidgetData s a
WidgetValue a
value) t a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow [DropdownCfg s e a]
newConfigs
dropdownD_
:: (WidgetModel s, WidgetEvent e, Traversable t, DropdownItem a)
=> WidgetData s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
dropdownD_ :: WidgetData s a
-> t a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> [DropdownCfg s e a]
-> WidgetNode s e
dropdownD_ WidgetData s a
widgetData t a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow [DropdownCfg s e a]
configs = Widget s e -> WidgetNode s e
forall s e. Widget s e -> WidgetNode s e
makeNode Widget s e
widget where
config :: DropdownCfg s e a
config = [DropdownCfg s e a] -> DropdownCfg s e a
forall a. Monoid a => [a] -> a
mconcat [DropdownCfg s e a]
configs
newState :: DropdownState
newState = Bool -> Point -> DropdownState
DropdownState Bool
False Point
forall a. Default a => a
def
newItems :: Seq a
newItems = (Seq a -> a -> Seq a) -> Seq a -> t a -> Seq a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
(|>) Seq a
forall a. Seq a
Empty t a
items
widget :: Widget s e
widget = WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
forall s e a.
(WidgetModel s, WidgetEvent e, DropdownItem a) =>
WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
makeDropdown WidgetData s a
widgetData Seq a
newItems a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow DropdownCfg s e a
config DropdownState
newState
makeNode :: Widget s e -> WidgetNode s e
makeNode :: Widget s e -> WidgetNode s e
makeNode Widget s e
widget = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
"dropdown" 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
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
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
True
makeDropdown
:: (WidgetModel s, WidgetEvent e, DropdownItem a)
=> WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
makeDropdown :: WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
makeDropdown WidgetData s a
widgetData Seq a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow DropdownCfg s e a
config DropdownState
state = Widget s e
widget where
container :: Container s e DropdownState
container = Container s e DropdownState
forall a. Default a => a
def {
containerAddStyleReq :: Bool
containerAddStyleReq = Bool
False,
containerChildrenOffset :: Maybe Point
containerChildrenOffset = Point -> Maybe Point
forall a. a -> Maybe a
Just (DropdownState -> Point
_ddsOffset DropdownState
state),
containerGetBaseStyle :: ContainerGetBaseStyle s e
containerGetBaseStyle = ContainerGetBaseStyle s e
forall s e p. WidgetEnv s e -> p -> Maybe Style
getBaseStyle,
containerInit :: ContainerInitHandler s e
containerInit = ContainerInitHandler s e
init,
containerFindNextFocus :: ContainerFindNextFocusHandler s e
containerFindNextFocus = ContainerFindNextFocusHandler s e
forall s a p p p.
HasChildren s (Seq a) =>
p -> s -> p -> p -> Seq a
findNextFocus,
containerFindByPoint :: ContainerFindByPointHandler s e
containerFindByPoint = ContainerFindByPointHandler s e
forall s s e p p.
HasChildren s (Seq (WidgetNode s e)) =>
p -> s -> p -> Point -> Maybe Int
findByPoint,
containerMerge :: ContainerMergeHandler s e DropdownState
containerMerge = ContainerMergeHandler s e DropdownState
forall p.
WidgetEnv s e
-> WidgetNode s e -> p -> DropdownState -> WidgetResult s e
merge,
containerDispose :: ContainerInitHandler s e
containerDispose = ContainerInitHandler s e
forall p s e. p -> WidgetNode s e -> WidgetResult s e
dispose,
containerHandleEvent :: ContainerEventHandler s e
containerHandleEvent = ContainerEventHandler s e
forall p.
WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
containerHandleMessage :: ContainerMessageHandler s e
containerHandleMessage = ContainerMessageHandler s e
forall a p.
Typeable a =>
WidgetEnv s e
-> WidgetNode s e -> p -> a -> Maybe (WidgetResult s e)
handleMessage,
containerGetSizeReq :: ContainerGetSizeReqHandler s e
containerGetSizeReq = ContainerGetSizeReqHandler s e
forall s e. ContainerGetSizeReqHandler s e
getSizeReq,
containerResize :: ContainerResizeHandler s e
containerResize = ContainerResizeHandler s e
forall s e p.
WidgetEnv s e
-> WidgetNode s e -> Rect -> p -> (WidgetResult s e, Seq Rect)
resize
}
baseWidget :: Widget s e
baseWidget = DropdownState -> Container s e DropdownState -> Widget s e
forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer DropdownState
state Container s e DropdownState
container
widget :: Widget s e
widget = Widget s e
baseWidget {
widgetRender :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
widgetRender = WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render
}
mainIdx :: Int
mainIdx = Int
0
listIdx :: Int
listIdx = Int
1
isOpen :: Bool
isOpen = DropdownState -> Bool
_ddsOpen DropdownState
state
currentValue :: WidgetEnv s e -> a
currentValue WidgetEnv s e
wenv = s -> WidgetData s a -> a
forall s a. s -> WidgetData s a -> a
widgetDataGet (WidgetEnv s e -> s
forall s e. WidgetEnv s e -> s
_weModel WidgetEnv s e
wenv) WidgetData s a
widgetData
createDropdown :: WidgetEnv s e -> WidgetNode s e -> DropdownState -> WidgetNode s e
createDropdown WidgetEnv s e
wenv WidgetNode s e
node DropdownState
newState = WidgetNode s e
newNode where
selected :: a
selected = WidgetEnv s e -> a
forall e. WidgetEnv s e -> a
currentValue WidgetEnv s e
wenv
nodeStyle :: Style
nodeStyle = WidgetNode s e -> WidgetNodeInfo
forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo WidgetNode s e
node WidgetNodeInfo -> Getting Style WidgetNodeInfo Style -> Style
forall s a. s -> Getting a s a -> a
^. Getting Style WidgetNodeInfo Style
forall s a. HasStyle s a => Lens' s a
L.style
mainNode :: WidgetNode s e
mainNode = a -> WidgetNode s e
makeMain a
selected
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
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Style -> Identity Style)
-> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Style -> Identity Style)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Identity Style)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasStyle s a => Lens' s a
L.style ((Style -> Identity Style)
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Style -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
nodeStyle
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
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
L.widgetId
selectListNode :: WidgetNode s e
selectListNode = WidgetEnv s e
-> WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> WidgetId
-> WidgetNode s e
forall s e a.
(WidgetModel s, WidgetEvent e, DropdownItem a) =>
WidgetEnv s e
-> WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> WidgetId
-> WidgetNode s e
makeSelectList WidgetEnv s e
wenv WidgetData s a
widgetData Seq a
items a -> WidgetNode s e
makeRow DropdownCfg s e a
config WidgetId
widgetId
newWidget :: Widget s e
newWidget = WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
forall s e a.
(WidgetModel s, WidgetEvent e, DropdownItem a) =>
WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
makeDropdown WidgetData s a
widgetData Seq a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow DropdownCfg s e a
config DropdownState
newState
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
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
.~ Widget s e
newWidget
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
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
mainNode, WidgetNode s e
selectListNode]
getBaseStyle :: WidgetEnv s e -> p -> Maybe Style
getBaseStyle WidgetEnv s e
wenv p
node = Style -> Maybe Style
forall a. a -> Maybe a
Just Style
style where
style :: Style
style = WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasDropdownStyle s a => Lens' s a
Lens' ThemeState StyleState
L.dropdownStyle
init :: ContainerInitHandler s e
init WidgetEnv s e
wenv WidgetNode s e
node = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode (WidgetNode s e -> WidgetResult s e)
-> WidgetNode s e -> WidgetResult s e
forall a b. (a -> b) -> a -> b
$ WidgetEnv s e -> WidgetNode s e -> DropdownState -> WidgetNode s e
createDropdown WidgetEnv s e
wenv WidgetNode s e
node DropdownState
state
merge :: WidgetEnv s e
-> WidgetNode s e -> p -> DropdownState -> WidgetResult s e
merge WidgetEnv s e
wenv WidgetNode s e
newNode p
oldNode DropdownState
oldState = WidgetResult s e
result where
result :: WidgetResult s e
result = WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode (WidgetNode s e -> WidgetResult s e)
-> WidgetNode s e -> WidgetResult s e
forall a b. (a -> b) -> a -> b
$ WidgetEnv s e -> WidgetNode s e -> DropdownState -> WidgetNode s e
createDropdown WidgetEnv s e
wenv WidgetNode s e
newNode DropdownState
oldState
dispose :: p -> WidgetNode s e -> WidgetResult s e
dispose p
wenv WidgetNode s e
node = 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]
reqs 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
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
L.widgetId
reqs :: [WidgetRequest s e]
reqs = [ WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
ResetOverlay WidgetId
widgetId | Bool
isOpen ]
findNextFocus :: p -> s -> p -> p -> Seq a
findNextFocus p
wenv s
node p
direction p
start
| Bool
isOpen = s
node s -> Getting (Seq a) s (Seq a) -> Seq a
forall s a. s -> Getting a s a -> a
^. Getting (Seq a) s (Seq a)
forall s a. HasChildren s a => Lens' s a
L.children
| Bool
otherwise = Seq a
forall a. Seq a
Empty
findByPoint :: p -> s -> p -> Point -> Maybe Int
findByPoint p
wenv s
node p
start Point
point = Maybe Int
result where
children :: Seq (WidgetNode s e)
children = s
node s
-> Getting (Seq (WidgetNode s e)) s (Seq (WidgetNode s e))
-> Seq (WidgetNode s e)
forall s a. s -> Getting a s a -> a
^. Getting (Seq (WidgetNode s e)) s (Seq (WidgetNode s e))
forall s a. HasChildren s a => Lens' s a
L.children
mainNode :: WidgetNode s e
mainNode = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
mainIdx
listNode :: WidgetNode s e
listNode = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
listIdx
result :: Maybe Int
result
| Bool
isOpen Bool -> Bool -> Bool
&& WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
listNode Point
point = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
listIdx
| Bool -> Bool
not Bool
isOpen Bool -> Bool -> Bool
&& WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
mainNode Point
point = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
mainIdx
| Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
ddFocusChange :: WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
ddFocusChange WidgetNode s e
node Path
prev [Path -> WidgetRequest s e]
reqs = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
newResult where
tmpResult :: Maybe (WidgetResult s e)
tmpResult = WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
handleFocusChange WidgetNode s e
node Path
prev [Path -> WidgetRequest s e]
reqs
newResult :: WidgetResult s e
newResult = WidgetResult s e -> Maybe (WidgetResult s e) -> WidgetResult s e
forall a. a -> Maybe a -> a
fromMaybe (WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node) Maybe (WidgetResult s e)
tmpResult
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
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e))
-> (Seq (WidgetRequest s e) -> Seq (WidgetRequest s e))
-> WidgetResult s e
-> WidgetResult s e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Seq (WidgetRequest s e)
-> WidgetRequest s e -> Seq (WidgetRequest s e)
forall a. Seq a -> a -> Seq a
|> WidgetRequest s e
forall s e. WidgetRequest s e
IgnoreChildrenEvents)
handleEvent :: WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent WidgetEnv s e
wenv WidgetNode s e
node p
target SystemEvent
evt = case SystemEvent
evt of
Focus Path
prev
| Bool -> Bool
not Bool
isOpen -> WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
ddFocusChange WidgetNode s e
node Path
prev (DropdownCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnFocusReq DropdownCfg s e a
config)
Blur Path
next
| Bool -> Bool
not Bool
isOpen Bool -> Bool -> Bool
&& Bool -> Bool
not (Path -> Path -> Bool
forall a. Eq a => Seq a -> Seq a -> Bool
seqStartsWith Path
path Path
focusedPath)
-> WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
ddFocusChange WidgetNode s e
node Path
next (DropdownCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnBlurReq DropdownCfg s e a
config)
Move Point
point -> Maybe (WidgetResult s e)
result where
mainNode :: WidgetNode s e
mainNode = 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
L.children) Int
mainIdx
listNode :: WidgetNode s e
listNode = 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
L.children) Int
listIdx
slPoint :: Point
slPoint = Point -> Point -> Point
addPoint (Point -> Point
negPoint (DropdownState -> Point
_ddsOffset DropdownState
state)) Point
point
validMainPos :: Bool
validMainPos = Bool -> Bool
not Bool
isOpen Bool -> Bool -> Bool
&& WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
mainNode Point
point
validListPos :: Bool
validListPos = Bool
isOpen Bool -> Bool -> Bool
&& WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
listNode Point
slPoint
validPos :: Bool
validPos = Bool
validMainPos Bool -> Bool -> Bool
|| Bool
validListPos
isArrow :: Bool
isArrow = CursorIcon -> Maybe CursorIcon
forall a. a -> Maybe a
Just CursorIcon
CursorArrow Maybe CursorIcon -> Maybe CursorIcon -> Bool
forall a. Eq a => a -> a -> Bool
== ((Path, CursorIcon) -> CursorIcon
forall a b. (a, b) -> b
snd ((Path, CursorIcon) -> CursorIcon)
-> Maybe (Path, CursorIcon) -> Maybe CursorIcon
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WidgetEnv s e
wenv WidgetEnv s e
-> Getting
(Maybe (Path, CursorIcon))
(WidgetEnv s e)
(Maybe (Path, CursorIcon))
-> Maybe (Path, CursorIcon)
forall s a. s -> Getting a s a -> a
^. Getting
(Maybe (Path, CursorIcon))
(WidgetEnv s e)
(Maybe (Path, CursorIcon))
forall s a. HasCursor s a => Lens' s a
L.cursor)
resetRes :: WidgetResult s e
resetRes = 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 [WidgetId -> CursorIcon -> WidgetRequest s e
forall s e. WidgetId -> CursorIcon -> WidgetRequest s e
SetCursorIcon WidgetId
widgetId CursorIcon
CursorArrow]
result :: Maybe (WidgetResult s e)
result
| Bool -> Bool
not Bool
validPos Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isArrow = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
resetRes
| Bool
otherwise = Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
ButtonAction Point
_ Button
btn ButtonState
BtnPressed Int
_
| Button
btn Button -> Button -> Bool
forall a. Eq a => a -> a -> Bool
== WidgetEnv s e
wenv WidgetEnv s e -> Getting Button (WidgetEnv s e) Button -> Button
forall s a. s -> Getting a s a -> a
^. Getting Button (WidgetEnv s e) Button
forall s a. HasMainButton s a => Lens' s a
L.mainButton Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isOpen -> Maybe (WidgetResult s e)
result where
result :: Maybe (WidgetResult s e)
result = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ 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 [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
SetFocus (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
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
L.widgetId)]
Click Point
point Button
_ Int
_
| Point -> WidgetNode s e -> Bool
forall s a. (HasInfo s a, HasViewport a Rect) => Point -> s -> Bool
openRequired Point
point WidgetNode s e
node -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
resultOpen
| Point -> WidgetNode s e -> Bool
forall s a a.
(HasChildren s (Seq a), HasInfo a a, HasViewport a Rect) =>
Point -> s -> Bool
closeRequired Point
point WidgetNode s e
node -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
resultClose
where
inVp :: Bool
inVp = WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
node Point
point
resultOpen :: WidgetResult s e
resultOpen = ContainerInitHandler s e
openDropdown WidgetEnv s e
wenv WidgetNode s e
node
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
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 [WidgetId -> CursorIcon -> WidgetRequest s e
forall s e. WidgetId -> CursorIcon -> WidgetRequest s e
SetCursorIcon WidgetId
widgetId CursorIcon
CursorArrow]
resultClose :: WidgetResult s e
resultClose = ContainerInitHandler s e
forall p. p -> WidgetNode s e -> WidgetResult s e
closeDropdown WidgetEnv s e
wenv WidgetNode s e
node
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
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 [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
ResetCursorIcon WidgetId
widgetId | Bool -> Bool
not Bool
inVp]
KeyAction KeyMod
mode KeyCode
code KeyStatus
KeyPressed
| Bool
isKeyOpenDropdown Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isOpen -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ ContainerInitHandler s e
openDropdown WidgetEnv s e
wenv WidgetNode s e
node
| KeyCode -> Bool
isKeyEscape KeyCode
code Bool -> Bool -> Bool
&& Bool
isOpen -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ ContainerInitHandler s e
forall p. p -> WidgetNode s e -> WidgetResult s e
closeDropdown WidgetEnv s e
wenv WidgetNode s e
node
where
activationKeys :: [KeyCode -> Bool]
activationKeys = [KeyCode -> Bool
isKeyDown, KeyCode -> Bool
isKeyUp, KeyCode -> Bool
isKeySpace, KeyCode -> Bool
isKeyReturn]
isKeyOpenDropdown :: Bool
isKeyOpenDropdown = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (((KeyCode -> Bool) -> Bool) -> [KeyCode -> Bool] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((KeyCode -> Bool) -> KeyCode -> Bool
forall a b. (a -> b) -> a -> b
$ KeyCode
code) [KeyCode -> Bool]
activationKeys)
SystemEvent
_
| Bool -> Bool
not Bool
isOpen -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ 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]
| Bool
otherwise -> Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
where
style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
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
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
L.widgetId
path :: Path
path = WidgetNode s e
node WidgetNode s e -> Getting Path (WidgetNode s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. (WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> WidgetNode s e -> Const Path (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> WidgetNode s e -> Const Path (WidgetNode s e))
-> ((Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo)
-> Getting Path (WidgetNode s e) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const Path Path)
-> WidgetNodeInfo -> Const Path WidgetNodeInfo
forall s a. HasPath s a => Lens' s a
L.path
focusedPath :: Path
focusedPath = WidgetEnv s e
wenv WidgetEnv s e -> Getting Path (WidgetEnv s e) Path -> Path
forall s a. s -> Getting a s a -> a
^. Getting Path (WidgetEnv s e) Path
forall s a. HasFocusedPath s a => Lens' s a
L.focusedPath
overlayPath :: Maybe Path
overlayPath = WidgetEnv s e
wenv WidgetEnv s e
-> Getting (Maybe Path) (WidgetEnv s e) (Maybe Path) -> Maybe Path
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Path) (WidgetEnv s e) (Maybe Path)
forall s a. HasOverlayPath s a => Lens' s a
L.overlayPath
overlayParent :: Bool
overlayParent = WidgetNode s e -> Path -> Bool
forall s e. WidgetNode s e -> Path -> Bool
isNodeParentOfPath WidgetNode s e
node (Maybe Path -> Path
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Path
overlayPath)
nodeValid :: Bool
nodeValid = Maybe Path -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Path
overlayPath Bool -> Bool -> Bool
|| Bool
overlayParent
openRequired :: Point -> s -> Bool
openRequired Point
point s
node = Bool -> Bool
not Bool
isOpen Bool -> Bool -> Bool
&& Bool
inViewport where
inViewport :: Bool
inViewport = Point -> Rect -> Bool
pointInRect Point
point (s
node s -> Getting Rect s Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (a -> Const Rect a) -> s -> Const Rect s
forall s a. HasInfo s a => Lens' s a
L.info ((a -> Const Rect a) -> s -> Const Rect s)
-> ((Rect -> Const Rect Rect) -> a -> Const Rect a)
-> Getting Rect s Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect) -> a -> Const Rect a
forall s a. HasViewport s a => Lens' s a
L.viewport)
closeRequired :: Point -> s -> Bool
closeRequired Point
point s
node = Bool
isOpen Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
inOverlay where
offset :: Point
offset = DropdownState -> Point
_ddsOffset DropdownState
state
listNode :: a
listNode = Seq a -> Int -> a
forall a. Seq a -> Int -> a
Seq.index (s
node s -> Getting (Seq a) s (Seq a) -> Seq a
forall s a. s -> Getting a s a -> a
^. Getting (Seq a) s (Seq a)
forall s a. HasChildren s a => Lens' s a
L.children) Int
listIdx
listVp :: Rect
listVp = Point -> Rect -> Rect
moveRect Point
offset (a
listNode a -> Getting Rect a Rect -> Rect
forall s a. s -> Getting a s a -> a
^. (a -> Const Rect a) -> a -> Const Rect a
forall s a. HasInfo s a => Lens' s a
L.info ((a -> Const Rect a) -> a -> Const Rect a)
-> ((Rect -> Const Rect Rect) -> a -> Const Rect a)
-> Getting Rect a Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rect -> Const Rect Rect) -> a -> Const Rect a
forall s a. HasViewport s a => Lens' s a
L.viewport)
inOverlay :: Bool
inOverlay = Point -> Rect -> Bool
pointInRect Point
point Rect
listVp
openDropdown :: ContainerInitHandler s e
openDropdown WidgetEnv s e
wenv WidgetNode s e
node = 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]
forall s e. [WidgetRequest s e]
requests where
newState :: DropdownState
newState = DropdownState
state {
_ddsOpen :: Bool
_ddsOpen = Bool
True,
_ddsOffset :: Point
_ddsOffset = WidgetEnv s e -> WidgetNode s e -> Point
forall s e. WidgetEnv s e -> WidgetNode s e -> Point
listOffset WidgetEnv s e
wenv WidgetNode s e
node
}
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
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 a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
forall s e a.
(WidgetModel s, WidgetEvent e, DropdownItem a) =>
WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
makeDropdown WidgetData s a
widgetData Seq a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow DropdownCfg s e a
config DropdownState
newState
(WidgetId
slWid, Path
slPath) = WidgetNode s e -> (WidgetId, Path)
forall s a b s.
(HasWidgetId s a, HasPath s b,
HasChildren s (Seq (WidgetNode s e)),
HasInfo (IxValue (Seq (WidgetNode s e))) s) =>
s -> (a, b)
scrollListInfo WidgetNode s e
node
(WidgetId
listWid, Path
_) = WidgetNode s e -> (WidgetId, Path)
forall s a b s a.
(HasWidgetId s a, HasPath s b,
HasChildren s (Seq (WidgetNode s e)),
HasChildren (IxValue (Seq (WidgetNode s e))) a, Ixed a,
Num (Index a), HasInfo (IxValue a) s) =>
s -> (a, b)
selectListInfo WidgetNode s e
node
scrollMsg :: WidgetRequest s e
scrollMsg = WidgetId -> SelectListMessage -> WidgetRequest s e
forall s e i. Typeable i => WidgetId -> i -> WidgetRequest s e
SendMessage WidgetId
listWid SelectListMessage
SelectListShowSelected
requests :: [WidgetRequest s e]
requests = [WidgetId -> Path -> WidgetRequest s e
forall s e. WidgetId -> Path -> WidgetRequest s e
SetOverlay WidgetId
slWid Path
slPath, WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
SetFocus WidgetId
listWid, WidgetRequest s e
forall s e. WidgetRequest s e
scrollMsg]
closeDropdown :: p -> WidgetNode s e -> WidgetResult s e
closeDropdown p
wenv WidgetNode s e
node = 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]
forall s e. [WidgetRequest s e]
requests 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
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
L.widgetId
(WidgetId
slWid, Path
_) = WidgetNode s e -> (WidgetId, Path)
forall s a b s.
(HasWidgetId s a, HasPath s b,
HasChildren s (Seq (WidgetNode s e)),
HasInfo (IxValue (Seq (WidgetNode s e))) s) =>
s -> (a, b)
scrollListInfo WidgetNode s e
node
(WidgetId
listWid, Path
_) = WidgetNode s e -> (WidgetId, Path)
forall s a b s a.
(HasWidgetId s a, HasPath s b,
HasChildren s (Seq (WidgetNode s e)),
HasChildren (IxValue (Seq (WidgetNode s e))) a, Ixed a,
Num (Index a), HasInfo (IxValue a) s) =>
s -> (a, b)
selectListInfo WidgetNode s e
node
newState :: DropdownState
newState = DropdownState
state {
_ddsOpen :: Bool
_ddsOpen = Bool
False,
_ddsOffset :: Point
_ddsOffset = Point
forall a. Default a => a
def
}
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
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 a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
forall s e a.
(WidgetModel s, WidgetEvent e, DropdownItem a) =>
WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> DropdownState
-> Widget s e
makeDropdown WidgetData s a
widgetData Seq a
items a -> WidgetNode s e
makeMain a -> WidgetNode s e
makeRow DropdownCfg s e a
config DropdownState
newState
requests :: [WidgetRequest s e]
requests = [WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
ResetOverlay WidgetId
slWid, WidgetId -> WidgetRequest s e
forall s e. WidgetId -> WidgetRequest s e
SetFocus WidgetId
widgetId]
scrollListInfo :: s -> (a, b)
scrollListInfo s
node = (s
scrollInfo s -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^. Getting a s a
forall s a. HasWidgetId s a => Lens' s a
L.widgetId, s
scrollInfo s -> Getting b s b -> b
forall s a. s -> Getting a s a -> a
^. Getting b s b
forall s a. HasPath s a => Lens' s a
L.path) where
scrollInfo :: s
scrollInfo = s
node s -> Getting (Endo s) s s -> s
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! (Seq (WidgetNode s e) -> Const (Endo s) (Seq (WidgetNode s e)))
-> s -> Const (Endo s) s
forall s a. HasChildren s a => Lens' s a
L.children ((Seq (WidgetNode s e) -> Const (Endo s) (Seq (WidgetNode s e)))
-> s -> Const (Endo s) s)
-> ((s -> Const (Endo s) s)
-> Seq (WidgetNode s e) -> Const (Endo s) (Seq (WidgetNode s e)))
-> Getting (Endo s) s s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Seq (WidgetNode s e))
-> Traversal'
(Seq (WidgetNode s e)) (IxValue (Seq (WidgetNode s e)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (Seq (WidgetNode s e))
listIdx ((IxValue (Seq (WidgetNode s e))
-> Const (Endo s) (IxValue (Seq (WidgetNode s e))))
-> Seq (WidgetNode s e) -> Const (Endo s) (Seq (WidgetNode s e)))
-> ((s -> Const (Endo s) s)
-> IxValue (Seq (WidgetNode s e))
-> Const (Endo s) (IxValue (Seq (WidgetNode s e))))
-> (s -> Const (Endo s) s)
-> Seq (WidgetNode s e)
-> Const (Endo s) (Seq (WidgetNode s e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> Const (Endo s) s)
-> IxValue (Seq (WidgetNode s e))
-> Const (Endo s) (IxValue (Seq (WidgetNode s e)))
forall s a. HasInfo s a => Lens' s a
L.info
selectListInfo :: s -> (a, b)
selectListInfo s
node = (s
listInfo s -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^. Getting a s a
forall s a. HasWidgetId s a => Lens' s a
L.widgetId, s
listInfo s -> Getting b s b -> b
forall s a. s -> Getting a s a -> a
^. Getting b s b
forall s a. HasPath s a => Lens' s a
L.path) where
listInfo :: s
listInfo = s
node s -> Getting (Endo s) s s -> s
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! (Seq (WidgetNode s e) -> Const (Endo s) (Seq (WidgetNode s e)))
-> s -> Const (Endo s) s
forall s a. HasChildren s a => Lens' s a
L.children ((Seq (WidgetNode s e) -> Const (Endo s) (Seq (WidgetNode s e)))
-> s -> Const (Endo s) s)
-> ((s -> Const (Endo s) s)
-> Seq (WidgetNode s e) -> Const (Endo s) (Seq (WidgetNode s e)))
-> Getting (Endo s) s s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Seq (WidgetNode s e))
-> Traversal'
(Seq (WidgetNode s e)) (IxValue (Seq (WidgetNode s e)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (Seq (WidgetNode s e))
listIdx ((IxValue (Seq (WidgetNode s e))
-> Const (Endo s) (IxValue (Seq (WidgetNode s e))))
-> Seq (WidgetNode s e) -> Const (Endo s) (Seq (WidgetNode s e)))
-> ((s -> Const (Endo s) s)
-> IxValue (Seq (WidgetNode s e))
-> Const (Endo s) (IxValue (Seq (WidgetNode s e))))
-> (s -> Const (Endo s) s)
-> Seq (WidgetNode s e)
-> Const (Endo s) (Seq (WidgetNode s e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Const (Endo s) a)
-> IxValue (Seq (WidgetNode s e))
-> Const (Endo s) (IxValue (Seq (WidgetNode s e)))
forall s a. HasChildren s a => Lens' s a
L.children ((a -> Const (Endo s) a)
-> IxValue (Seq (WidgetNode s e))
-> Const (Endo s) (IxValue (Seq (WidgetNode s e))))
-> ((s -> Const (Endo s) s) -> a -> Const (Endo s) a)
-> (s -> Const (Endo s) s)
-> IxValue (Seq (WidgetNode s e))
-> Const (Endo s) (IxValue (Seq (WidgetNode s e)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index a -> Traversal' a (IxValue a)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index a
0 ((IxValue a -> Const (Endo s) (IxValue a))
-> a -> Const (Endo s) a)
-> ((s -> Const (Endo s) s)
-> IxValue a -> Const (Endo s) (IxValue a))
-> (s -> Const (Endo s) s)
-> a
-> Const (Endo s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> Const (Endo s) s) -> IxValue a -> Const (Endo s) (IxValue a)
forall s a. HasInfo s a => Lens' s a
L.info
handleMessage :: WidgetEnv s e
-> WidgetNode s e -> p -> a -> Maybe (WidgetResult s e)
handleMessage WidgetEnv s e
wenv WidgetNode s e
node p
target a
msg =
a -> Maybe DropdownMessage
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
msg Maybe DropdownMessage
-> (DropdownMessage -> Maybe (WidgetResult s e))
-> Maybe (WidgetResult s e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WidgetEnv s e
-> WidgetNode s e -> DropdownMessage -> Maybe (WidgetResult s e)
handleLvMsg WidgetEnv s e
wenv WidgetNode s e
node
handleLvMsg :: WidgetEnv s e
-> WidgetNode s e -> DropdownMessage -> Maybe (WidgetResult s e)
handleLvMsg WidgetEnv s e
wenv WidgetNode s e
node (OnChangeMessage Int
idx a
_) =
Int -> Seq a -> Maybe a
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
idx Seq a
items Maybe a
-> (a -> Maybe (WidgetResult s e)) -> Maybe (WidgetResult s e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
value -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just (WidgetResult s e -> Maybe (WidgetResult s e))
-> WidgetResult s e -> Maybe (WidgetResult s e)
forall a b. (a -> b) -> a -> b
$ WidgetEnv s e -> WidgetNode s e -> Int -> a -> WidgetResult s e
forall p. p -> WidgetNode s e -> Int -> a -> WidgetResult s e
onChange WidgetEnv s e
wenv WidgetNode s e
node Int
idx a
value
handleLvMsg WidgetEnv s e
wenv WidgetNode s e
node DropdownMessage
OnListBlur = WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result where
tempResult :: WidgetResult s e
tempResult = ContainerInitHandler s e
forall p. p -> WidgetNode s e -> WidgetResult s e
closeDropdown WidgetEnv s e
wenv WidgetNode s e
node
result :: WidgetResult s e
result = WidgetResult s e
tempResult 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
L.requests ((Seq (WidgetRequest s e) -> Identity (Seq (WidgetRequest s e)))
-> WidgetResult s e -> Identity (WidgetResult s e))
-> (Seq (WidgetRequest s e) -> Seq (WidgetRequest s e))
-> WidgetResult s e
-> WidgetResult s e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Seq (WidgetRequest s e)
-> WidgetRequest s e -> Seq (WidgetRequest s e)
forall a. Seq a -> a -> Seq a
|> WidgetEnv s e -> WidgetRequest s e
forall s e. WidgetEnv s e -> WidgetRequest s e
createMoveFocusReq WidgetEnv s e
wenv)
onChange :: p -> WidgetNode s e -> Int -> a -> WidgetResult s e
onChange p
wenv WidgetNode s e
node Int
idx a
item = WidgetResult s e
result where
WidgetResult WidgetNode s e
newNode Seq (WidgetRequest s e)
reqs = p -> WidgetNode s e -> WidgetResult s e
forall p. p -> WidgetNode s e -> WidgetResult s e
closeDropdown p
wenv WidgetNode s e
node
newReqs :: Seq (WidgetRequest s e)
newReqs = [WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a. [a] -> Seq a
Seq.fromList ([WidgetRequest s e] -> Seq (WidgetRequest s e))
-> [WidgetRequest s e] -> Seq (WidgetRequest s e)
forall a b. (a -> b) -> a -> b
$ WidgetData s a -> a -> [WidgetRequest s e]
forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet WidgetData s a
widgetData a
item
[WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ ((a -> WidgetRequest s e) -> WidgetRequest s e)
-> [a -> WidgetRequest s e] -> [WidgetRequest s e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> WidgetRequest s e) -> a -> WidgetRequest s e
forall a b. (a -> b) -> a -> b
$ a
item) (DropdownCfg s e a -> [a -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [a -> WidgetRequest s e]
_ddcOnChangeReq DropdownCfg s e a
config)
[WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ ((Int -> a -> WidgetRequest s e) -> WidgetRequest s e)
-> [Int -> a -> WidgetRequest s e] -> [WidgetRequest s e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int -> a -> WidgetRequest s e
fn -> Int -> a -> WidgetRequest s e
fn Int
idx a
item) (DropdownCfg s e a -> [Int -> a -> WidgetRequest s e]
forall s e a. DropdownCfg s e a -> [Int -> a -> WidgetRequest s e]
_ddcOnChangeIdxReq DropdownCfg s e a
config)
result :: WidgetResult s e
result = WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
forall s e.
WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
WidgetResult WidgetNode s e
newNode (Seq (WidgetRequest s e)
reqs Seq (WidgetRequest s e)
-> Seq (WidgetRequest s e) -> Seq (WidgetRequest s e)
forall a. Semigroup a => a -> a -> a
<> Seq (WidgetRequest s e)
newReqs)
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
mainC :: WidgetNode s e
mainC = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
mainReqW :: SizeReq
mainReqW = WidgetNode s e
mainC 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
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
L.sizeReqW
mainReqH :: SizeReq
mainReqH = WidgetNode s e
mainC 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
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
L.sizeReqH
listC :: WidgetNode s e
listC = Seq (WidgetNode s e) -> Int -> WidgetNode s e
forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
1
listReqW :: SizeReq
listReqW = WidgetNode s e
listC 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
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
L.sizeReqW
newReqW :: SizeReq
newReqW = SizeReq -> SizeReq -> SizeReq
sizeReqMergeMax SizeReq
mainReqW SizeReq
listReqW
newReqH :: SizeReq
newReqH = SizeReq
mainReqH
listHeight :: WidgetEnv s e -> WidgetNode s e -> Double
listHeight WidgetEnv s e
wenv WidgetNode s e
node = Double
maxHeight where
Size Double
_ Double
winH = WidgetEnv s e -> Size
forall s e. WidgetEnv s e -> Size
_weWindowSize WidgetEnv s e
wenv
theme :: ThemeState
theme = WidgetEnv s e -> WidgetNode s e -> ThemeState
forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
maxHeightTheme :: Double
maxHeightTheme = ThemeState
theme ThemeState -> Getting Double ThemeState Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double ThemeState Double
forall s a. HasDropdownMaxHeight s a => Lens' s a
L.dropdownMaxHeight
cfgMaxHeight :: Maybe Double
cfgMaxHeight = DropdownCfg s e a -> Maybe Double
forall s e a. DropdownCfg s e a -> Maybe Double
_ddcMaxHeight DropdownCfg s e a
config
maxHeightStyle :: Double
maxHeightStyle = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
20 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
maxHeightTheme Maybe Double
cfgMaxHeight
reqHeight :: Double
reqHeight = case Int -> Seq (WidgetNode s e) -> Maybe (WidgetNode s e)
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
1 (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
L.children) of
Just WidgetNode s e
child -> SizeReq -> Double
sizeReqMaxBounded (SizeReq -> Double) -> SizeReq -> Double
forall a b. (a -> b) -> a -> b
$ WidgetNode s e
child 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
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
L.sizeReqH
Maybe (WidgetNode s e)
_ -> Double
0
maxHeight :: Double
maxHeight = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
winH (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
reqHeight Double
maxHeightStyle)
listOffset :: WidgetEnv s e -> WidgetNode s e -> Point
listOffset WidgetEnv s e
wenv WidgetNode s e
node = Double -> Double -> Point
Point Double
0 Double
newOffset where
Size Double
_ Double
winH = WidgetEnv s e -> Size
forall s e. WidgetEnv s e -> Size
_weWindowSize WidgetEnv s e
wenv
viewport :: Rect
viewport = WidgetNode s e
node 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
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
L.viewport
scOffset :: Point
scOffset = 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
L.offset
Rect Double
rx Double
ry Double
rw Double
rh = Point -> Rect -> Rect
moveRect Point
scOffset Rect
viewport
lh :: Double
lh = WidgetEnv s e -> WidgetNode s e -> Double
forall s e. WidgetEnv s e -> WidgetNode s e -> Double
listHeight WidgetEnv s e
wenv WidgetNode s e
node
newOffset :: Double
newOffset
| Double
ry Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
rh Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
lh Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
winH = - (Double
rh Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
lh)
| Bool
otherwise = Double
0
resize :: WidgetEnv s e
-> WidgetNode s e -> Rect -> p -> (WidgetResult s e, Seq Rect)
resize WidgetEnv s e
wenv WidgetNode s e
node Rect
viewport p
children = (WidgetResult s e, Seq Rect)
resized where
style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
Rect Double
rx Double
ry Double
rw Double
rh = Rect
viewport
!mainArea :: Rect
mainArea = Rect
viewport
!listArea :: Rect
listArea = Rect
viewport {
_rY :: Double
_rY = Double
ry Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
rh,
_rH :: Double
_rH = WidgetEnv s e -> WidgetNode s e -> Double
forall s e. WidgetEnv s e -> WidgetNode s e -> Double
listHeight WidgetEnv s e
wenv WidgetNode s e
node
}
assignedAreas :: Seq Rect
assignedAreas = [Rect] -> Seq Rect
forall a. [a] -> Seq a
Seq.fromList [Rect
mainArea, Rect
listArea]
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
Renderer -> Bool -> Rect -> IO () -> IO ()
drawInScissor Renderer
renderer Bool
True Rect
viewport (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Renderer -> Rect -> StyleState -> (Rect -> IO ()) -> IO ()
drawStyledAction Renderer
renderer Rect
viewport StyleState
style ((Rect -> IO ()) -> IO ()) -> (Rect -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Rect
contentArea -> 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
mainNode 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
L.widget) WidgetEnv s e
wenv WidgetNode s e
mainNode Renderer
renderer
Renderer -> StyleState -> Rect -> IO ()
renderArrow Renderer
renderer StyleState
style Rect
contentArea
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isOpen (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
totalOffset (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Renderer -> WidgetEnv s e -> WidgetNode s e -> IO ()
forall s e. Renderer -> WidgetEnv s e -> WidgetNode s e -> IO ()
renderOverlay Renderer
renderer WidgetEnv s e
cwenv WidgetNode s e
listOverlay
where
style :: StyleState
style = WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
currentStyle WidgetEnv s e
wenv WidgetNode s e
node
viewport :: Rect
viewport = WidgetNode s e
node 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
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
L.viewport
mainNode :: WidgetNode s e
mainNode = 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
L.children) Int
mainIdx
listOverlay :: WidgetNode s e
listOverlay = 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
L.children) Int
listIdx
listOverlayVp :: Rect
listOverlayVp = WidgetNode s e
listOverlay 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
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
L.viewport
scOffset :: Point
scOffset = 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
L.offset
offset :: Point
offset = DropdownState -> Point
_ddsOffset DropdownState
state
totalOffset :: Point
totalOffset = Point -> Point -> Point
addPoint Point
scOffset Point
offset
cwenv :: WidgetEnv s e
cwenv = Container s e DropdownState
-> 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 DropdownState
container WidgetEnv s e
wenv WidgetNode s e
node Rect
listOverlayVp
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
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
listOverlayVp
renderArrow :: Renderer -> StyleState -> Rect -> IO ()
renderArrow Renderer
renderer StyleState
style Rect
contentArea =
Renderer -> Rect -> Maybe Color -> IO ()
drawArrowDown Renderer
renderer Rect
arrowRect (StyleState -> Maybe Color
_sstFgColor StyleState
style)
where
Rect Double
x Double
y Double
w Double
h = Rect
contentArea
size :: FontSize
size = StyleState
style StyleState -> Getting FontSize StyleState FontSize -> FontSize
forall s a. s -> Getting a s a -> a
^. (Maybe TextStyle -> Const FontSize (Maybe TextStyle))
-> StyleState -> Const FontSize StyleState
forall s a. HasText s a => Lens' s a
L.text ((Maybe TextStyle -> Const FontSize (Maybe TextStyle))
-> StyleState -> Const FontSize StyleState)
-> ((FontSize -> Const FontSize FontSize)
-> Maybe TextStyle -> Const FontSize (Maybe TextStyle))
-> Getting FontSize StyleState FontSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextStyle -> Iso' (Maybe TextStyle) TextStyle
forall a. Eq a => a -> Iso' (Maybe a) a
non TextStyle
forall a. Default a => a
def ((TextStyle -> Const FontSize TextStyle)
-> Maybe TextStyle -> Const FontSize (Maybe TextStyle))
-> ((FontSize -> Const FontSize FontSize)
-> TextStyle -> Const FontSize TextStyle)
-> (FontSize -> Const FontSize FontSize)
-> Maybe TextStyle
-> Const FontSize (Maybe TextStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe FontSize -> Const FontSize (Maybe FontSize))
-> TextStyle -> Const FontSize TextStyle
forall s a. HasFontSize s a => Lens' s a
L.fontSize ((Maybe FontSize -> Const FontSize (Maybe FontSize))
-> TextStyle -> Const FontSize TextStyle)
-> ((FontSize -> Const FontSize FontSize)
-> Maybe FontSize -> Const FontSize (Maybe FontSize))
-> (FontSize -> Const FontSize FontSize)
-> TextStyle
-> Const FontSize TextStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontSize -> Iso' (Maybe FontSize) FontSize
forall a. Eq a => a -> Iso' (Maybe a) a
non FontSize
forall a. Default a => a
def
arrowW :: Double
arrowW = FontSize -> Double
unFontSize FontSize
size Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
dh :: Double
dh = (Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
arrowW) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
arrowRect :: Rect
arrowRect = Double -> Double -> Double -> Double -> Rect
Rect (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
dh Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2) (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dh Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1.25) Double
arrowW (Double
arrowW Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)
renderOverlay :: Renderer -> WidgetEnv s e -> WidgetNode s e -> IO ()
renderOverlay Renderer
renderer WidgetEnv s e
wenv WidgetNode s e
overlayNode = IO ()
renderAction where
widget :: Widget s e
widget = WidgetNode s e
overlayNode 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
L.widget
renderAction :: IO ()
renderAction = 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 Widget s e
widget WidgetEnv s e
wenv WidgetNode s e
overlayNode Renderer
renderer
makeSelectList
:: (WidgetModel s, WidgetEvent e, DropdownItem a)
=> WidgetEnv s e
-> WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> WidgetId
-> WidgetNode s e
makeSelectList :: WidgetEnv s e
-> WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> DropdownCfg s e a
-> WidgetId
-> WidgetNode s e
makeSelectList WidgetEnv s e
wenv WidgetData s a
value Seq a
items a -> WidgetNode s e
makeRow DropdownCfg s e a
config WidgetId
widgetId = WidgetNode s e
selectListNode where
normalTheme :: Style
normalTheme = WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasDropdownItemStyle s a => Lens' s a
Lens' ThemeState StyleState
L.dropdownItemStyle
selectedTheme :: Style
selectedTheme = WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasDropdownItemSelectedStyle s a => Lens' s a
Lens' ThemeState StyleState
L.dropdownItemSelectedStyle
itemStyle :: Style
itemStyle = Maybe Style -> Style
forall a. HasCallStack => Maybe a -> a
fromJust (Style -> Maybe Style
forall a. a -> Maybe a
Just Style
normalTheme Maybe Style -> Maybe Style -> Maybe Style
forall a. Semigroup a => a -> a -> a
<> DropdownCfg s e a -> Maybe Style
forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemStyle DropdownCfg s e a
config)
itemSelStyle :: Style
itemSelStyle = Maybe Style -> Style
forall a. HasCallStack => Maybe a -> a
fromJust (Style -> Maybe Style
forall a. a -> Maybe a
Just Style
selectedTheme Maybe Style -> Maybe Style -> Maybe Style
forall a. Semigroup a => a -> a -> a
<> DropdownCfg s e a -> Maybe Style
forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemSelectedStyle DropdownCfg s e a
config)
slConfig :: [SelectListCfg s e a]
slConfig = [
SelectListCfg s e a
forall t. CmbSelectOnBlur t => t
selectOnBlur,
(Path -> WidgetRequest s e) -> SelectListCfg s e a
forall t s e a.
CmbOnBlurReq t s e a =>
(a -> WidgetRequest s e) -> t
onBlurReq (WidgetRequest s e -> Path -> WidgetRequest s e
forall a b. a -> b -> a
const (WidgetRequest s e -> Path -> WidgetRequest s e)
-> WidgetRequest s e -> Path -> WidgetRequest s e
forall a b. (a -> b) -> a -> b
$ WidgetId -> DropdownMessage -> WidgetRequest s e
forall s e i. Typeable i => WidgetId -> i -> WidgetRequest s e
SendMessage WidgetId
widgetId DropdownMessage
OnListBlur),
(Int -> a -> WidgetRequest s e) -> SelectListCfg s e a
forall t s e a.
CmbOnChangeIdxReq t s e a =>
(Int -> a -> WidgetRequest s e) -> t
onChangeIdxReq (\Int
idx a
it -> WidgetId -> DropdownMessage -> WidgetRequest s e
forall s e i. Typeable i => WidgetId -> i -> WidgetRequest s e
SendMessage WidgetId
widgetId (Int -> a -> DropdownMessage
forall a. DropdownItem a => Int -> a -> DropdownMessage
OnChangeMessage Int
idx a
it)),
Style -> SelectListCfg s e a
forall t s. CmbItemBasicStyle t s => s -> t
itemBasicStyle Style
itemStyle,
Style -> SelectListCfg s e a
forall t s. CmbItemSelectedStyle t s => s -> t
itemSelectedStyle Style
itemSelStyle
]
slStyle :: Style
slStyle = WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasDropdownListStyle s a => Lens' s a
Lens' ThemeState StyleState
L.dropdownListStyle
selectListNode :: WidgetNode s e
selectListNode = WidgetData s a
-> Seq a
-> (a -> WidgetNode s e)
-> [SelectListCfg s e a]
-> WidgetNode s e
forall s e (t :: * -> *) a.
(WidgetModel s, WidgetEvent e, Traversable t, SelectListItem a) =>
WidgetData s a
-> t a
-> SelectListMakeRow s e a
-> [SelectListCfg s e a]
-> WidgetNode s e
selectListD_ WidgetData s a
value Seq a
items a -> WidgetNode s e
makeRow [SelectListCfg s e a]
slConfig
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
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Style -> Identity Style)
-> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Style -> Identity Style)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Identity Style)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasStyle s a => Lens' s a
L.style ((Style -> Identity Style)
-> WidgetNode s e -> Identity (WidgetNode s e))
-> Style -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
slStyle
createMoveFocusReq :: WidgetEnv s e -> WidgetRequest s e
createMoveFocusReq :: WidgetEnv s e -> WidgetRequest s e
createMoveFocusReq WidgetEnv s e
wenv = Maybe WidgetId -> FocusDirection -> WidgetRequest s e
forall s e. Maybe WidgetId -> FocusDirection -> WidgetRequest s e
MoveFocus Maybe WidgetId
forall a. Maybe a
Nothing FocusDirection
direction where
direction :: FocusDirection
direction
| WidgetEnv s e
wenv WidgetEnv s e -> Getting Bool (WidgetEnv s e) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (InputStatus -> Const Bool InputStatus)
-> WidgetEnv s e -> Const Bool (WidgetEnv s e)
forall s a. HasInputStatus s a => Lens' s a
L.inputStatus ((InputStatus -> Const Bool InputStatus)
-> WidgetEnv s e -> Const Bool (WidgetEnv s e))
-> ((Bool -> Const Bool Bool)
-> InputStatus -> Const Bool InputStatus)
-> Getting Bool (WidgetEnv s e) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyMod -> Const Bool KeyMod)
-> InputStatus -> Const Bool InputStatus
forall s a. HasKeyMod s a => Lens' s a
L.keyMod ((KeyMod -> Const Bool KeyMod)
-> InputStatus -> Const Bool InputStatus)
-> ((Bool -> Const Bool Bool) -> KeyMod -> Const Bool KeyMod)
-> (Bool -> Const Bool Bool)
-> InputStatus
-> Const Bool InputStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> KeyMod -> Const Bool KeyMod
forall s a. HasLeftShift s a => Lens' s a
L.leftShift = FocusDirection
FocusBwd
| Bool
otherwise = FocusDirection
FocusFwd