mirror of
https://github.com/fjvallarino/monomer.git
synced 2024-11-10 01:15:49 +03:00
Add onVisibleChange and onEnableChange to composite. Also add onInit, to replace the previous Maybe parameter. Update alert/confirm
This commit is contained in:
Francisco Vallarino
parent
e625e02830
commit
95bf96174b
@ -54,7 +54,7 @@ initialState = KeysCompState {
|
||||
}
|
||||
|
||||
keysComposite :: WidgetNode KeysCompState ep
|
||||
keysComposite = composite "keysComposite" id Nothing buildKeysComp handleKeysCompEvent
|
||||
keysComposite = composite "keysComposite" id buildKeysComp handleKeysCompEvent
|
||||
|
||||
handleKeysCompEvent wenv model evt = case evt of
|
||||
RotateChildren -> [Model (model & items %~ rotateSeq)]
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module TestComposite (testComposite) where
|
||||
module TestComposite (testComp) where
|
||||
|
||||
import Debug.Trace
|
||||
|
||||
@ -35,7 +35,7 @@ instance Default CompState where
|
||||
makeLenses ''CompState
|
||||
|
||||
data CompEvent
|
||||
= InitComposite
|
||||
= InitComp
|
||||
| MessageParent
|
||||
| CallSandbox
|
||||
| StartTask
|
||||
@ -43,11 +43,11 @@ data CompEvent
|
||||
| HandleProducer Int
|
||||
deriving (Eq, Show)
|
||||
|
||||
testComposite :: WidgetNode CompState AppEvent
|
||||
testComposite = composite "testComposite" id (Just InitComposite) buildComposite handleCompositeEvent
|
||||
testComp :: WidgetNode CompState AppEvent
|
||||
testComp = composite_ "testComp" id buildComp handleCompEvt [onInit InitComp]
|
||||
|
||||
handleCompositeEvent wenv model evt = case evt of
|
||||
InitComposite -> [Task $ do
|
||||
handleCompEvt wenv model evt = case evt of
|
||||
InitComp -> [Task $ do
|
||||
threadDelay 1000
|
||||
putStrLn "Initialized composite"
|
||||
return Nothing]
|
||||
@ -62,7 +62,7 @@ handleCompositeEvent wenv model evt = case evt of
|
||||
threadDelay $ 1000 * 1000]
|
||||
HandleProducer val -> [Model $ model & csProduced %~ (+val)]
|
||||
|
||||
buildComposite wenv model = trace "Created composite UI" $
|
||||
buildComp wenv model = trace "Created composite UI" $
|
||||
vgrid [
|
||||
scroll $ label "This is a composite label!",
|
||||
scroll $ label "This is a composite label again!",
|
||||
|
||||
@ -96,6 +96,9 @@ class CmbTextBottom t where
|
||||
textBottom :: t
|
||||
|
||||
-- Events
|
||||
class CmbOnInit t e | t -> e where
|
||||
onInit :: e -> t
|
||||
|
||||
class CmbOnFocus t e | t -> e where
|
||||
onFocus :: e -> t
|
||||
|
||||
@ -120,6 +123,12 @@ class CmbOnClickEmpty t e | t -> e where
|
||||
class CmbOnClickEmptyReq t s | t -> s where
|
||||
onClickEmptyReq :: WidgetRequest s -> t
|
||||
|
||||
class CmbOnEnabledChange t e | t -> e where
|
||||
onEnabledChange :: e -> t
|
||||
|
||||
class CmbOnVisibleChange t e | t -> e where
|
||||
onVisibleChange :: e -> t
|
||||
|
||||
class CmbOnChange t a e | t -> e where
|
||||
onChange :: (a -> e) -> t
|
||||
|
||||
|
||||
@ -1,4 +1,3 @@
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
@ -30,6 +29,7 @@ import qualified SDL
|
||||
import qualified Data.Sequence as Seq
|
||||
|
||||
import Monomer.Core
|
||||
import Monomer.Core.Combinators
|
||||
import Monomer.Event
|
||||
import Monomer.Lens
|
||||
import Monomer.Main.Handlers
|
||||
@ -55,7 +55,7 @@ data MainLoopArgs s e ep = MainLoopArgs {
|
||||
_mlFrameStartTs :: Int,
|
||||
_mlFrameAccumTs :: Int,
|
||||
_mlFrameCount :: Int,
|
||||
_mlExitEvent :: Maybe e,
|
||||
_mlExitEvents :: [e],
|
||||
_mlWidgetRoot :: WidgetNode s ep
|
||||
}
|
||||
|
||||
@ -86,8 +86,8 @@ simpleApp_ model eventHandler uiBuilder configs = do
|
||||
where
|
||||
config = mconcat configs
|
||||
useHdpi = fromMaybe defaultUseHdpi (_apcHdpi config)
|
||||
initEvent = _apcInitEvent config
|
||||
appWidget = composite "app" id initEvent uiBuilder eventHandler
|
||||
compCfgs = onInit <$> _apcInitEvent config
|
||||
appWidget = composite_ "app" id uiBuilder eventHandler compCfgs
|
||||
|
||||
runApp
|
||||
:: (MonomerM s m, WidgetEvent e)
|
||||
@ -105,7 +105,7 @@ runApp window widgetRoot config = do
|
||||
let maxFps = fromMaybe 30 (_apcMaxFps config)
|
||||
let fonts = _apcFonts config
|
||||
let theme = fromMaybe def (_apcTheme config)
|
||||
let exitEvent = _apcExitEvent config
|
||||
let exitEvents = _apcExitEvent config
|
||||
let mainBtn = fromMaybe LeftBtn (_apcMainButton config)
|
||||
|
||||
L.windowSize .= newWindowSize
|
||||
@ -154,7 +154,7 @@ runApp window widgetRoot config = do
|
||||
_mlFrameStartTs = startTs,
|
||||
_mlFrameAccumTs = 0,
|
||||
_mlFrameCount = 0,
|
||||
_mlExitEvent = exitEvent,
|
||||
_mlExitEvents = exitEvents,
|
||||
_mlWidgetRoot = resizedRoot
|
||||
}
|
||||
|
||||
@ -214,8 +214,10 @@ mainLoop window renderer config loopArgs = do
|
||||
}
|
||||
-- Exit handler
|
||||
let quit = SDL.QuitEvent `elem` eventsPayload
|
||||
let exitMsg = SendMessage (Seq.fromList [0]) _mlExitEvent
|
||||
let baseReqs = Seq.fromList [ exitMsg | quit ]
|
||||
let exitMsgs = SendMessage (Seq.fromList [0]) <$> _mlExitEvents
|
||||
let baseReqs
|
||||
| quit = Seq.fromList exitMsgs
|
||||
| otherwise = Seq.Empty
|
||||
let baseStep = (wenv, Seq.empty, _mlWidgetRoot)
|
||||
|
||||
-- when newSecond $
|
||||
|
||||
@ -105,8 +105,8 @@ data AppConfig e = AppConfig {
|
||||
_apcMaxFps :: Maybe Int,
|
||||
_apcFonts :: [FontDef],
|
||||
_apcTheme :: Maybe Theme,
|
||||
_apcInitEvent :: Maybe e,
|
||||
_apcExitEvent :: Maybe e,
|
||||
_apcInitEvent :: [e],
|
||||
_apcExitEvent :: [e],
|
||||
_apcMainButton :: Maybe Button,
|
||||
_apcStateFileMain :: Maybe String
|
||||
}
|
||||
@ -121,8 +121,8 @@ instance Default (AppConfig e) where
|
||||
_apcMaxFps = Nothing,
|
||||
_apcFonts = [],
|
||||
_apcTheme = Nothing,
|
||||
_apcInitEvent = Nothing,
|
||||
_apcExitEvent = Nothing,
|
||||
_apcInitEvent = [],
|
||||
_apcExitEvent = [],
|
||||
_apcMainButton = Nothing,
|
||||
_apcStateFileMain = Nothing
|
||||
}
|
||||
@ -137,8 +137,8 @@ instance Semigroup (AppConfig e) where
|
||||
_apcMaxFps = _apcMaxFps a2 <|> _apcMaxFps a1,
|
||||
_apcFonts = _apcFonts a1 ++ _apcFonts a2,
|
||||
_apcTheme = _apcTheme a2 <|> _apcTheme a1,
|
||||
_apcInitEvent = _apcInitEvent a2 <|> _apcInitEvent a1,
|
||||
_apcExitEvent = _apcExitEvent a2 <|> _apcExitEvent a1,
|
||||
_apcInitEvent = _apcInitEvent a1 ++ _apcInitEvent a2,
|
||||
_apcExitEvent = _apcExitEvent a1 ++ _apcExitEvent a2,
|
||||
_apcMainButton = _apcMainButton a2 <|> _apcMainButton a1,
|
||||
_apcStateFileMain = _apcStateFileMain a2 <|> _apcStateFileMain a1
|
||||
}
|
||||
@ -187,13 +187,13 @@ appTheme t = def {
|
||||
}
|
||||
|
||||
appInitEvent :: e -> AppConfig e
|
||||
appInitEvent e = def {
|
||||
_apcInitEvent = Just e
|
||||
appInitEvent evt = def {
|
||||
_apcInitEvent = [evt]
|
||||
}
|
||||
|
||||
appExitEvent :: e -> AppConfig e
|
||||
appExitEvent e = def {
|
||||
_apcExitEvent = Just e
|
||||
appExitEvent evt = def {
|
||||
_apcExitEvent = [evt]
|
||||
}
|
||||
|
||||
appMainButton :: Button -> AppConfig e
|
||||
|
||||
@ -46,35 +46,61 @@ instance CmbCloseCaption AlertCfg where
|
||||
_alcClose = Just t
|
||||
}
|
||||
|
||||
alert :: (WidgetModel s, WidgetEvent e) => Text -> e -> WidgetNode s e
|
||||
data AlertEvt e
|
||||
= ParentEvt e
|
||||
| VisibleChanged
|
||||
deriving (Eq, Show)
|
||||
|
||||
alert
|
||||
:: (WidgetModel sp, WidgetEvent ep)
|
||||
=> Text
|
||||
-> ep
|
||||
-> WidgetNode sp ep
|
||||
alert message evt = alert_ message evt def
|
||||
|
||||
alert_
|
||||
:: (WidgetModel s, WidgetEvent e) => Text -> e -> [AlertCfg] -> WidgetNode s e
|
||||
:: (WidgetModel sp, WidgetEvent ep)
|
||||
=> Text
|
||||
-> ep
|
||||
-> [AlertCfg]
|
||||
-> WidgetNode sp ep
|
||||
alert_ message evt configs = newNode where
|
||||
config = mconcat configs
|
||||
createUI = buildUI message evt config
|
||||
newNode = compositeExt "alert" () Nothing createUI handleEvent
|
||||
newNode = compositeExt "alert" () createUI handleEvent
|
||||
|
||||
buildUI :: Text -> e -> AlertCfg -> WidgetEnv s e -> s -> WidgetNode s e
|
||||
buildUI message evt config wenv model = alertBox where
|
||||
buildUI
|
||||
:: Text
|
||||
-> ep
|
||||
-> AlertCfg
|
||||
-> WidgetEnv s (AlertEvt ep)
|
||||
-> s
|
||||
-> WidgetNode s (AlertEvt ep)
|
||||
buildUI message pCancelEvt config wenv model = alertBox where
|
||||
cancelEvt = ParentEvt pCancelEvt
|
||||
title = fromMaybe "" (_alcTitle config)
|
||||
close = fromMaybe "Close" (_alcClose config)
|
||||
emptyOverlayColor = themeEmptyOverlayColor wenv
|
||||
dismissButton = mainButton close evt
|
||||
dismissButton = mainButton close cancelEvt
|
||||
closeIcon = icon IconClose & L.info . L.style .~ themeDialogCloseIcon wenv
|
||||
alertTree = vstack [
|
||||
hstack [
|
||||
label title & L.info . L.style .~ themeDialogTitle wenv,
|
||||
box_ closeIcon [onClick evt]
|
||||
box_ closeIcon [onClick cancelEvt]
|
||||
],
|
||||
label_ message [textMultiLine]
|
||||
& L.info . L.style .~ themeDialogBody wenv,
|
||||
box_ dismissButton [alignLeft]
|
||||
& L.info . L.style .~ themeDialogButtons wenv
|
||||
] & L.info . L.style .~ themeDialogFrame wenv
|
||||
alertBox = box_ alertTree [onClickEmpty evt]
|
||||
alertBox = box_ alertTree [onClickEmpty cancelEvt]
|
||||
& L.info . L.style .~ emptyOverlayColor
|
||||
|
||||
handleEvent :: WidgetEnv s e -> s -> e -> [EventResponse s e e]
|
||||
handleEvent wenv model evt = [Report evt]
|
||||
handleEvent
|
||||
:: WidgetEnv s (AlertEvt ep)
|
||||
-> s
|
||||
-> AlertEvt ep
|
||||
-> [EventResponse s e ep]
|
||||
handleEvent wenv model evt = case evt of
|
||||
ParentEvt pevt -> [Report pevt]
|
||||
VisibleChanged -> []
|
||||
|
||||
@ -65,52 +65,78 @@ data EventResponse s e ep
|
||||
| Task (TaskHandler e)
|
||||
| Producer (ProducerHandler e)
|
||||
|
||||
data CompositeCfg s ep sp = CompositeCfg {
|
||||
data CompositeCfg s e sp ep = CompositeCfg {
|
||||
_cmcMergeRequired :: Maybe (MergeRequired s),
|
||||
_cmcOnInit :: [e],
|
||||
_cmcOnChange :: [s -> ep],
|
||||
_cmcOnChangeReq :: [WidgetRequest sp]
|
||||
_cmcOnChangeReq :: [WidgetRequest sp],
|
||||
_cmcOnEnabledChange :: [e],
|
||||
_cmcOnVisibleChange :: [e]
|
||||
}
|
||||
|
||||
instance Default (CompositeCfg s ep sp) where
|
||||
instance Default (CompositeCfg s e sp ep) where
|
||||
def = CompositeCfg {
|
||||
_cmcMergeRequired = Nothing,
|
||||
_cmcOnInit = [],
|
||||
_cmcOnChange = [],
|
||||
_cmcOnChangeReq = []
|
||||
_cmcOnChangeReq = [],
|
||||
_cmcOnEnabledChange = [],
|
||||
_cmcOnVisibleChange = []
|
||||
}
|
||||
|
||||
instance Semigroup (CompositeCfg s ep sp) where
|
||||
instance Semigroup (CompositeCfg s e sp ep) where
|
||||
(<>) c1 c2 = CompositeCfg {
|
||||
_cmcMergeRequired = _cmcMergeRequired c2 <|> _cmcMergeRequired c1,
|
||||
_cmcOnInit = _cmcOnInit c2 <|> _cmcOnInit c1,
|
||||
_cmcOnChange = _cmcOnChange c2 <|> _cmcOnChange c1,
|
||||
_cmcOnChangeReq = _cmcOnChangeReq c2 <|> _cmcOnChangeReq c1
|
||||
_cmcOnChangeReq = _cmcOnChangeReq c2 <|> _cmcOnChangeReq c1,
|
||||
_cmcOnEnabledChange = _cmcOnEnabledChange c2 <|> _cmcOnEnabledChange c1,
|
||||
_cmcOnVisibleChange = _cmcOnVisibleChange c2 <|> _cmcOnVisibleChange c1
|
||||
}
|
||||
|
||||
instance Monoid (CompositeCfg s ep sp) where
|
||||
instance Monoid (CompositeCfg s e sp ep) where
|
||||
mempty = def
|
||||
|
||||
instance CmbMergeRequired (CompositeCfg s ep sp) s where
|
||||
instance CmbMergeRequired (CompositeCfg s e sp ep) s where
|
||||
mergeRequired fn = def {
|
||||
_cmcMergeRequired = Just fn
|
||||
}
|
||||
|
||||
instance CmbOnChange (CompositeCfg s ep sp) s ep where
|
||||
instance CmbOnInit (CompositeCfg s e sp ep) e where
|
||||
onInit fn = def {
|
||||
_cmcOnInit = [fn]
|
||||
}
|
||||
|
||||
instance CmbOnChange (CompositeCfg s e sp ep) s ep where
|
||||
onChange fn = def {
|
||||
_cmcOnChange = [fn]
|
||||
}
|
||||
|
||||
instance CmbOnChangeReq (CompositeCfg s ep sp) sp where
|
||||
instance CmbOnChangeReq (CompositeCfg s e sp ep) sp where
|
||||
onChangeReq req = def {
|
||||
_cmcOnChangeReq = [req]
|
||||
}
|
||||
|
||||
instance CmbOnEnabledChange (CompositeCfg s e sp ep) e where
|
||||
onEnabledChange fn = def {
|
||||
_cmcOnEnabledChange = [fn]
|
||||
}
|
||||
|
||||
instance CmbOnVisibleChange (CompositeCfg s e sp ep) e where
|
||||
onVisibleChange fn = def {
|
||||
_cmcOnVisibleChange = [fn]
|
||||
}
|
||||
|
||||
data Composite s e sp ep = Composite {
|
||||
_cmpWidgetData :: WidgetData sp s,
|
||||
_cmpEventHandler :: EventHandler s e ep,
|
||||
_cmpUiBuilder :: UIBuilder s e,
|
||||
_cmpMergeRequired :: MergeRequired s,
|
||||
_cmpInitEvent :: Maybe e,
|
||||
_cmpInitEvent :: [e],
|
||||
_cmpOnChange :: [s -> ep],
|
||||
_cmpOnChangeReq :: [WidgetRequest sp]
|
||||
_cmpOnChangeReq :: [WidgetRequest sp],
|
||||
_cmpOnEnabledChange :: [e],
|
||||
_cmpOnVisibleChange :: [e]
|
||||
}
|
||||
|
||||
data CompositeState s e = CompositeState {
|
||||
@ -143,87 +169,80 @@ composite
|
||||
:: (CompositeModel s, CompositeEvent e, ParentModel sp)
|
||||
=> WidgetType
|
||||
-> ALens' sp s
|
||||
-> Maybe e
|
||||
-> UIBuilder s e
|
||||
-> EventHandler s e ep
|
||||
-> WidgetNode sp ep
|
||||
composite widgetType field initEvt uiBuilder evtHandler = newNode where
|
||||
newNode = composite_ widgetType field initEvt uiBuilder evtHandler def
|
||||
composite widgetType field uiBuilder evtHandler = newNode where
|
||||
newNode = composite_ widgetType field uiBuilder evtHandler def
|
||||
|
||||
composite_
|
||||
:: (CompositeModel s, CompositeEvent e, ParentModel sp)
|
||||
=> WidgetType
|
||||
-> ALens' sp s
|
||||
-> Maybe e
|
||||
-> UIBuilder s e
|
||||
-> EventHandler s e ep
|
||||
-> [CompositeCfg s ep sp]
|
||||
-> [CompositeCfg s e sp ep]
|
||||
-> WidgetNode sp ep
|
||||
composite_ widgetType field initEvt uiBuilder evtHandler cfgs = newNode where
|
||||
composite_ widgetType field uiBuilder evtHandler cfgs = newNode where
|
||||
widgetData = WidgetLens field
|
||||
newNode = compositeD_ widgetType widgetData initEvt uiBuilder evtHandler cfgs
|
||||
newNode = compositeD_ widgetType widgetData uiBuilder evtHandler cfgs
|
||||
|
||||
compositeV
|
||||
:: (CompositeModel s, CompositeEvent e, ParentModel sp)
|
||||
=> WidgetType
|
||||
-> s
|
||||
-> (s -> ep)
|
||||
-> Maybe e
|
||||
-> UIBuilder s e
|
||||
-> EventHandler s e ep
|
||||
-> WidgetNode sp ep
|
||||
compositeV wType val handler initEvt uiBuilder evtHandler = newNode where
|
||||
newNode = compositeV_ wType val handler initEvt uiBuilder evtHandler def
|
||||
compositeV wType val handler uiBuilder evtHandler = newNode where
|
||||
newNode = compositeV_ wType val handler uiBuilder evtHandler def
|
||||
|
||||
compositeV_
|
||||
:: (CompositeModel s, CompositeEvent e, ParentModel sp)
|
||||
=> WidgetType
|
||||
-> s
|
||||
-> (s -> ep)
|
||||
-> Maybe e
|
||||
-> UIBuilder s e
|
||||
-> EventHandler s e ep
|
||||
-> [CompositeCfg s ep sp]
|
||||
-> [CompositeCfg s e sp ep]
|
||||
-> WidgetNode sp ep
|
||||
compositeV_ wType val handler initEvt uiBuilder evtHandler cfgs = newNode where
|
||||
compositeV_ wType val handler uiBuilder evtHandler cfgs = newNode where
|
||||
widgetData = WidgetValue val
|
||||
newCfgs = onChange handler : cfgs
|
||||
newNode = compositeD_ wType widgetData initEvt uiBuilder evtHandler newCfgs
|
||||
newNode = compositeD_ wType widgetData uiBuilder evtHandler newCfgs
|
||||
|
||||
compositeExt
|
||||
:: (CompositeModel s, CompositeEvent e, ParentModel sp)
|
||||
=> WidgetType
|
||||
-> s
|
||||
-> Maybe e
|
||||
-> UIBuilder s e
|
||||
-> EventHandler s e ep
|
||||
-> WidgetNode sp ep
|
||||
compositeExt wType val initEvt uiBuilder evtHandler = newNode where
|
||||
newNode = compositeExt_ wType val initEvt uiBuilder evtHandler []
|
||||
compositeExt wType val uiBuilder evtHandler = newNode where
|
||||
newNode = compositeExt_ wType val uiBuilder evtHandler []
|
||||
|
||||
compositeExt_
|
||||
:: (CompositeModel s, CompositeEvent e, ParentModel sp)
|
||||
=> WidgetType
|
||||
-> s
|
||||
-> Maybe e
|
||||
-> UIBuilder s e
|
||||
-> EventHandler s e ep
|
||||
-> [CompositeCfg s ep sp]
|
||||
-> [CompositeCfg s e sp ep]
|
||||
-> WidgetNode sp ep
|
||||
compositeExt_ wType val initEvt uiBuilder evtHandler cfgs = newNode where
|
||||
compositeExt_ wType val uiBuilder evtHandler cfgs = newNode where
|
||||
widgetData = WidgetValue val
|
||||
newNode = compositeD_ wType widgetData initEvt uiBuilder evtHandler cfgs
|
||||
newNode = compositeD_ wType widgetData uiBuilder evtHandler cfgs
|
||||
|
||||
compositeD_
|
||||
:: (CompositeModel s, CompositeEvent e, ParentModel sp)
|
||||
=> WidgetType
|
||||
-> WidgetData sp s
|
||||
-> Maybe e
|
||||
-> UIBuilder s e
|
||||
-> EventHandler s e ep
|
||||
-> [CompositeCfg s ep sp]
|
||||
-> [CompositeCfg s e sp ep]
|
||||
-> WidgetNode sp ep
|
||||
compositeD_ wType wData initEvt uiBuilder evtHandler configs = newNode where
|
||||
compositeD_ wType wData uiBuilder evtHandler configs = newNode where
|
||||
config = mconcat configs
|
||||
mergeReq = fromMaybe (/=) (_cmcMergeRequired config)
|
||||
widgetRoot = spacer
|
||||
@ -232,9 +251,11 @@ compositeD_ wType wData initEvt uiBuilder evtHandler configs = newNode where
|
||||
_cmpEventHandler = evtHandler,
|
||||
_cmpUiBuilder = uiBuilder,
|
||||
_cmpMergeRequired = mergeReq,
|
||||
_cmpInitEvent = initEvt,
|
||||
_cmpInitEvent = _cmcOnInit config,
|
||||
_cmpOnChange = _cmcOnChange config,
|
||||
_cmpOnChangeReq = _cmcOnChangeReq config
|
||||
_cmpOnChangeReq = _cmcOnChangeReq config,
|
||||
_cmpOnEnabledChange = _cmcOnEnabledChange config,
|
||||
_cmpOnVisibleChange = _cmcOnVisibleChange config
|
||||
}
|
||||
state = CompositeState Nothing widgetRoot M.empty
|
||||
widget = createComposite composite state
|
||||
@ -277,13 +298,13 @@ compositeInit comp state wenv widgetComp = newResult where
|
||||
builtRoot = _cmpUiBuilder comp cwenv model
|
||||
tempRoot = cascadeCtx wenv widgetComp builtRoot
|
||||
WidgetResult root reqs evts = widgetInit (tempRoot ^. L.widget) cwenv tempRoot
|
||||
newEvts = maybe evts (evts |>) (_cmpInitEvent comp)
|
||||
newEvts = Seq.fromList (_cmpInitEvent comp)
|
||||
newState = state {
|
||||
_cpsModel = Just model,
|
||||
_cpsRoot = root,
|
||||
_cpsGlobalKeys = collectGlobalKeys M.empty root
|
||||
}
|
||||
tempResult = WidgetResult root reqs newEvts
|
||||
tempResult = WidgetResult root reqs (evts <> newEvts)
|
||||
getBaseStyle wenv node = Nothing
|
||||
styledComp = initNodeStyle getBaseStyle wenv widgetComp
|
||||
newResult = reduceResult comp newState wenv styledComp tempResult
|
||||
@ -309,17 +330,17 @@ compositeMerge comp state wenv oldComp newComp = newResult where
|
||||
-- Needed in case the user references something outside model when building UI
|
||||
-- The same model is provided as old since nothing else is available, but
|
||||
-- mergeRequired may be using data from a closure
|
||||
oldFlags = [oldComp ^. L.info . L.visible, oldComp ^. L.info . L.enabled]
|
||||
newFlags = [newComp ^. L.info . L.visible, newComp ^. L.info . L.enabled]
|
||||
visibleChg = oldComp ^. L.info . L.visible /= newComp ^. L.info . L.visible
|
||||
enabledChg = oldComp ^. L.info . L.enabled /= newComp ^. L.info . L.enabled
|
||||
modelChanged = _cmpMergeRequired comp (fromJust oldModel) model
|
||||
mergeRequired
|
||||
| isJust oldModel = modelChanged || (oldFlags /= newFlags)
|
||||
| isJust oldModel = modelChanged || visibleChg || enabledChg
|
||||
| otherwise = True
|
||||
initRequired = not (nodeMatches tempRoot oldRoot)
|
||||
tempResult
|
||||
WidgetResult newRoot tmpReqs tmpEvts
|
||||
| initRequired = widgetInit tempWidget cwenv tempRoot
|
||||
| otherwise = widgetMerge tempWidget cwenv oldRoot tempRoot
|
||||
newRoot = tempResult ^. L.node
|
||||
| mergeRequired = widgetMerge tempWidget cwenv oldRoot tempRoot
|
||||
| otherwise = resultWidget oldRoot
|
||||
newState = validState {
|
||||
_cpsModel = Just model,
|
||||
_cpsRoot = newRoot,
|
||||
@ -332,10 +353,11 @@ compositeMerge comp state wenv oldComp newComp = newResult where
|
||||
& L.info . L.renderArea .~ oldComp ^. L.info . L.renderArea
|
||||
& L.info . L.sizeReqW .~ oldComp ^. L.info . L.sizeReqW
|
||||
& L.info . L.sizeReqH .~ oldComp ^. L.info . L.sizeReqH
|
||||
reducedResult
|
||||
| mergeRequired = reduceResult comp newState wenv styledComp tempResult
|
||||
| otherwise = resultWidget $ styledComp
|
||||
& L.widget .~ oldComp ^. L.widget
|
||||
visibleEvts = if visibleChg then _cmpOnVisibleChange comp else []
|
||||
enabledEvts = if enabledChg then _cmpOnEnabledChange comp else []
|
||||
evts = Seq.fromList (visibleEvts ++ enabledEvts)
|
||||
tmpResult = WidgetResult newRoot tmpReqs (tmpEvts <> evts)
|
||||
reducedResult = reduceResult comp newState wenv styledComp tmpResult
|
||||
newResult = handleWidgetIdChange oldComp reducedResult
|
||||
|
||||
-- | Dispose
|
||||
|
||||
@ -57,23 +57,43 @@ instance CmbCancelCaption ConfirmCfg where
|
||||
_cfcCancel = Just t
|
||||
}
|
||||
|
||||
confirm :: (WidgetModel s, WidgetEvent e) => Text -> e -> e -> WidgetNode s e
|
||||
data ConfirmEvt e
|
||||
= ParentEvt e
|
||||
| VisibleChanged
|
||||
deriving (Eq, Show)
|
||||
|
||||
confirm
|
||||
:: (WidgetModel sp, WidgetEvent ep)
|
||||
=> Text
|
||||
-> ep
|
||||
-> ep
|
||||
-> WidgetNode sp ep
|
||||
confirm message acceptEvt cancelEvt = confirm_ message acceptEvt cancelEvt def
|
||||
|
||||
confirm_
|
||||
:: (WidgetModel s, WidgetEvent e)
|
||||
:: (WidgetModel sp, WidgetEvent ep)
|
||||
=> Text
|
||||
-> e
|
||||
-> e
|
||||
-> ep
|
||||
-> ep
|
||||
-> [ConfirmCfg]
|
||||
-> WidgetNode s e
|
||||
-> WidgetNode sp ep
|
||||
confirm_ message acceptEvt cancelEvt configs = newNode where
|
||||
config = mconcat configs
|
||||
createUI = buildUI message acceptEvt cancelEvt config
|
||||
newNode = compositeExt "confirm" () Nothing createUI handleEvent
|
||||
evts = [onVisibleChange VisibleChanged]
|
||||
newNode = compositeExt_ "confirm" () createUI handleEvent evts
|
||||
|
||||
buildUI :: Text -> e -> e -> ConfirmCfg -> WidgetEnv s e -> s -> WidgetNode s e
|
||||
buildUI message acceptEvt cancelEvt config wenv model = confirmBox where
|
||||
buildUI
|
||||
:: Text
|
||||
-> ep
|
||||
-> ep
|
||||
-> ConfirmCfg
|
||||
-> WidgetEnv s (ConfirmEvt ep)
|
||||
-> s
|
||||
-> WidgetNode s (ConfirmEvt ep)
|
||||
buildUI message pAcceptEvt pCancelEvt config wenv model = confirmBox where
|
||||
acceptEvt = ParentEvt pAcceptEvt
|
||||
cancelEvt = ParentEvt pCancelEvt
|
||||
title = fromMaybe "" (_cfcTitle config)
|
||||
accept = fromMaybe "Accept" (_cfcAccept config)
|
||||
cancel = fromMaybe "Cancel" (_cfcCancel config)
|
||||
@ -95,5 +115,11 @@ buildUI message acceptEvt cancelEvt config wenv model = confirmBox where
|
||||
confirmBox = box_ confirmTree [onClickEmpty cancelEvt]
|
||||
& L.info . L.style .~ emptyOverlayColor
|
||||
|
||||
handleEvent :: WidgetEnv s e -> s -> e -> [EventResponse s e e]
|
||||
handleEvent wenv model evt = [Report evt]
|
||||
handleEvent
|
||||
:: WidgetEnv s (ConfirmEvt ep)
|
||||
-> s
|
||||
-> ConfirmEvt ep
|
||||
-> [EventResponse s e ep]
|
||||
handleEvent wenv model evt = case evt of
|
||||
ParentEvt pevt -> [Report pevt]
|
||||
VisibleChanged -> []
|
||||
|
||||
@ -119,7 +119,7 @@ handleEventBasic = describe "handleEventBasic" $ do
|
||||
-> [EventResponse MainModel MainEvt ()]
|
||||
handleEvent wenv model evt = [Model (model & clicks %~ (+1))]
|
||||
buildUI wenv model = button "Click" MainBtnClicked
|
||||
cmpNode = composite "main" id Nothing buildUI handleEvent
|
||||
cmpNode = composite "main" id buildUI handleEvent
|
||||
model es = nodeHandleEventModel wenv es cmpNode
|
||||
|
||||
handleEventChild :: Spec
|
||||
@ -153,9 +153,9 @@ handleEventChild = describe "handleEventChild" $ do
|
||||
handleEvent wenv model evt = [Model (model & clicks %~ (+1))]
|
||||
buildUI wenv model = vstack [
|
||||
button "Click" MainBtnClicked,
|
||||
composite "child" child Nothing buildChild handleChild
|
||||
composite "child" child buildChild handleChild
|
||||
]
|
||||
cmpNode = composite "main" id Nothing buildUI handleEvent
|
||||
cmpNode = composite "main" id buildUI handleEvent
|
||||
model es = nodeHandleEventModel wenv es cmpNode
|
||||
|
||||
handleEventLocalKey :: Spec
|
||||
@ -194,8 +194,8 @@ handleEventLocalKey = describe "handleEventLocalKey" $
|
||||
textField text1 `key` "localTxt1"
|
||||
]
|
||||
]
|
||||
cmpNode1 = composite "main" id Nothing buildUI1 handleEvent
|
||||
cmpNode2 = composite_ "main" id Nothing buildUI2 handleEvent [mergeRequired (\_ _ -> True)]
|
||||
cmpNode1 = composite "main" id buildUI1 handleEvent
|
||||
cmpNode2 = composite_ "main" id buildUI2 handleEvent [mergeRequired (\_ _ -> True)]
|
||||
evts1 = [evtK keyTab, evtT "aacc", moveCharL, moveCharL]
|
||||
((wenv1, _, root1), ctx1) = nodeHandleEvents wenv evts1 cmpNode1
|
||||
cntNodeM = nodeMerge wenv1 root1 cmpNode2
|
||||
@ -239,8 +239,8 @@ handleEventGlobalKey = describe "handleEventGlobalKey" $
|
||||
textField text1 `globalKey` "globalTxt1"
|
||||
]
|
||||
]
|
||||
cmpNode1 = composite "main" id Nothing buildUI1 handleEvent
|
||||
cmpNode2 = composite_ "main" id Nothing buildUI2 handleEvent [mergeRequired (\_ _ -> True)]
|
||||
cmpNode1 = composite "main" id buildUI1 handleEvent
|
||||
cmpNode2 = composite_ "main" id buildUI2 handleEvent [mergeRequired (\_ _ -> True)]
|
||||
evts1 = [evtT "aacc", moveCharL, moveCharL]
|
||||
((wenv1, _, root1), ctx1) = nodeHandleEvents wenv evts1 cmpNode1
|
||||
cntNodeM = nodeMerge wenv1 root1 cmpNode2
|
||||
@ -275,9 +275,9 @@ handleMessage = describe "handleMessage" $ do
|
||||
handleEvent wenv model evt = [Request (SendMessage path msg)]
|
||||
buildUI wenv model = vstack [
|
||||
button "Start" MainBtnClicked,
|
||||
composite "child" child Nothing buildChild handleChild
|
||||
composite "child" child buildChild handleChild
|
||||
]
|
||||
cmpNode = composite "main" id Nothing buildUI handleEvent
|
||||
cmpNode = composite "main" id buildUI handleEvent
|
||||
model es = nodeHandleEventModel wenv es cmpNode
|
||||
|
||||
getSizeReq :: Spec
|
||||
@ -296,7 +296,7 @@ getSizeReq = describe "getSizeReq" $ do
|
||||
label "label 1",
|
||||
label "label 2"
|
||||
]
|
||||
cmpNode = composite "main" id Nothing buildUI handleEvent
|
||||
cmpNode = composite "main" id buildUI handleEvent
|
||||
(sizeReqW, sizeReqH) = nodeGetSizeReq wenv cmpNode
|
||||
|
||||
resize :: Spec
|
||||
@ -317,7 +317,7 @@ resize = describe "resize" $ do
|
||||
handleEvent wenv model evt = []
|
||||
buildUI :: WidgetEnv () () -> () -> WidgetNode () ()
|
||||
buildUI wenv model = hstack []
|
||||
cmpNode = composite "main" id Nothing buildUI handleEvent
|
||||
cmpNode = composite "main" id buildUI handleEvent
|
||||
tmpNode = nodeInit wenv cmpNode
|
||||
newNode = widgetSave (tmpNode ^. L.widget) wenv tmpNode
|
||||
viewport = newNode ^. L.info . L.viewport
|
||||
|
||||
@ -122,7 +122,7 @@ restoreComposite = describe "restoreComposite" $ do
|
||||
buildUI wenv model = vstack [
|
||||
textField text1
|
||||
]
|
||||
node1 = composite "main" id Nothing buildUI handleEvent
|
||||
node1 = composite "main" id buildUI handleEvent
|
||||
(model2, oldInfo, rstInfo) = handleRestoredEvents wenv node1
|
||||
|
||||
handleRestoredEvents wenv node1 = (model2, oldInfo, rstInfo) where
|
||||
|
||||
Loading…
Reference in New Issue
Block a user