{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# 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 (Typeable, Proxy, cast, typeRep)
import GHC.Generics
import TextShow
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 {
forall s e a. DropdownCfg s e a -> Maybe Double
_ddcMaxHeight :: Maybe Double,
forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemStyle :: Maybe Style,
forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemSelectedStyle :: Maybe Style,
forall s e a.
DropdownCfg s e a
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
_ddcMergeRequired :: Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool),
forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnFocusReq :: [Path -> WidgetRequest s e],
forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnBlurReq :: [Path -> WidgetRequest s e],
forall s e a. DropdownCfg s e a -> [a -> WidgetRequest s e]
_ddcOnChangeReq :: [a -> WidgetRequest s e],
forall s e a. 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 {
_ddcMaxHeight :: Maybe Double
_ddcMaxHeight = forall a. Maybe a
Nothing,
_ddcItemStyle :: Maybe Style
_ddcItemStyle = forall a. Maybe a
Nothing,
_ddcItemSelectedStyle :: Maybe Style
_ddcItemSelectedStyle = forall a. Maybe a
Nothing,
_ddcMergeRequired :: Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
_ddcMergeRequired = 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 {
_ddcMaxHeight :: Maybe Double
_ddcMaxHeight = forall s e a. DropdownCfg s e a -> Maybe Double
_ddcMaxHeight DropdownCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DropdownCfg s e a -> Maybe Double
_ddcMaxHeight DropdownCfg s e a
t1,
_ddcItemStyle :: Maybe Style
_ddcItemStyle = forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemStyle DropdownCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemStyle DropdownCfg s e a
t1,
_ddcItemSelectedStyle :: Maybe Style
_ddcItemSelectedStyle = forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemSelectedStyle DropdownCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemSelectedStyle DropdownCfg s e a
t1,
_ddcMergeRequired :: Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
_ddcMergeRequired = forall s e a.
DropdownCfg s e a
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
_ddcMergeRequired DropdownCfg s e a
t2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s e a.
DropdownCfg s e a
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
_ddcMergeRequired DropdownCfg s e a
t1,
_ddcOnFocusReq :: [Path -> WidgetRequest s e]
_ddcOnFocusReq = forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnFocusReq DropdownCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnFocusReq DropdownCfg s e a
t2,
_ddcOnBlurReq :: [Path -> WidgetRequest s e]
_ddcOnBlurReq = forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnBlurReq DropdownCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> forall s e a. DropdownCfg s e a -> [Path -> WidgetRequest s e]
_ddcOnBlurReq DropdownCfg s e a
t2,
_ddcOnChangeReq :: [a -> WidgetRequest s e]
_ddcOnChangeReq = forall s e a. DropdownCfg s e a -> [a -> WidgetRequest s e]
_ddcOnChangeReq DropdownCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> 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 = forall s e a. DropdownCfg s e a -> [Int -> a -> WidgetRequest s e]
_ddcOnChangeIdxReq DropdownCfg s e a
t1 forall a. Semigroup a => a -> a -> a
<> 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 = 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 = forall a. Default a => a
def {
_ddcOnFocusReq :: [Path -> WidgetRequest s e]
_ddcOnFocusReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent 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 = 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 = forall a. Default a => a
def {
_ddcOnBlurReq :: [Path -> WidgetRequest s e]
_ddcOnBlurReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent 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 = 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 = forall a. Default a => a
def {
_ddcOnChangeReq :: [a -> WidgetRequest s e]
_ddcOnChangeReq = [forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent 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 = 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 = forall a. Default a => a
def {
_ddcOnChangeIdxReq :: [Int -> a -> WidgetRequest s e]
_ddcOnChangeIdxReq = [(forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 = forall a. Default a => a
def {
_ddcMaxHeight :: Maybe Double
_ddcMaxHeight = 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 = forall a. Default a => a
def {
_ddcItemStyle :: Maybe Style
_ddcItemStyle = 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 = forall a. Default a => a
def {
_ddcItemSelectedStyle :: Maybe Style
_ddcItemSelectedStyle = forall a. a -> Maybe a
Just Style
style
}
instance CmbMergeRequired (DropdownCfg s e a) (WidgetEnv s e) (Seq a) where
mergeRequired :: (WidgetEnv s e -> Seq a -> Seq a -> Bool) -> DropdownCfg s e a
mergeRequired WidgetEnv s e -> Seq a -> Seq a -> Bool
fn = forall a. Default a => a
def {
_ddcMergeRequired :: Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
_ddcMergeRequired = forall a. a -> Maybe a
Just WidgetEnv s e -> Seq a -> Seq a -> Bool
fn
}
data DropdownState = DropdownState {
DropdownState -> Bool
_ddsOpen :: Bool,
DropdownState -> Point
_ddsOffset :: Point
} deriving (DropdownState -> DropdownState -> Bool
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
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. 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 :: 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)
-> 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 = 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 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_ :: 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]
configs = WidgetNode s e
newNode where
widgetData :: WidgetData s a
widgetData = forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s a
field
newNode :: WidgetNode s e
newNode = 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 :: 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)
-> 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 = 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 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_ :: 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]
configs = WidgetNode s e
newNode where
newConfigs :: [DropdownCfg s e a]
newConfigs = forall t e a. CmbOnChangeIdx t e a => (Int -> a -> e) -> t
onChangeIdx Int -> a -> e
handler forall a. a -> [a] -> [a]
: [DropdownCfg s e a]
configs
newNode :: WidgetNode s e
newNode = 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_ (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_
:: 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_ :: 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 = WidgetNode s e
newNode where
config :: DropdownCfg s e a
config = forall a. Monoid a => [a] -> a
mconcat [DropdownCfg s e a]
configs
newState :: DropdownState
newState = Bool -> Point -> DropdownState
DropdownState Bool
False forall a. Default a => a
def
newItems :: Seq a
newItems = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Seq a -> a -> Seq a
(|>) forall a. Seq a
Empty t a
items
wtype :: WidgetType
wtype = Text -> WidgetType
WidgetType (Text
"dropdown-" forall a. Semigroup a => a -> a -> a
<> forall a. TextShow a => a -> Text
showt (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall a. HasCallStack => a
undefined :: Proxy a)))
widget :: Widget s e
widget = 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
newNode :: WidgetNode s e
newNode = forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
wtype Widget s e
widget
forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFocusable s a => Lens' s a
L.focusable forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
makeDropdown
:: 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 :: 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
state = Widget s e
widget where
container :: Container s e DropdownState
container = forall a. Default a => a
def {
containerAddStyleReq :: Bool
containerAddStyleReq = Bool
False,
containerChildrenOffset :: Maybe Point
containerChildrenOffset = forall a. a -> Maybe a
Just (DropdownState -> Point
_ddsOffset DropdownState
state),
containerGetBaseStyle :: ContainerGetBaseStyle s e
containerGetBaseStyle = 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 = forall {s} {a} {p} {p} {p}.
HasChildren s (Seq a) =>
p -> s -> p -> p -> Seq a
findNextFocus,
containerFindByPoint :: ContainerFindByPointHandler s e
containerFindByPoint = forall {p} {s} {e} {p} {p}.
HasChildren p (Seq (WidgetNode s e)) =>
p -> p -> p -> Point -> Maybe Int
findByPoint,
containerMerge :: ContainerMergeHandler s e DropdownState
containerMerge = forall {p}.
WidgetEnv s e
-> WidgetNode s e -> p -> DropdownState -> WidgetResult s e
merge,
containerDispose :: ContainerInitHandler s e
containerDispose = forall {p} {s} {e}. p -> WidgetNode s e -> WidgetResult s e
dispose,
containerHandleEvent :: ContainerEventHandler s e
containerHandleEvent = forall {p}.
WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
containerHandleMessage :: ContainerMessageHandler s e
containerHandleMessage = 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
getSizeReq,
containerResize :: ContainerResizeHandler s e
containerResize = forall {s} {e} {p}.
WidgetEnv s e
-> WidgetNode s e -> Rect -> p -> (WidgetResult s e, Seq Rect)
resize
}
baseWidget :: Widget s e
baseWidget = 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 = forall s a. s -> WidgetData s a -> a
widgetDataGet (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 = forall {e}. WidgetEnv s e -> a
currentValue WidgetEnv s e
wenv
nodeStyle :: Style
nodeStyle = forall s e. WidgetNode s e -> WidgetNodeInfo
_wnInfo WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasStyle s a => Lens' s a
L.style
mainNode :: WidgetNode s e
mainNode = a -> WidgetNode s e
makeMain a
selected
forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasStyle s a => Lens' s a
L.style forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
nodeStyle
widgetId :: WidgetId
widgetId = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
selectListNode :: WidgetNode s e
selectListNode = 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 = 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
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ Widget s e
newWidget
forall a b. a -> (a -> b) -> b
& forall s a. HasChildren s a => Lens' s a
L.children forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. [a] -> Seq a
Seq.fromList [WidgetNode s e
mainNode, WidgetNode s e
selectListNode]
getBaseStyle :: WidgetEnv s e -> p -> Maybe Style
getBaseStyle WidgetEnv s e
wenv p
node = forall a. a -> Maybe a
Just Style
style where
style :: Style
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
L.dropdownStyle
init :: ContainerInitHandler s e
init WidgetEnv s e
wenv WidgetNode s e
node = forall s e. WidgetNode s e -> WidgetResult s e
resultNode 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 = forall s e. WidgetNode s e -> WidgetResult s e
resultNode 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 = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node forall {s} {e}. [WidgetRequest s e]
reqs where
widgetId :: WidgetId
widgetId = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
reqs :: [WidgetRequest s e]
reqs = [ 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children
| Bool
otherwise = forall a. Seq a
Empty
findByPoint :: p -> p -> p -> Point -> Maybe Int
findByPoint p
wenv p
node p
start Point
point = Maybe Int
result where
children :: Seq (WidgetNode s e)
children = p
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children
mainNode :: WidgetNode s e
mainNode = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
mainIdx
listNode :: WidgetNode s e
listNode = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
listIdx
result :: Maybe Int
result
| Bool
isOpen Bool -> Bool -> Bool
&& forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
listNode Point
point = forall a. a -> Maybe a
Just Int
listIdx
| Bool -> Bool
not Bool
isOpen Bool -> Bool -> Bool
&& forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
mainNode Point
point = forall a. a -> Maybe a
Just Int
mainIdx
| Bool
otherwise = 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 = forall a. a -> Maybe a
Just WidgetResult s e
newResult where
tmpResult :: Maybe (WidgetResult s e)
tmpResult = 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 = forall a. a -> Maybe a -> a
fromMaybe (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node) Maybe (WidgetResult s e)
tmpResult
forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Seq a -> a -> Seq a
|> 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 -> forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
ddFocusChange WidgetNode s e
node Path
prev (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 (forall a. Eq a => Seq a -> Seq a -> Bool
seqStartsWith Path
path Path
focusedPath)
-> forall s e.
WidgetNode s e
-> Path -> [Path -> WidgetRequest s e] -> Maybe (WidgetResult s e)
ddFocusChange WidgetNode s e
node Path
next (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 = forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children) Int
mainIdx
listNode :: WidgetNode s e
listNode = forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children) Int
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
&& forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
mainNode Point
point
validListPos :: Bool
validListPos = Bool
isOpen Bool -> Bool -> 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 = forall a. a -> Maybe a
Just CursorIcon
CursorArrow forall a. Eq a => a -> a -> Bool
== (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasCursor s a => Lens' s a
L.cursor)
resetRes :: WidgetResult s e
resetRes = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [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 = forall a. a -> Maybe a
Just WidgetResult s e
resetRes
| Bool
otherwise = forall a. Maybe a
Nothing
ButtonAction Point
_ Button
btn ButtonState
BtnPressed Int
_
| Button
btn forall a. Eq a => a -> a -> Bool
== WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. 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 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall s e. WidgetId -> WidgetRequest s e
SetFocus (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId)]
Click Point
point Button
_ Int
_
| forall {p} {a}.
(HasInfo p a, HasViewport a Rect) =>
Point -> p -> Bool
openRequired Point
point WidgetNode s e
node -> forall a. a -> Maybe a
Just WidgetResult s e
resultOpen
| forall {p} {a} {a}.
(HasChildren p (Seq a), HasInfo a a, HasViewport a Rect) =>
Point -> p -> Bool
closeRequired Point
point WidgetNode s e
node -> forall a. a -> Maybe a
Just WidgetResult s e
resultClose
where
inVp :: Bool
inVp = 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
forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ forall a. [a] -> Seq a
Seq.fromList [forall s e. WidgetId -> CursorIcon -> WidgetRequest s e
SetCursorIcon WidgetId
widgetId CursorIcon
CursorArrow]
resultClose :: WidgetResult s e
resultClose = forall {p}. p -> WidgetNode s e -> WidgetResult s e
closeDropdown WidgetEnv s e
wenv WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ forall a. [a] -> Seq a
Seq.fromList [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 -> forall a. a -> Maybe a
Just 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 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 = forall (t :: * -> *). Foldable t => t Bool -> Bool
or (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ KeyCode
code) [KeyCode -> Bool]
activationKeys)
SystemEvent
_
| Bool -> Bool
not Bool
isOpen -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [forall s e. WidgetRequest s e
IgnoreChildrenEvents]
| Bool
otherwise -> forall a. Maybe a
Nothing
where
style :: StyleState
style = 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
path :: Path
path = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasPath s a => Lens' s a
L.path
focusedPath :: Path
focusedPath = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasFocusedPath s a => Lens' s a
L.focusedPath
overlayPath :: Maybe Path
overlayPath = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasOverlayPath s a => Lens' s a
L.overlayPath
overlayParent :: Bool
overlayParent = forall s e. WidgetNode s e -> Path -> Bool
isNodeParentOfPath WidgetNode s e
node (forall a. HasCallStack => Maybe a -> a
fromJust Maybe Path
overlayPath)
nodeValid :: Bool
nodeValid = forall a. Maybe a -> Bool
isNothing Maybe Path
overlayPath Bool -> Bool -> Bool
|| Bool
overlayParent
openRequired :: Point -> p -> Bool
openRequired Point
point p
node = Bool -> Bool
not Bool
isOpen Bool -> Bool -> Bool
&& Bool
inViewport where
inViewport :: Bool
inViewport = Point -> Rect -> Bool
pointInRect Point
point (p
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport)
closeRequired :: Point -> p -> Bool
closeRequired Point
point p
node = Bool
isOpen Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
inOverlay where
offset :: Point
offset = DropdownState -> Point
_ddsOffset DropdownState
state
listNode :: a
listNode = forall a. Seq a -> Int -> a
Seq.index (p
node forall s a. s -> Getting a s a -> 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport)
inOverlay :: Bool
inOverlay = Point -> Rect -> Bool
pointInRect Point
point Rect
listVp
openDropdown :: ContainerInitHandler s e
openDropdown WidgetEnv s e
wenv WidgetNode s e
node = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode forall {s} {e}. [WidgetRequest s e]
requests where
newState :: DropdownState
newState = DropdownState
state {
_ddsOpen :: Bool
_ddsOpen = Bool
True,
_ddsOffset :: Point
_ddsOffset = 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
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e 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)
scrollListInfo WidgetNode s e
node
(WidgetId
listWid, Path
_) = WidgetNode s e -> (WidgetId, Path)
selectListInfo WidgetNode s e
node
scrollMsg :: WidgetRequest s e
scrollMsg = forall s e i. Typeable i => WidgetId -> i -> WidgetRequest s e
SendMessage WidgetId
listWid SelectListMessage
SelectListShowSelected
requests :: [WidgetRequest s e]
requests = [forall s e. WidgetId -> Path -> WidgetRequest s e
SetOverlay WidgetId
slWid Path
slPath, forall s e. WidgetId -> WidgetRequest s e
SetFocus WidgetId
listWid, forall s e. WidgetRequest s e
scrollMsg]
closeDropdown :: p -> WidgetNode s e -> WidgetResult s e
closeDropdown p
wenv WidgetNode s e
node = forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
newNode forall {s} {e}. [WidgetRequest s e]
requests where
widgetId :: WidgetId
widgetId = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWidgetId s a => Lens' s a
L.widgetId
(WidgetId
slWid, Path
_) = WidgetNode s e -> (WidgetId, Path)
scrollListInfo WidgetNode s e
node
(WidgetId
listWid, Path
_) = WidgetNode s e -> (WidgetId, Path)
selectListInfo WidgetNode s e
node
newState :: DropdownState
newState = DropdownState
state {
_ddsOpen :: Bool
_ddsOpen = Bool
False,
_ddsOffset :: Point
_ddsOffset = forall a. Default a => a
def
}
newNode :: WidgetNode s e
newNode = WidgetNode s e
node
forall a b. a -> (a -> b) -> b
& forall s a. HasWidget s a => Lens' s a
L.widget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e 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 = [forall s e. WidgetId -> WidgetRequest s e
ResetOverlay WidgetId
slWid, forall s e. WidgetId -> WidgetRequest s e
SetFocus WidgetId
widgetId]
scrollListInfo :: WidgetNode s e -> (WidgetId, Path)
scrollListInfo :: WidgetNode s e -> (WidgetId, Path)
scrollListInfo WidgetNode s e
node = (WidgetNodeInfo
scrollInfo forall s a. s -> Getting a s a -> a
^. forall s a. HasWidgetId s a => Lens' s a
L.widgetId, WidgetNodeInfo
scrollInfo forall s a. s -> Getting a s a -> a
^. forall s a. HasPath s a => Lens' s a
L.path) where
scrollInfo :: WidgetNodeInfo
scrollInfo = WidgetNode s e
node forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall s a. HasChildren s a => Lens' s a
L.children forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
listIdx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasInfo s a => Lens' s a
L.info
selectListInfo :: WidgetNode s e -> (WidgetId, Path)
selectListInfo :: WidgetNode s e -> (WidgetId, Path)
selectListInfo WidgetNode s e
node = (WidgetNodeInfo
listInfo forall s a. s -> Getting a s a -> a
^. forall s a. HasWidgetId s a => Lens' s a
L.widgetId, WidgetNodeInfo
listInfo forall s a. s -> Getting a s a -> a
^. forall s a. HasPath s a => Lens' s a
L.path) where
listInfo :: WidgetNodeInfo
listInfo = WidgetNode s e
node forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall s a. HasChildren s a => Lens' s a
L.children forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
listIdx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasChildren s a => Lens' s a
L.children forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Seq (WidgetNode s e))
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
msg 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
_) =
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
idx Seq a
items forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
value -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 = forall a. a -> Maybe a
Just WidgetResult s e
result where
tempResult :: WidgetResult s e
tempResult = 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 forall a b. a -> (a -> b) -> b
& forall s a. HasRequests s a => Lens' s a
L.requests forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Seq a -> a -> Seq a
|> 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 = forall {p}. p -> WidgetNode s e -> WidgetResult s e
closeDropdown p
wenv WidgetNode s e
node
newReqs :: Seq (WidgetRequest s e)
newReqs = forall a. [a] -> Seq a
Seq.fromList forall a b. (a -> b) -> a -> b
$ forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet WidgetData s a
widgetData a
item
forall a. [a] -> [a] -> [a]
++ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ a
item) (forall s e a. DropdownCfg s e a -> [a -> WidgetRequest s e]
_ddcOnChangeReq DropdownCfg s e a
config)
forall a. [a] -> [a] -> [a]
++ 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) (forall s e a. DropdownCfg s e a -> [Int -> a -> WidgetRequest s e]
_ddcOnChangeIdxReq DropdownCfg s e a
config)
result :: WidgetResult s e
result = forall s e.
WidgetNode s e -> Seq (WidgetRequest s e) -> WidgetResult s e
WidgetResult WidgetNode s e
newNode (Seq (WidgetRequest s e)
reqs 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 = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
0
mainReqW :: SizeReq
mainReqW = WidgetNode s e
mainC forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW
mainReqH :: SizeReq
mainReqH = WidgetNode s e
mainC forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH
listC :: WidgetNode s e
listC = forall a. Seq a -> Int -> a
Seq.index Seq (WidgetNode s e)
children Int
1
listReqW :: SizeReq
listReqW = WidgetNode s e
listC forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqW s a => Lens' s a
L.sizeReqW
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 = forall s e. WidgetEnv s e -> Size
_weWindowSize WidgetEnv s e
wenv
theme :: ThemeState
theme = forall s e. WidgetEnv s e -> WidgetNode s e -> ThemeState
currentTheme WidgetEnv s e
wenv WidgetNode s e
node
maxHeightTheme :: Double
maxHeightTheme = ThemeState
theme forall s a. s -> Getting a s a -> a
^. forall s a. HasDropdownMaxHeight s a => Lens' s a
L.dropdownMaxHeight
cfgMaxHeight :: Maybe Double
cfgMaxHeight = forall s e a. DropdownCfg s e a -> Maybe Double
_ddcMaxHeight DropdownCfg s e a
config
maxHeightStyle :: Double
maxHeightStyle = forall a. Ord a => a -> a -> a
max Double
20 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Double
maxHeightTheme Maybe Double
cfgMaxHeight
reqHeight :: Double
reqHeight = case forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
1 (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children) of
Just WidgetNode s e
child -> SizeReq -> Double
sizeReqMaxBounded forall a b. (a -> b) -> a -> b
$ WidgetNode s e
child forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSizeReqH s a => Lens' s a
L.sizeReqH
Maybe (WidgetNode s e)
_ -> Double
0
maxHeight :: Double
maxHeight = forall a. Ord a => a -> a -> a
min Double
winH (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 = forall s e. WidgetEnv s e -> Size
_weWindowSize WidgetEnv s e
wenv
viewport :: Rect
viewport = WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport
scOffset :: Point
scOffset = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasOffset s a => Lens' s a
L.offset
Rect Double
rx Double
ry Double
rw Double
rh = Point -> Rect -> Rect
moveRect Point
scOffset Rect
viewport
lh :: Double
lh = forall {s} {e}. WidgetEnv s e -> WidgetNode s e -> Double
listHeight WidgetEnv s e
wenv WidgetNode s e
node
newOffset :: Double
newOffset
| Double
ry forall a. Num a => a -> a -> a
+ Double
rh forall a. Num a => a -> a -> a
+ Double
lh forall a. Ord a => a -> a -> Bool
> Double
winH = - (Double
rh 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 = 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 forall a. Num a => a -> a -> a
+ Double
rh,
_rH :: Double
_rH = forall {s} {e}. WidgetEnv s e -> WidgetNode s e -> Double
listHeight WidgetEnv s e
wenv WidgetNode s e
node
}
assignedAreas :: Seq Rect
assignedAreas = forall a. [a] -> Seq a
Seq.fromList [Rect
mainArea, Rect
listArea]
resized :: (WidgetResult s e, Seq Rect)
resized = (forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node, Seq Rect
assignedAreas)
render :: WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
render WidgetEnv s e
wenv WidgetNode s e
node Renderer
renderer = do
Renderer -> Bool -> Rect -> IO () -> IO ()
drawInScissor Renderer
renderer Bool
True Rect
viewport forall a b. (a -> b) -> a -> b
$
Renderer -> Rect -> StyleState -> (Rect -> IO ()) -> IO ()
drawStyledAction Renderer
renderer Rect
viewport StyleState
style forall a b. (a -> b) -> a -> b
$ \Rect
contentArea -> do
forall s e.
Widget s e -> WidgetEnv s e -> WidgetNode s e -> Renderer -> IO ()
widgetRender (WidgetNode s e
mainNode forall s a. s -> Getting a s a -> a
^. 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
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isOpen forall a b. (a -> b) -> a -> b
$
Renderer -> IO () -> IO ()
createOverlay Renderer
renderer forall a b. (a -> b) -> a -> b
$
Renderer -> Point -> IO () -> IO ()
drawInTranslation Renderer
renderer Point
totalOffset forall a b. (a -> b) -> a -> b
$ do
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 = 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport
mainNode :: WidgetNode s e
mainNode = forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children) Int
mainIdx
listOverlay :: WidgetNode s e
listOverlay = forall a. Seq a -> Int -> a
Seq.index (WidgetNode s e
node forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
L.children) Int
listIdx
listOverlayVp :: Rect
listOverlayVp = WidgetNode s e
listOverlay forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasViewport s a => Lens' s a
L.viewport
scOffset :: Point
scOffset = WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. 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 = 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
forall a b. a -> (a -> b) -> b
& forall s a. HasViewport s a => Lens' s a
L.viewport forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rect
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 forall s a. s -> Getting a s a -> a
^. forall s a. HasText s a => Lens' s a
L.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFontSize s a => Lens' s a
L.fontSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall a. Default a => a
def
arrowW :: Double
arrowW = FontSize -> Double
unFontSize FontSize
size forall a. Fractional a => a -> a -> a
/ Double
2
arrowRect :: Rect
arrowRect = Double -> Double -> Double -> Double -> Rect
Rect (Double
x forall a. Num a => a -> a -> a
+ Double
w forall a. Num a => a -> a -> a
- Double
arrowW) (Double
y forall a. Num a => a -> a -> a
+ Double
h forall a. Fractional a => a -> a -> a
/ Double
2 forall a. Num a => a -> a -> a
- Double
arrowW forall a. Fractional a => a -> a -> a
/ Double
3) Double
arrowW (Double
arrowW 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasWidget s a => Lens' s a
L.widget
renderAction :: IO ()
renderAction = 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 :: 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
value Seq a
items a -> WidgetNode s e
makeRow DropdownCfg s e a
config WidgetId
widgetId = WidgetNode s e
selectListNode where
normalTheme :: Style
normalTheme = forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasDropdownItemStyle s a => Lens' s a
L.dropdownItemStyle
selectedTheme :: Style
selectedTheme = forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasDropdownItemSelectedStyle s a => Lens' s a
L.dropdownItemSelectedStyle
itemStyle :: Style
itemStyle = forall a. HasCallStack => Maybe a -> a
fromJust (forall a. a -> Maybe a
Just Style
normalTheme forall a. Semigroup a => a -> a -> a
<> forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemStyle DropdownCfg s e a
config)
itemSelStyle :: Style
itemSelStyle = forall a. HasCallStack => Maybe a -> a
fromJust (forall a. a -> Maybe a
Just Style
selectedTheme forall a. Semigroup a => a -> a -> a
<> forall s e a. DropdownCfg s e a -> Maybe Style
_ddcItemSelectedStyle DropdownCfg s e a
config)
mergeReqFn :: SelectListCfg s e a
mergeReqFn = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Default a => a
def forall t w s. CmbMergeRequired t w s => (w -> s -> s -> Bool) -> t
mergeRequired (forall s e a.
DropdownCfg s e a
-> Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool)
_ddcMergeRequired DropdownCfg s e a
config)
slConfig :: [SelectListCfg s e a]
slConfig = [
forall t. CmbSelectOnBlur t => t
selectOnBlur,
forall t s e a.
CmbOnBlurReq t s e a =>
(a -> WidgetRequest s e) -> t
onBlurReq (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall s e i. Typeable i => WidgetId -> i -> WidgetRequest s e
SendMessage WidgetId
widgetId DropdownMessage
OnListBlur),
forall t s e a.
CmbOnChangeIdxReq t s e a =>
(Int -> a -> WidgetRequest s e) -> t
onChangeIdxReq (\Int
idx a
it -> forall s e i. Typeable i => WidgetId -> i -> WidgetRequest s e
SendMessage WidgetId
widgetId (forall a. DropdownItem a => Int -> a -> DropdownMessage
OnChangeMessage Int
idx a
it)),
forall t s. CmbItemBasicStyle t s => s -> t
itemBasicStyle Style
itemStyle,
forall t s. CmbItemSelectedStyle t s => s -> t
itemSelectedStyle Style
itemSelStyle,
SelectListCfg s e a
mergeReqFn
]
slStyle :: Style
slStyle = forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasDropdownListStyle s a => Lens' s a
L.dropdownListStyle
selectListNode :: WidgetNode s e
selectListNode = 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
forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasStyle s a => Lens' s a
L.style forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
slStyle
createMoveFocusReq :: WidgetEnv s e -> WidgetRequest s e
createMoveFocusReq :: forall s e. WidgetEnv s e -> WidgetRequest s e
createMoveFocusReq WidgetEnv s e
wenv = forall s e. Maybe WidgetId -> FocusDirection -> WidgetRequest s e
MoveFocus forall a. Maybe a
Nothing FocusDirection
direction where
direction :: FocusDirection
direction
| WidgetEnv s e
wenv forall s a. s -> Getting a s a -> a
^. forall s a. HasInputStatus s a => Lens' s a
L.inputStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasKeyMod s a => Lens' s a
L.keyMod forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasLeftShift s a => Lens' s a
L.leftShift = FocusDirection
FocusBwd
| Bool
otherwise = FocusDirection
FocusFwd