{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StrictData #-}
module Monomer.Widgets.Singles.OptionButton (
OptionButtonValue,
OptionButtonCfg,
optionButtonOffStyle,
optionButton,
optionButton_,
optionButtonV,
optionButtonV_,
optionButtonD_,
makeOptionButton
) where
import Control.Applicative ((<|>))
import Control.Lens (ALens', Lens', (&), (^.), (^?), (.~), (?~), _Just)
import Control.Monad
import Data.Default
import Data.Maybe
import Data.Text (Text)
import Data.Typeable (Typeable, typeOf)
import TextShow
import qualified Data.Sequence as Seq
import Monomer.Widgets.Container
import Monomer.Widgets.Singles.Label
import qualified Monomer.Lens as L
type OptionButtonValue a = (Eq a, Typeable a)
data OptionButtonCfg s e a = OptionButtonCfg {
OptionButtonCfg s e a -> Maybe Bool
_obcIgnoreTheme :: Maybe Bool,
OptionButtonCfg s e a -> Maybe Style
_obcOffStyle :: Maybe Style,
OptionButtonCfg s e a -> LabelCfg s e
_obcLabelCfg :: LabelCfg s e,
OptionButtonCfg s e a -> [Path -> WidgetRequest s e]
_obcOnFocusReq :: [Path -> WidgetRequest s e],
OptionButtonCfg s e a -> [Path -> WidgetRequest s e]
_obcOnBlurReq :: [Path -> WidgetRequest s e],
OptionButtonCfg s e a -> [WidgetRequest s e]
_obcOnClickReq :: [WidgetRequest s e],
OptionButtonCfg s e a -> [a -> WidgetRequest s e]
_obcOnChangeReq :: [a -> WidgetRequest s e]
}
instance Default (OptionButtonCfg s e a) where
def :: OptionButtonCfg s e a
def = OptionButtonCfg :: forall s e a.
Maybe Bool
-> Maybe Style
-> LabelCfg s e
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [WidgetRequest s e]
-> [a -> WidgetRequest s e]
-> OptionButtonCfg s e a
OptionButtonCfg {
_obcIgnoreTheme :: Maybe Bool
_obcIgnoreTheme = Maybe Bool
forall a. Maybe a
Nothing,
_obcOffStyle :: Maybe Style
_obcOffStyle = Maybe Style
forall a. Maybe a
Nothing,
_obcLabelCfg :: LabelCfg s e
_obcLabelCfg = LabelCfg s e
forall a. Default a => a
def,
_obcOnFocusReq :: [Path -> WidgetRequest s e]
_obcOnFocusReq = [],
_obcOnBlurReq :: [Path -> WidgetRequest s e]
_obcOnBlurReq = [],
_obcOnClickReq :: [WidgetRequest s e]
_obcOnClickReq = [],
_obcOnChangeReq :: [a -> WidgetRequest s e]
_obcOnChangeReq = []
}
instance Semigroup (OptionButtonCfg s e a) where
<> :: OptionButtonCfg s e a
-> OptionButtonCfg s e a -> OptionButtonCfg s e a
(<>) OptionButtonCfg s e a
t1 OptionButtonCfg s e a
t2 = OptionButtonCfg :: forall s e a.
Maybe Bool
-> Maybe Style
-> LabelCfg s e
-> [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e]
-> [WidgetRequest s e]
-> [a -> WidgetRequest s e]
-> OptionButtonCfg s e a
OptionButtonCfg {
_obcIgnoreTheme :: Maybe Bool
_obcIgnoreTheme = OptionButtonCfg s e a -> Maybe Bool
forall s e a. OptionButtonCfg s e a -> Maybe Bool
_obcIgnoreTheme OptionButtonCfg s e a
t2 Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OptionButtonCfg s e a -> Maybe Bool
forall s e a. OptionButtonCfg s e a -> Maybe Bool
_obcIgnoreTheme OptionButtonCfg s e a
t1,
_obcOffStyle :: Maybe Style
_obcOffStyle = OptionButtonCfg s e a -> Maybe Style
forall s e a. OptionButtonCfg s e a -> Maybe Style
_obcOffStyle OptionButtonCfg s e a
t1 Maybe Style -> Maybe Style -> Maybe Style
forall a. Semigroup a => a -> a -> a
<> OptionButtonCfg s e a -> Maybe Style
forall s e a. OptionButtonCfg s e a -> Maybe Style
_obcOffStyle OptionButtonCfg s e a
t2,
_obcLabelCfg :: LabelCfg s e
_obcLabelCfg = OptionButtonCfg s e a -> LabelCfg s e
forall s e a. OptionButtonCfg s e a -> LabelCfg s e
_obcLabelCfg OptionButtonCfg s e a
t1 LabelCfg s e -> LabelCfg s e -> LabelCfg s e
forall a. Semigroup a => a -> a -> a
<> OptionButtonCfg s e a -> LabelCfg s e
forall s e a. OptionButtonCfg s e a -> LabelCfg s e
_obcLabelCfg OptionButtonCfg s e a
t2,
_obcOnFocusReq :: [Path -> WidgetRequest s e]
_obcOnFocusReq = OptionButtonCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. OptionButtonCfg s e a -> [Path -> WidgetRequest s e]
_obcOnFocusReq OptionButtonCfg s e a
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> OptionButtonCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. OptionButtonCfg s e a -> [Path -> WidgetRequest s e]
_obcOnFocusReq OptionButtonCfg s e a
t2,
_obcOnBlurReq :: [Path -> WidgetRequest s e]
_obcOnBlurReq = OptionButtonCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. OptionButtonCfg s e a -> [Path -> WidgetRequest s e]
_obcOnBlurReq OptionButtonCfg s e a
t1 [Path -> WidgetRequest s e]
-> [Path -> WidgetRequest s e] -> [Path -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> OptionButtonCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. OptionButtonCfg s e a -> [Path -> WidgetRequest s e]
_obcOnBlurReq OptionButtonCfg s e a
t2,
_obcOnClickReq :: [WidgetRequest s e]
_obcOnClickReq = OptionButtonCfg s e a -> [WidgetRequest s e]
forall s e a. OptionButtonCfg s e a -> [WidgetRequest s e]
_obcOnClickReq OptionButtonCfg s e a
t1 [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> OptionButtonCfg s e a -> [WidgetRequest s e]
forall s e a. OptionButtonCfg s e a -> [WidgetRequest s e]
_obcOnClickReq OptionButtonCfg s e a
t2,
_obcOnChangeReq :: [a -> WidgetRequest s e]
_obcOnChangeReq = OptionButtonCfg s e a -> [a -> WidgetRequest s e]
forall s e a. OptionButtonCfg s e a -> [a -> WidgetRequest s e]
_obcOnChangeReq OptionButtonCfg s e a
t1 [a -> WidgetRequest s e]
-> [a -> WidgetRequest s e] -> [a -> WidgetRequest s e]
forall a. Semigroup a => a -> a -> a
<> OptionButtonCfg s e a -> [a -> WidgetRequest s e]
forall s e a. OptionButtonCfg s e a -> [a -> WidgetRequest s e]
_obcOnChangeReq OptionButtonCfg s e a
t2
}
instance Monoid (OptionButtonCfg s e a) where
mempty :: OptionButtonCfg s e a
mempty = OptionButtonCfg s e a
forall a. Default a => a
def
instance CmbIgnoreTheme (OptionButtonCfg s e a) where
ignoreTheme_ :: Bool -> OptionButtonCfg s e a
ignoreTheme_ Bool
ignore = OptionButtonCfg s e a
forall a. Default a => a
def {
_obcIgnoreTheme :: Maybe Bool
_obcIgnoreTheme = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
ignore
}
instance CmbTrimSpaces (OptionButtonCfg s e a) where
trimSpaces_ :: Bool -> OptionButtonCfg s e a
trimSpaces_ Bool
trim = OptionButtonCfg s e a
forall a. Default a => a
def {
_obcLabelCfg :: LabelCfg s e
_obcLabelCfg = Bool -> LabelCfg s e
forall t. CmbTrimSpaces t => Bool -> t
trimSpaces_ Bool
trim
}
instance CmbEllipsis (OptionButtonCfg s e a) where
ellipsis_ :: Bool -> OptionButtonCfg s e a
ellipsis_ Bool
ellipsis = OptionButtonCfg s e a
forall a. Default a => a
def {
_obcLabelCfg :: LabelCfg s e
_obcLabelCfg = Bool -> LabelCfg s e
forall t. CmbEllipsis t => Bool -> t
ellipsis_ Bool
ellipsis
}
instance CmbMultiline (OptionButtonCfg s e a) where
multiline_ :: Bool -> OptionButtonCfg s e a
multiline_ Bool
multi = OptionButtonCfg s e a
forall a. Default a => a
def {
_obcLabelCfg :: LabelCfg s e
_obcLabelCfg = Bool -> LabelCfg s e
forall t. CmbMultiline t => Bool -> t
multiline_ Bool
multi
}
instance CmbMaxLines (OptionButtonCfg s e a) where
maxLines :: Int -> OptionButtonCfg s e a
maxLines Int
count = OptionButtonCfg s e a
forall a. Default a => a
def {
_obcLabelCfg :: LabelCfg s e
_obcLabelCfg = Int -> LabelCfg s e
forall t. CmbMaxLines t => Int -> t
maxLines Int
count
}
instance CmbResizeFactor (OptionButtonCfg s e a) where
resizeFactor :: Double -> OptionButtonCfg s e a
resizeFactor Double
s = OptionButtonCfg s e a
forall a. Default a => a
def {
_obcLabelCfg :: LabelCfg s e
_obcLabelCfg = Double -> LabelCfg s e
forall t. CmbResizeFactor t => Double -> t
resizeFactor Double
s
}
instance CmbResizeFactorDim (OptionButtonCfg s e a) where
resizeFactorW :: Double -> OptionButtonCfg s e a
resizeFactorW Double
w = OptionButtonCfg s e a
forall a. Default a => a
def {
_obcLabelCfg :: LabelCfg s e
_obcLabelCfg = Double -> LabelCfg s e
forall t. CmbResizeFactorDim t => Double -> t
resizeFactorW Double
w
}
resizeFactorH :: Double -> OptionButtonCfg s e a
resizeFactorH Double
h = OptionButtonCfg s e a
forall a. Default a => a
def {
_obcLabelCfg :: LabelCfg s e
_obcLabelCfg = Double -> LabelCfg s e
forall t. CmbResizeFactorDim t => Double -> t
resizeFactorH Double
h
}
instance WidgetEvent e => CmbOnFocus (OptionButtonCfg s e a) e Path where
onFocus :: (Path -> e) -> OptionButtonCfg s e a
onFocus Path -> e
fn = OptionButtonCfg s e a
forall a. Default a => a
def {
_obcOnFocusReq :: [Path -> WidgetRequest s e]
_obcOnFocusReq = [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 (OptionButtonCfg s e a) s e Path where
onFocusReq :: (Path -> WidgetRequest s e) -> OptionButtonCfg s e a
onFocusReq Path -> WidgetRequest s e
req = OptionButtonCfg s e a
forall a. Default a => a
def {
_obcOnFocusReq :: [Path -> WidgetRequest s e]
_obcOnFocusReq = [Path -> WidgetRequest s e
req]
}
instance WidgetEvent e => CmbOnBlur (OptionButtonCfg s e a) e Path where
onBlur :: (Path -> e) -> OptionButtonCfg s e a
onBlur Path -> e
fn = OptionButtonCfg s e a
forall a. Default a => a
def {
_obcOnBlurReq :: [Path -> WidgetRequest s e]
_obcOnBlurReq = [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 (OptionButtonCfg s e a) s e Path where
onBlurReq :: (Path -> WidgetRequest s e) -> OptionButtonCfg s e a
onBlurReq Path -> WidgetRequest s e
req = OptionButtonCfg s e a
forall a. Default a => a
def {
_obcOnBlurReq :: [Path -> WidgetRequest s e]
_obcOnBlurReq = [Path -> WidgetRequest s e
req]
}
instance WidgetEvent e => CmbOnClick (OptionButtonCfg s e a) e where
onClick :: e -> OptionButtonCfg s e a
onClick e
req = OptionButtonCfg s e a
forall a. Default a => a
def {
_obcOnClickReq :: [WidgetRequest s e]
_obcOnClickReq = [e -> WidgetRequest s e
forall s e. WidgetEvent e => e -> WidgetRequest s e
RaiseEvent e
req]
}
instance CmbOnClickReq (OptionButtonCfg s e a) s e where
onClickReq :: WidgetRequest s e -> OptionButtonCfg s e a
onClickReq WidgetRequest s e
req = OptionButtonCfg s e a
forall a. Default a => a
def {
_obcOnClickReq :: [WidgetRequest s e]
_obcOnClickReq = [WidgetRequest s e
req]
}
instance WidgetEvent e => CmbOnChange (OptionButtonCfg s e a) a e where
onChange :: (a -> e) -> OptionButtonCfg s e a
onChange a -> e
fn = OptionButtonCfg s e Any
forall a. Default a => a
def {
_obcOnChangeReq :: [a -> WidgetRequest s e]
_obcOnChangeReq = [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 (OptionButtonCfg s e a) s e a where
onChangeReq :: (a -> WidgetRequest s e) -> OptionButtonCfg s e a
onChangeReq a -> WidgetRequest s e
req = OptionButtonCfg s e Any
forall a. Default a => a
def {
_obcOnChangeReq :: [a -> WidgetRequest s e]
_obcOnChangeReq = [a -> WidgetRequest s e
req]
}
optionButtonOffStyle :: Style -> OptionButtonCfg s e a
optionButtonOffStyle :: Style -> OptionButtonCfg s e a
optionButtonOffStyle Style
style = OptionButtonCfg s e a
forall a. Default a => a
def {
_obcOffStyle :: Maybe Style
_obcOffStyle = Style -> Maybe Style
forall a. a -> Maybe a
Just Style
style
}
optionButton
:: OptionButtonValue a
=> Text
-> a
-> ALens' s a
-> WidgetNode s e
optionButton :: Text -> a -> ALens' s a -> WidgetNode s e
optionButton Text
caption a
option ALens' s a
field = Text
-> a -> ALens' s a -> [OptionButtonCfg s e a] -> WidgetNode s e
forall a s e.
OptionButtonValue a =>
Text
-> a -> ALens' s a -> [OptionButtonCfg s e a] -> WidgetNode s e
optionButton_ Text
caption a
option ALens' s a
field [OptionButtonCfg s e a]
forall a. Default a => a
def
optionButton_
:: OptionButtonValue a
=> Text
-> a
-> ALens' s a
-> [OptionButtonCfg s e a]
-> WidgetNode s e
optionButton_ :: Text
-> a -> ALens' s a -> [OptionButtonCfg s e a] -> WidgetNode s e
optionButton_ Text
caption a
option ALens' s a
field [OptionButtonCfg s e a]
cfgs = WidgetNode s e
newNode where
newNode :: WidgetNode s e
newNode = Text
-> a -> WidgetData s a -> [OptionButtonCfg s e a] -> WidgetNode s e
forall a s e.
OptionButtonValue a =>
Text
-> a -> WidgetData s a -> [OptionButtonCfg s e a] -> WidgetNode s e
optionButtonD_ Text
caption a
option (ALens' s a -> WidgetData s a
forall s a. ALens' s a -> WidgetData s a
WidgetLens ALens' s a
field) [OptionButtonCfg s e a]
cfgs
optionButtonV
:: (OptionButtonValue a, WidgetEvent e)
=> Text
-> a
-> a
-> (a -> e)
-> WidgetNode s e
optionButtonV :: Text -> a -> a -> (a -> e) -> WidgetNode s e
optionButtonV Text
caption a
option a
value a -> e
handler = WidgetNode s e
forall s. WidgetNode s e
newNode where
newNode :: WidgetNode s e
newNode = Text
-> a -> a -> (a -> e) -> [OptionButtonCfg s e a] -> WidgetNode s e
forall a e s.
(OptionButtonValue a, WidgetEvent e) =>
Text
-> a -> a -> (a -> e) -> [OptionButtonCfg s e a] -> WidgetNode s e
optionButtonV_ Text
caption a
option a
value a -> e
handler [OptionButtonCfg s e a]
forall a. Default a => a
def
optionButtonV_
:: (OptionButtonValue a, WidgetEvent e)
=> Text
-> a
-> a
-> (a -> e)
-> [OptionButtonCfg s e a]
-> WidgetNode s e
optionButtonV_ :: Text
-> a -> a -> (a -> e) -> [OptionButtonCfg s e a] -> WidgetNode s e
optionButtonV_ Text
caption a
option a
value a -> e
handler [OptionButtonCfg s e a]
configs = WidgetNode s e
newNode where
widgetData :: WidgetData s a
widgetData = a -> WidgetData s a
forall s a. a -> WidgetData s a
WidgetValue a
value
newConfigs :: [OptionButtonCfg s e a]
newConfigs = (a -> e) -> OptionButtonCfg s e a
forall t a e. CmbOnChange t a e => (a -> e) -> t
onChange a -> e
handler OptionButtonCfg s e a
-> [OptionButtonCfg s e a] -> [OptionButtonCfg s e a]
forall a. a -> [a] -> [a]
: [OptionButtonCfg s e a]
configs
newNode :: WidgetNode s e
newNode = Text
-> a -> WidgetData s a -> [OptionButtonCfg s e a] -> WidgetNode s e
forall a s e.
OptionButtonValue a =>
Text
-> a -> WidgetData s a -> [OptionButtonCfg s e a] -> WidgetNode s e
optionButtonD_ Text
caption a
option WidgetData s a
forall s. WidgetData s a
widgetData [OptionButtonCfg s e a]
newConfigs
optionButtonD_
:: OptionButtonValue a
=> Text
-> a
-> WidgetData s a
-> [OptionButtonCfg s e a]
-> WidgetNode s e
optionButtonD_ :: Text
-> a -> WidgetData s a -> [OptionButtonCfg s e a] -> WidgetNode s e
optionButtonD_ Text
caption a
option WidgetData s a
widgetData [OptionButtonCfg s e a]
configs = WidgetNode s e
optionButtonNode where
config :: OptionButtonCfg s e a
config = [OptionButtonCfg s e a] -> OptionButtonCfg s e a
forall a. Monoid a => [a] -> a
mconcat [OptionButtonCfg s e a]
configs
makeWithStyle :: WidgetData s a
-> Text
-> (a -> Bool)
-> (a -> a)
-> OptionButtonCfg s e a
-> Widget s e
makeWithStyle = Lens' ThemeState StyleState
-> Lens' ThemeState StyleState
-> WidgetData s a
-> Text
-> (a -> Bool)
-> (a -> a)
-> OptionButtonCfg s e a
-> Widget s e
forall a s e.
OptionButtonValue a =>
Lens' ThemeState StyleState
-> Lens' ThemeState StyleState
-> WidgetData s a
-> Text
-> (a -> Bool)
-> (a -> a)
-> OptionButtonCfg s e a
-> Widget s e
makeOptionButton forall s a. HasOptionBtnOnStyle s a => Lens' s a
Lens' ThemeState StyleState
L.optionBtnOnStyle forall s a. HasOptionBtnOffStyle s a => Lens' s a
Lens' ThemeState StyleState
L.optionBtnOffStyle
wtype :: WidgetType
wtype = Text -> WidgetType
WidgetType (Text
"optionButton-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
forall a. TextShow a => a -> Text
showt (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
option))
widget :: Widget s e
widget = WidgetData s a
-> Text
-> (a -> Bool)
-> (a -> a)
-> OptionButtonCfg s e a
-> Widget s e
forall s e.
WidgetData s a
-> Text
-> (a -> Bool)
-> (a -> a)
-> OptionButtonCfg s e a
-> Widget s e
makeWithStyle WidgetData s a
widgetData Text
caption (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
option) (a -> a -> a
forall a b. a -> b -> a
const a
option) OptionButtonCfg s e a
config
optionButtonNode :: WidgetNode s e
optionButtonNode = WidgetType -> Widget s e -> WidgetNode s e
forall s e. WidgetType -> Widget s e -> WidgetNode s e
defaultWidgetNode WidgetType
wtype 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
makeOptionButton
:: OptionButtonValue a
=> Lens' ThemeState StyleState
-> Lens' ThemeState StyleState
-> WidgetData s a
-> Text
-> (a -> Bool)
-> (a -> a)
-> OptionButtonCfg s e a
-> Widget s e
makeOptionButton :: Lens' ThemeState StyleState
-> Lens' ThemeState StyleState
-> WidgetData s a
-> Text
-> (a -> Bool)
-> (a -> a)
-> OptionButtonCfg s e a
-> Widget s e
makeOptionButton Lens' ThemeState StyleState
styleOn Lens' ThemeState StyleState
styleOff !WidgetData s a
field !Text
caption !a -> Bool
isSelVal !a -> a
getNextVal !OptionButtonCfg s e a
config = Widget s e
widget where
widget :: Widget s e
widget = () -> Container s e () -> Widget s e
forall a s e. WidgetModel a => a -> Container s e a -> Widget s e
createContainer () Container s e ()
forall a. Default a => a
def {
containerAddStyleReq :: Bool
containerAddStyleReq = Bool
False,
containerDrawDecorations :: Bool
containerDrawDecorations = Bool
False,
containerUseScissor :: Bool
containerUseScissor = Bool
True,
containerInit :: ContainerInitHandler s e
containerInit = ContainerInitHandler s e
forall e. WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
init,
containerMerge :: ContainerMergeHandler s e ()
containerMerge = ContainerMergeHandler s e ()
forall e p p.
WidgetEnv s e -> WidgetNode s e -> p -> p -> WidgetResult s e
merge,
containerHandleEvent :: ContainerEventHandler s e
containerHandleEvent = ContainerEventHandler s e
forall p.
WidgetEnv s e
-> WidgetNode s e -> p -> SystemEvent -> Maybe (WidgetResult s e)
handleEvent,
containerResize :: ContainerResizeHandler s e
containerResize = ContainerResizeHandler s e
forall p s e a p.
p -> WidgetNode s e -> a -> p -> (WidgetResult s e, Seq a)
resize
}
createChildNode :: WidgetEnv s e -> b -> b
createChildNode WidgetEnv s e
wenv b
node = b
newNode where
currValue :: a
currValue = s -> WidgetData s a -> a
forall s a. s -> WidgetData s a -> a
widgetDataGet (WidgetEnv s e
wenv WidgetEnv s e -> Getting s (WidgetEnv s e) s -> s
forall s a. s -> Getting a s a -> a
^. Getting s (WidgetEnv s e) s
forall s a. HasModel s a => Lens' s a
L.model) WidgetData s a
field
isSelected :: Bool
isSelected = a -> Bool
isSelVal a
currValue
useBaseTheme :: Bool
useBaseTheme = OptionButtonCfg s e a -> Maybe Bool
forall s e a. OptionButtonCfg s e a -> Maybe Bool
_obcIgnoreTheme OptionButtonCfg s e a
config Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
baseOffStyle :: Maybe Style
baseOffStyle
| Bool
useBaseTheme = Style -> Maybe Style
forall a. a -> Maybe a
Just (WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv Lens' ThemeState StyleState
styleOff)
| Bool
otherwise = Maybe Style
forall a. Maybe a
Nothing
baseOnStyle :: Maybe Style
baseOnStyle
| Bool
useBaseTheme = Style -> Maybe Style
forall a. a -> Maybe a
Just (WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv Lens' ThemeState StyleState
styleOn)
| Bool
otherwise = Maybe Style
forall a. Maybe a
Nothing
nodeStyle :: Style
nodeStyle = b
node b -> Getting Style b Style -> Style
forall s a. s -> Getting a s a -> a
^. (a -> Const Style a) -> b -> Const Style b
forall s a. HasInfo s a => Lens' s a
L.info ((a -> Const Style a) -> b -> Const Style b)
-> ((Style -> Const Style Style) -> a -> Const Style a)
-> Getting Style b Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Const Style Style) -> a -> Const Style a
forall s a. HasStyle s a => Lens' s a
L.style
colorlessStyle :: Style
colorlessStyle = (StyleState -> StyleState) -> Style -> Style
mapStyleStates StyleState -> StyleState
resetColor Style
nodeStyle
customOffStyle :: Maybe Style
customOffStyle = Style -> Style
mergeBasicStyle (Style -> Style) -> Maybe Style -> Maybe Style
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OptionButtonCfg s e a -> Maybe Style
forall s e a. OptionButtonCfg s e a -> Maybe Style
_obcOffStyle OptionButtonCfg s e a
config
labelNodeStyle :: Style
labelNodeStyle
| Bool
isSelected = Maybe Style -> Style
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Style
baseOnStyle Maybe Style -> Maybe Style -> Maybe Style
forall a. Semigroup a => a -> a -> a
<> Style -> Maybe Style
forall a. a -> Maybe a
Just Style
nodeStyle)
| Bool
otherwise = Maybe Style -> Style
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Style
baseOffStyle Maybe Style -> Maybe Style -> Maybe Style
forall a. Semigroup a => a -> a -> a
<> Style -> Maybe Style
forall a. a -> Maybe a
Just Style
colorlessStyle Maybe Style -> Maybe Style -> Maybe Style
forall a. Semigroup a => a -> a -> a
<> Maybe Style
customOffStyle)
labelCfg :: LabelCfg s e
labelCfg = OptionButtonCfg s e a -> LabelCfg s e
forall s e a. OptionButtonCfg s e a -> LabelCfg s e
_obcLabelCfg OptionButtonCfg s e a
config
labelCurrStyle :: LabelCfg s e
labelCurrStyle = (WidgetEnv s e -> WidgetNode s e -> StyleState) -> LabelCfg s e
forall s e.
(WidgetEnv s e -> WidgetNode s e -> StyleState) -> LabelCfg s e
labelCurrentStyle WidgetEnv s e -> WidgetNode s e -> StyleState
forall s e. WidgetEnv s e -> WidgetNode s e -> StyleState
childOfFocusedStyle
labelNode :: WidgetNode s e
labelNode = Text -> [LabelCfg s e] -> WidgetNode s e
forall s e. Text -> [LabelCfg s e] -> WidgetNode s e
label_ Text
caption [LabelCfg s e
forall t. CmbIgnoreTheme t => t
ignoreTheme, LabelCfg s e
labelCfg, LabelCfg s e
forall s e. LabelCfg s e
labelCurrStyle]
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
labelNodeStyle
!newNode :: b
newNode = b
node
b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& (Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> b -> Identity b
forall s a. HasChildren s a => Lens' s a
L.children ((Seq (WidgetNode s e) -> Identity (Seq (WidgetNode s e)))
-> b -> Identity b)
-> Seq (WidgetNode s e) -> b -> b
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.singleton WidgetNode s e
labelNode
init :: WidgetEnv s e -> WidgetNode s e -> WidgetResult s e
init WidgetEnv s e
wenv WidgetNode s e
node = 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 (WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
forall b a e.
(HasInfo b a, HasStyle a Style,
HasChildren b (Seq (WidgetNode s e))) =>
WidgetEnv s e -> b -> b
createChildNode WidgetEnv s e
wenv WidgetNode s e
node)
merge :: WidgetEnv s e -> WidgetNode s e -> p -> p -> WidgetResult s e
merge WidgetEnv s e
wenv WidgetNode s e
node p
oldNode p
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 (WidgetEnv s e -> WidgetNode s e -> WidgetNode s e
forall b a e.
(HasInfo b a, HasStyle a Style,
HasChildren b (Seq (WidgetNode s e))) =>
WidgetEnv s e -> b -> b
createChildNode WidgetEnv s e
wenv WidgetNode s e
node)
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 -> 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 (OptionButtonCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. OptionButtonCfg s e a -> [Path -> WidgetRequest s e]
_obcOnFocusReq OptionButtonCfg s e a
config)
Blur Path
next -> 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
next (OptionButtonCfg s e a -> [Path -> WidgetRequest s e]
forall s e a. OptionButtonCfg s e a -> [Path -> WidgetRequest s e]
_obcOnBlurReq OptionButtonCfg s e a
config)
KeyAction KeyMod
mode KeyCode
code KeyStatus
status
| KeyCode -> Bool
isSelectKey KeyCode
code Bool -> Bool -> Bool
&& KeyStatus
status KeyStatus -> KeyStatus -> Bool
forall a. Eq a => a -> a -> Bool
== KeyStatus
KeyPressed -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result
where
isSelectKey :: KeyCode -> Bool
isSelectKey KeyCode
code = KeyCode -> Bool
isKeyReturn KeyCode
code Bool -> Bool -> Bool
|| KeyCode -> Bool
isKeySpace KeyCode
code
Click Point
p Button
_ Int
_
| WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
node Point
p -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
result
ButtonAction Point
p Button
btn ButtonState
BtnPressed Int
1
| Button -> Bool
forall a. (Eq a, HasMainButton (WidgetEnv s e) a) => a -> Bool
mainBtn Button
btn Bool -> Bool -> Bool
&& Point -> Bool
pointInVp Point
p Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
focused -> WidgetResult s e -> Maybe (WidgetResult s e)
forall a. a -> Maybe a
Just WidgetResult s e
resultFocus
SystemEvent
_ -> Maybe (WidgetResult s e)
forall a. Maybe a
Nothing
where
mainBtn :: a -> Bool
mainBtn a
btn = a
btn a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== WidgetEnv s e
wenv WidgetEnv s e -> Getting a (WidgetEnv s e) a -> a
forall s a. s -> Getting a s a -> a
^. Getting a (WidgetEnv s e) a
forall s a. HasMainButton s a => Lens' s a
L.mainButton
focused :: Bool
focused = WidgetEnv s e -> WidgetNode s e -> Bool
forall s e. WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused WidgetEnv s e
wenv WidgetNode s e
node
pointInVp :: Point -> Bool
pointInVp Point
p = WidgetNode s e -> Point -> Bool
forall s e. WidgetNode s e -> Point -> Bool
isPointInNodeVp WidgetNode s e
node Point
p
currValue :: a
currValue = s -> WidgetData s a -> a
forall s a. s -> WidgetData s a -> a
widgetDataGet (WidgetEnv s e
wenv WidgetEnv s e -> Getting s (WidgetEnv s e) s -> s
forall s a. s -> Getting a s a -> a
^. Getting s (WidgetEnv s e) s
forall s a. HasModel s a => Lens' s a
L.model) WidgetData s a
field
nextValue :: a
nextValue = a -> a
getNextVal a
currValue
setValueReq :: [WidgetRequest s e]
setValueReq = WidgetData s a -> a -> [WidgetRequest s e]
forall s a e. WidgetData s a -> a -> [WidgetRequest s e]
widgetDataSet WidgetData s a
field a
nextValue
clickReqs :: [WidgetRequest s e]
clickReqs = OptionButtonCfg s e a -> [WidgetRequest s e]
forall s e a. OptionButtonCfg s e a -> [WidgetRequest s e]
_obcOnClickReq OptionButtonCfg s e a
config
changeReqs :: [WidgetRequest s e]
changeReqs
| a
currValue a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
nextValue = ((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
nextValue) (OptionButtonCfg s e a -> [a -> WidgetRequest s e]
forall s e a. OptionButtonCfg s e a -> [a -> WidgetRequest s e]
_obcOnChangeReq OptionButtonCfg s e a
config)
| Bool
otherwise = []
reqs :: [WidgetRequest s e]
reqs = [WidgetRequest s e]
forall e. [WidgetRequest s e]
setValueReq [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
clickReqs [WidgetRequest s e] -> [WidgetRequest s e] -> [WidgetRequest s e]
forall a. [a] -> [a] -> [a]
++ [WidgetRequest s e]
changeReqs
result :: WidgetResult s e
result = WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
forall s e.
WidgetNode s e -> [WidgetRequest s e] -> WidgetResult s e
resultReqs WidgetNode s e
node [WidgetRequest s e]
reqs
resultFocus :: WidgetResult s e
resultFocus = 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)]
resize :: p -> WidgetNode s e -> a -> p -> (WidgetResult s e, Seq a)
resize p
wenv WidgetNode s e
node a
viewport p
children = (WidgetResult s e, Seq a)
resized where
assignedAreas :: Seq a
assignedAreas = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList [a
viewport]
resized :: (WidgetResult s e, Seq a)
resized = (WidgetNode s e -> WidgetResult s e
forall s e. WidgetNode s e -> WidgetResult s e
resultNode WidgetNode s e
node, Seq a
assignedAreas)
resetColor :: StyleState -> StyleState
resetColor :: StyleState -> StyleState
resetColor StyleState
st = StyleState
st
StyleState -> (StyleState -> StyleState) -> StyleState
forall a b. a -> (a -> b) -> b
& (Maybe Color -> Identity (Maybe Color))
-> StyleState -> Identity StyleState
forall s a. HasBgColor s a => Lens' s a
L.bgColor ((Maybe Color -> Identity (Maybe Color))
-> StyleState -> Identity StyleState)
-> Maybe Color -> StyleState -> StyleState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Color
forall a. Maybe a
Nothing
StyleState -> (StyleState -> StyleState) -> StyleState
forall a b. a -> (a -> b) -> b
& (Maybe Color -> Identity (Maybe Color))
-> StyleState -> Identity StyleState
forall s a. HasFgColor s a => Lens' s a
L.fgColor ((Maybe Color -> Identity (Maybe Color))
-> StyleState -> Identity StyleState)
-> Maybe Color -> StyleState -> StyleState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Color
forall a. Maybe a
Nothing
StyleState -> (StyleState -> StyleState) -> StyleState
forall a b. a -> (a -> b) -> b
& (Maybe TextStyle -> Identity (Maybe TextStyle))
-> StyleState -> Identity StyleState
forall s a. HasText s a => Lens' s a
L.text ((Maybe TextStyle -> Identity (Maybe TextStyle))
-> StyleState -> Identity StyleState)
-> ((Maybe Color -> Identity (Maybe Color))
-> Maybe TextStyle -> Identity (Maybe TextStyle))
-> (Maybe Color -> Identity (Maybe Color))
-> StyleState
-> Identity StyleState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextStyle -> Identity TextStyle)
-> Maybe TextStyle -> Identity (Maybe TextStyle)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((TextStyle -> Identity TextStyle)
-> Maybe TextStyle -> Identity (Maybe TextStyle))
-> ((Maybe Color -> Identity (Maybe Color))
-> TextStyle -> Identity TextStyle)
-> (Maybe Color -> Identity (Maybe Color))
-> Maybe TextStyle
-> Identity (Maybe TextStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Color -> Identity (Maybe Color))
-> TextStyle -> Identity TextStyle
forall s a. HasFontColor s a => Lens' s a
L.fontColor ((Maybe Color -> Identity (Maybe Color))
-> StyleState -> Identity StyleState)
-> Maybe Color -> StyleState -> StyleState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Color
forall a. Maybe a
Nothing