mirror of
https://github.com/fjvallarino/monomer.git
synced 2024-09-20 00:09:02 +03:00
Rename WidgetInstance fields
This commit is contained in:
parent
a969a901dc
commit
3f2c26460b
@ -94,7 +94,7 @@ runWidgets window c widgetRoot = do
|
||||
_weTimestamp = startTs
|
||||
}
|
||||
let pathReadyRoot = widgetRoot {
|
||||
_instancePath = Seq.singleton 0
|
||||
_wiPath = Seq.singleton 0
|
||||
}
|
||||
(newWenv, _, initializedRoot) <- handleWidgetInit renderer wenv pathReadyRoot
|
||||
|
||||
@ -201,7 +201,7 @@ renderWidgets
|
||||
-> m ()
|
||||
renderWidgets !window !c !renderer wenv widgetRoot =
|
||||
doInDrawingContext window c $
|
||||
_widgetRender (_instanceWidget widgetRoot) renderer wenv widgetRoot
|
||||
_widgetRender (_wiWidget widgetRoot) renderer wenv widgetRoot
|
||||
|
||||
resizeWindow
|
||||
:: (MonomerM s m)
|
||||
@ -236,7 +236,7 @@ preProcessEvent
|
||||
=> WidgetEnv s e -> WidgetInstance s e -> SystemEvent -> m [SystemEvent]
|
||||
preProcessEvent wenv widgetRoot evt@(Move point) = do
|
||||
hover <- use latestHover
|
||||
let widget = _instanceWidget widgetRoot
|
||||
let widget = _wiWidget widgetRoot
|
||||
let current = _widgetFind widget wenv rootPath point widgetRoot
|
||||
let hoverChanged = isJust hover && current /= hover
|
||||
let enter = [Enter point | isNothing hover || hoverChanged]
|
||||
@ -247,7 +247,7 @@ preProcessEvent wenv widgetRoot evt@(Move point) = do
|
||||
|
||||
return $ leave ++ enter ++ [evt]
|
||||
preProcessEvent wenv widgetRoot evt@(ButtonAction point btn PressedBtn) = do
|
||||
let widget = _instanceWidget widgetRoot
|
||||
let widget = _wiWidget widgetRoot
|
||||
let current = _widgetFind widget wenv rootPath point widgetRoot
|
||||
|
||||
latestPressed .= current
|
||||
|
@ -58,7 +58,7 @@ getTargetPath wenv pressed overlay target event widgetRoot = case event of
|
||||
Leave oldPath _ -> pathEvent oldPath
|
||||
where
|
||||
startPath = fromMaybe rootPath overlay
|
||||
widget = _instanceWidget widgetRoot
|
||||
widget = _wiWidget widgetRoot
|
||||
pathEvent = Just
|
||||
pathFromPoint point = _widgetFind widget wenv startPath point widgetRoot
|
||||
pointEvent point = pressed <|> pathFromPoint point <|> overlay
|
||||
@ -94,7 +94,7 @@ handleSystemEvent renderer wenv event currentTarget widgetRoot = do
|
||||
case getTargetPath wenv pressed overlay currentTarget event widgetRoot of
|
||||
Nothing -> return (wenv, Seq.empty, widgetRoot)
|
||||
Just target -> do
|
||||
let widget = _instanceWidget widgetRoot
|
||||
let widget = _wiWidget widgetRoot
|
||||
let emptyResult = WidgetResult Seq.empty Seq.empty widgetRoot
|
||||
let evtResult = _widgetHandleEvent widget wenv target event widgetRoot
|
||||
let widgetResult = fromMaybe emptyResult evtResult
|
||||
@ -111,7 +111,7 @@ handleWidgetInit
|
||||
-> WidgetInstance s e
|
||||
-> m (HandlerStep s e)
|
||||
handleWidgetInit renderer wenv widgetRoot = do
|
||||
let widget = _instanceWidget widgetRoot
|
||||
let widget = _wiWidget widgetRoot
|
||||
let widgetResult = _widgetInit widget wenv widgetRoot
|
||||
|
||||
handleWidgetResult renderer wenv widgetResult
|
||||
@ -271,7 +271,7 @@ handleSendMessages renderer reqs previousStep = nextStep where
|
||||
|
||||
let (wenv, events, widgetRoot) = previousStep
|
||||
let emptyResult = WidgetResult Seq.empty Seq.empty widgetRoot
|
||||
let widget = _instanceWidget widgetRoot
|
||||
let widget = _wiWidget widgetRoot
|
||||
let msgResult = _widgetHandleMessage widget wenv path message widgetRoot
|
||||
let widgetResult = fromMaybe emptyResult msgResult
|
||||
|
||||
|
@ -30,7 +30,7 @@ initMonomerContext model winSize useHiDPI devicePixelRate = MonomerContext {
|
||||
|
||||
findNextFocusable :: WidgetEnv s e -> Path -> WidgetInstance s e -> Path
|
||||
findNextFocusable wenv currentFocus widgetRoot = fromJust nextFocus where
|
||||
widget = _instanceWidget widgetRoot
|
||||
widget = _wiWidget widgetRoot
|
||||
candidateFocus = _widgetNextFocusable widget wenv currentFocus widgetRoot
|
||||
fromRootFocus = _widgetNextFocusable widget wenv rootPath widgetRoot
|
||||
nextFocus = candidateFocus <|> fromRootFocus <|> Just currentFocus
|
||||
@ -40,6 +40,6 @@ resizeWidget
|
||||
resizeWidget wenv windowSize widgetRoot = newRoot where
|
||||
Size w h = windowSize
|
||||
assigned = Rect 0 0 w h
|
||||
widget = _instanceWidget widgetRoot
|
||||
widget = _wiWidget widgetRoot
|
||||
preferredSize = _widgetPreferredSize widget wenv widgetRoot
|
||||
newRoot = _widgetResize widget wenv assigned assigned preferredSize widgetRoot
|
||||
|
@ -96,7 +96,7 @@ processTaskEvent renderer wenv widgetRoot path event = do
|
||||
currentFocus <- use focused
|
||||
|
||||
let emptyResult = WidgetResult Seq.empty Seq.empty widgetRoot
|
||||
let widget = _instanceWidget widgetRoot
|
||||
let widget = _wiWidget widgetRoot
|
||||
let msgResult = _widgetHandleMessage widget wenv path event widgetRoot
|
||||
let widgetResult = fromMaybe emptyResult msgResult
|
||||
|
||||
|
@ -67,17 +67,17 @@ containerInit
|
||||
-> WidgetResult s e
|
||||
containerInit initHandler wenv widgetInst = result where
|
||||
WidgetResult reqs events tempInstance = initHandler wenv widgetInst
|
||||
children = _instanceChildren tempInstance
|
||||
children = _wiChildren tempInstance
|
||||
indexes = Seq.fromList [0..length children]
|
||||
zipper idx child = _widgetInit newWidget wenv newChild where
|
||||
newChild = cascadeCtx widgetInst child idx
|
||||
newWidget = _instanceWidget newChild
|
||||
newWidget = _wiWidget newChild
|
||||
results = Seq.zipWith zipper indexes children
|
||||
newReqs = fold $ fmap _wrRequests results
|
||||
newEvents = fold $ fmap _wrEvents results
|
||||
newChildren = fmap _wrWidget results
|
||||
newInstance = tempInstance {
|
||||
_instanceChildren = newChildren
|
||||
_wiChildren = newChildren
|
||||
}
|
||||
result = WidgetResult (reqs <> newReqs) (events <> newEvents) newInstance
|
||||
|
||||
@ -99,10 +99,10 @@ containerMergeTrees
|
||||
-> WidgetInstance s e
|
||||
-> WidgetResult s e
|
||||
containerMergeTrees mergeHandler wenv oldInst newInst = result where
|
||||
oldState = _widgetGetState (_instanceWidget oldInst) wenv
|
||||
oldState = _widgetGetState (_wiWidget oldInst) wenv
|
||||
WidgetResult uReqs uEvents uInstance = mergeHandler wenv oldState newInst
|
||||
oldChildren = _instanceChildren oldInst
|
||||
updatedChildren = _instanceChildren uInstance
|
||||
oldChildren = _wiChildren oldInst
|
||||
updatedChildren = _wiChildren uInstance
|
||||
indexes = Seq.fromList [0..length updatedChildren]
|
||||
zipper idx child = cascadeCtx newInst child idx
|
||||
newChildren = Seq.zipWith zipper indexes updatedChildren
|
||||
@ -112,7 +112,7 @@ containerMergeTrees mergeHandler wenv oldInst newInst = result where
|
||||
mergedReqs = concatSeq $ fmap _wrRequests mergedResults
|
||||
mergedEvents = concatSeq $ fmap _wrEvents mergedResults
|
||||
mergedInstance = uInstance {
|
||||
_instanceChildren = mergedChildren
|
||||
_wiChildren = mergedChildren
|
||||
}
|
||||
newReqs = uReqs <> mergedReqs
|
||||
newEvents = uEvents <> mergedEvents
|
||||
@ -125,13 +125,13 @@ mergeChildren
|
||||
-> Seq (WidgetResult s e)
|
||||
mergeChildren _ _ Empty = Empty
|
||||
mergeChildren wenv Empty newItems = result where
|
||||
init child = _widgetInit (_instanceWidget child) wenv child
|
||||
init child = _widgetInit (_wiWidget child) wenv child
|
||||
result = fmap init newItems
|
||||
mergeChildren wenv oldItems newItems = result where
|
||||
oldChild :<| oldChildren = oldItems
|
||||
newChild :<| newChildren = newItems
|
||||
newWidget = _instanceWidget newChild
|
||||
oldKeyMatch = _instanceKey newChild >>= flip M.lookup (_weGlobalKeys wenv)
|
||||
newWidget = _wiWidget newChild
|
||||
oldKeyMatch = _wiKey newChild >>= flip M.lookup (_weGlobalKeys wenv)
|
||||
mergedOld = _widgetMerge newWidget wenv oldChild newChild
|
||||
mergedKey = _widgetMerge newWidget wenv (fromJust oldKeyMatch) newChild
|
||||
initNew = _widgetInit newWidget wenv newChild
|
||||
@ -145,21 +145,21 @@ mergeChildren wenv oldItems newItems = result where
|
||||
containerNextFocusable
|
||||
:: WidgetEnv s e -> Path -> WidgetInstance s e -> Maybe Path
|
||||
containerNextFocusable wenv startFrom widgetInst = nextFocus where
|
||||
children = _instanceChildren widgetInst
|
||||
children = _wiChildren widgetInst
|
||||
isBeforeTarget ch = isTargetBeforeCurrent startFrom ch
|
||||
nextCandidate ch = _widgetNextFocusable (_instanceWidget ch) wenv startFrom ch
|
||||
nextCandidate ch = _widgetNextFocusable (_wiWidget ch) wenv startFrom ch
|
||||
candidates = fmap nextCandidate (Seq.filter isBeforeTarget children)
|
||||
focusedPaths = fmap fromJust (Seq.filter isJust candidates)
|
||||
nextFocus
|
||||
| isFocusCandidate startFrom widgetInst = Just (_instancePath widgetInst)
|
||||
| isFocusCandidate startFrom widgetInst = Just (_wiPath widgetInst)
|
||||
| otherwise = Seq.lookup 0 focusedPaths
|
||||
|
||||
-- | Find instance matching point
|
||||
containerFind
|
||||
:: WidgetEnv s e -> Path -> Point -> WidgetInstance s e -> Maybe Path
|
||||
containerFind wenv startPath point widgetInst = result where
|
||||
children = _instanceChildren widgetInst
|
||||
pointInWidget wi = pointInRect point (_instanceViewport wi)
|
||||
children = _wiChildren widgetInst
|
||||
pointInWidget wi = pointInRect point (_wiViewport wi)
|
||||
newStartPath = Seq.drop 1 startPath
|
||||
childIdx = case startPath of
|
||||
Empty -> Seq.findIndexL pointInWidget children
|
||||
@ -168,8 +168,8 @@ containerFind wenv startPath point widgetInst = result where
|
||||
Just idx -> childPath where
|
||||
childPath = _widgetFind childWidget wenv newStartPath point child
|
||||
child = Seq.index children idx
|
||||
childWidget = _instanceWidget child
|
||||
Nothing -> Just $ _instancePath widgetInst
|
||||
childWidget = _wiWidget child
|
||||
Nothing -> Just $ _wiPath widgetInst
|
||||
|
||||
-- | Event Handling
|
||||
type ContainerEventHandler s e
|
||||
@ -194,19 +194,19 @@ containerHandleEvent pHandler wenv target event widgetInst
|
||||
| otherwise = mergeParentChildEvts widgetInst pResponse cResponse childIdx
|
||||
where
|
||||
-- Having targetValid = False means the next path step is not in
|
||||
-- _instanceChildren, but may still be valid in the receiving widget
|
||||
-- _wiChildren, but may still be valid in the receiving widget
|
||||
-- For example, Composite has its own tree of child widgets with (possibly)
|
||||
-- different types for Model and Events, and is candidate for the next step
|
||||
targetReached = isTargetReached target widgetInst
|
||||
targetValid = isTargetValid target widgetInst
|
||||
childIdx = fromJust $ nextTargetStep target widgetInst
|
||||
children = _instanceChildren widgetInst
|
||||
children = _wiChildren widgetInst
|
||||
child = Seq.index children childIdx
|
||||
childWidget = _instanceWidget child
|
||||
childWidget = _wiWidget child
|
||||
pResponse = pHandler wenv target event widgetInst
|
||||
childrenIgnored = isJust pResponse && ignoreChildren (fromJust pResponse)
|
||||
cResponse
|
||||
| childrenIgnored || not (_instanceEnabled child) = Nothing
|
||||
| childrenIgnored || not (_wiEnabled child) = Nothing
|
||||
| otherwise = _widgetHandleEvent childWidget wenv target event child
|
||||
|
||||
mergeParentChildEvts
|
||||
@ -261,9 +261,9 @@ containerHandleMessage mHandler wenv target arg widgetInst
|
||||
targetReached = isTargetReached target widgetInst
|
||||
targetValid = isTargetValid target widgetInst
|
||||
childIdx = fromJust $ nextTargetStep target widgetInst
|
||||
children = _instanceChildren widgetInst
|
||||
children = _wiChildren widgetInst
|
||||
child = Seq.index children childIdx
|
||||
message = _widgetHandleMessage (_instanceWidget child) wenv target arg child
|
||||
message = _widgetHandleMessage (_wiWidget child) wenv target arg child
|
||||
messageResult = updateChild <$> message
|
||||
updateChild cr = cr {
|
||||
_wrWidget = replaceChild widgetInst (_wrWidget cr) childIdx
|
||||
@ -291,10 +291,10 @@ containerPreferredSize
|
||||
-> WidgetInstance s e
|
||||
-> Tree SizeReq
|
||||
containerPreferredSize psHandler wenv widgetInst = preferredSize where
|
||||
children = _instanceChildren widgetInst
|
||||
children = _wiChildren widgetInst
|
||||
childrenReqs = fmap updateChild children
|
||||
updateChild child = Node (updateSizeReq req child) reqs where
|
||||
Node req reqs = _widgetPreferredSize (_instanceWidget child) wenv child
|
||||
Node req reqs = _widgetPreferredSize (_wiWidget child) wenv child
|
||||
preferredSize = psHandler wenv widgetInst children childrenReqs
|
||||
|
||||
-- | Resize
|
||||
@ -321,19 +321,19 @@ containerResize
|
||||
-> WidgetInstance s e
|
||||
-> WidgetInstance s e
|
||||
containerResize handler wenv viewport renderArea reqs widgetInst = newSize where
|
||||
children = _instanceChildren widgetInst
|
||||
children = _wiChildren widgetInst
|
||||
defReqs = Seq.replicate (Seq.length children) (singleNode def)
|
||||
curReqs = nodeChildren reqs
|
||||
childrenReqs = if Seq.null curReqs then defReqs else curReqs
|
||||
(tempInst, assigned) =
|
||||
handler wenv viewport renderArea children childrenReqs widgetInst
|
||||
resizeChild (child, req, (viewport, renderArea)) =
|
||||
_widgetResize (_instanceWidget child) wenv viewport renderArea req child
|
||||
_widgetResize (_wiWidget child) wenv viewport renderArea req child
|
||||
newChildren = resizeChild <$> Seq.zip3 children childrenReqs assigned
|
||||
newSize = tempInst {
|
||||
_instanceViewport = viewport,
|
||||
_instanceRenderArea = renderArea,
|
||||
_instanceChildren = newChildren
|
||||
_wiViewport = viewport,
|
||||
_wiRenderArea = renderArea,
|
||||
_wiChildren = newChildren
|
||||
}
|
||||
|
||||
-- | Rendering
|
||||
@ -346,7 +346,7 @@ type ContainerRenderHandler s e m
|
||||
|
||||
defaultContainerRender :: ContainerRenderHandler s e m
|
||||
defaultContainerRender renderer wenv WidgetInstance{..} =
|
||||
drawStyledBackground renderer _instanceRenderArea _instanceStyle
|
||||
drawStyledBackground renderer _wiRenderArea _wiStyle
|
||||
|
||||
containerRender
|
||||
:: (Monad m)
|
||||
@ -356,12 +356,12 @@ containerRender
|
||||
-> WidgetInstance s e
|
||||
-> m ()
|
||||
containerRender rHandler renderer wenv widgetInst = do
|
||||
let children = _instanceChildren widgetInst
|
||||
let children = _wiChildren widgetInst
|
||||
|
||||
rHandler renderer wenv widgetInst
|
||||
|
||||
forM_ children $ \child -> when (_instanceVisible child) $
|
||||
_widgetRender (_instanceWidget child) renderer wenv child
|
||||
forM_ children $ \child -> when (_wiVisible child) $
|
||||
_widgetRender (_wiWidget child) renderer wenv child
|
||||
|
||||
-- | Event Handling Helpers
|
||||
ignoreChildren :: WidgetResult s e -> Bool
|
||||
@ -374,8 +374,8 @@ ignoreParent result = not (Seq.null ignoreReqs) where
|
||||
|
||||
replaceChild
|
||||
:: WidgetInstance s e -> WidgetInstance s e -> Int -> WidgetInstance s e
|
||||
replaceChild parent child idx = parent { _instanceChildren = newChildren } where
|
||||
newChildren = Seq.update idx child (_instanceChildren parent)
|
||||
replaceChild parent child idx = parent { _wiChildren = newChildren } where
|
||||
newChildren = Seq.update idx child (_wiChildren parent)
|
||||
|
||||
visibleChildrenReq
|
||||
:: Seq (WidgetInstance s e)
|
||||
@ -383,18 +383,18 @@ visibleChildrenReq
|
||||
-> (Seq (WidgetInstance s e), Seq SizeReq)
|
||||
visibleChildrenReq children reqs = Seq.unzipWith extract filtered where
|
||||
pairs = Seq.zip children reqs
|
||||
isVisible (child, req) = _instanceVisible child
|
||||
isVisible (child, req) = _wiVisible child
|
||||
filtered = Seq.filter isVisible pairs
|
||||
extract (child, treq) = (child, nodeValue treq)
|
||||
|
||||
cascadeCtx
|
||||
:: WidgetInstance s e -> WidgetInstance s e -> Int -> WidgetInstance s e
|
||||
cascadeCtx parent child idx = newChild where
|
||||
parentPath = _instancePath parent
|
||||
parentVisible = _instanceVisible parent
|
||||
parentEnabled = _instanceEnabled parent
|
||||
parentPath = _wiPath parent
|
||||
parentVisible = _wiVisible parent
|
||||
parentEnabled = _wiEnabled parent
|
||||
newChild = child {
|
||||
_instancePath = parentPath |> idx,
|
||||
_instanceVisible = _instanceVisible child && parentVisible,
|
||||
_instanceEnabled = _instanceEnabled child && parentEnabled
|
||||
_wiPath = parentPath |> idx,
|
||||
_wiVisible = _wiVisible child && parentVisible,
|
||||
_wiEnabled = _wiEnabled child && parentEnabled
|
||||
}
|
||||
|
@ -53,18 +53,18 @@ widgetMerge
|
||||
-> WidgetInstance s e
|
||||
-> WidgetResult s e
|
||||
widgetMerge mergeHandler wenv oldInstance newInstance = result where
|
||||
oldState = _widgetGetState (_instanceWidget oldInstance) wenv
|
||||
oldState = _widgetGetState (_wiWidget oldInstance) wenv
|
||||
result = mergeHandler wenv oldState newInstance
|
||||
|
||||
defaultNextFocusable
|
||||
:: WidgetEnv s e -> Path -> WidgetInstance s e -> Maybe Path
|
||||
defaultNextFocusable wenv startFrom widgetInst
|
||||
| isFocusCandidate startFrom widgetInst = Just (_instancePath widgetInst)
|
||||
| isFocusCandidate startFrom widgetInst = Just (_wiPath widgetInst)
|
||||
| otherwise = Nothing
|
||||
|
||||
defaultFind
|
||||
:: WidgetEnv s e -> Path -> Point -> WidgetInstance s e -> Maybe Path
|
||||
defaultFind wenv path point widgetInst = Just (_instancePath widgetInst)
|
||||
defaultFind wenv path point widgetInst = Just (_wiPath widgetInst)
|
||||
|
||||
defaultHandleEvent
|
||||
:: WidgetEnv s e
|
||||
@ -98,8 +98,8 @@ defaultResize
|
||||
-> WidgetInstance s e
|
||||
-> WidgetInstance s e
|
||||
defaultResize wenv viewport renderArea reqs widgetInst = widgetInst {
|
||||
_instanceViewport = viewport,
|
||||
_instanceRenderArea = renderArea
|
||||
_wiViewport = viewport,
|
||||
_wiRenderArea = renderArea
|
||||
}
|
||||
|
||||
defaultRender
|
||||
|
@ -116,7 +116,7 @@ compositeInit comp state wenv widgetComp = result where
|
||||
CompositeState{..} = state
|
||||
cwenv = convertWidgetEnv wenv _cmpGlobalKeys _cmpModel
|
||||
tempRoot = cascadeCtx widgetComp _cmpRoot
|
||||
widget = _instanceWidget tempRoot
|
||||
widget = _wiWidget tempRoot
|
||||
WidgetResult reqs evts root = _widgetInit widget cwenv tempRoot
|
||||
newEvts = maybe evts (evts |>) _cmpInitEvent
|
||||
newState = state {
|
||||
@ -135,7 +135,7 @@ compositeMerge
|
||||
-> WidgetInstance sp ep
|
||||
-> WidgetResult sp ep
|
||||
compositeMerge comp state wenv oldComposite newComposite = result where
|
||||
oldState = _widgetGetState (_instanceWidget oldComposite) wenv
|
||||
oldState = _widgetGetState (_wiWidget oldComposite) wenv
|
||||
validState = fromMaybe state (useState oldState)
|
||||
CompositeState oldModel oldRoot oldInit oldGlobalKeys = validState
|
||||
-- Duplicate widget tree creation is avoided because the widgetRoot created
|
||||
@ -145,7 +145,7 @@ compositeMerge comp state wenv oldComposite newComposite = result where
|
||||
_cmpRoot = newRoot,
|
||||
_cmpGlobalKeys = collectGlobalKeys M.empty newRoot
|
||||
}
|
||||
newWidget = _instanceWidget newRoot
|
||||
newWidget = _wiWidget newRoot
|
||||
cwenv = convertWidgetEnv wenv oldGlobalKeys oldModel
|
||||
mergeRequired = instanceMatches newRoot oldRoot
|
||||
widgetResult
|
||||
@ -163,7 +163,7 @@ compositeNextFocusable
|
||||
-> Maybe Path
|
||||
compositeNextFocusable comp state wenv startFrom widgetComp = nextFocus where
|
||||
CompositeState{..} = state
|
||||
widget = _instanceWidget _cmpRoot
|
||||
widget = _wiWidget _cmpRoot
|
||||
cwenv = convertWidgetEnv wenv _cmpGlobalKeys _cmpModel
|
||||
nextFocus = _widgetNextFocusable widget cwenv startFrom _cmpRoot
|
||||
|
||||
@ -179,7 +179,7 @@ compositeFind CompositeState{..} wenv startPath point widgetComp
|
||||
| validStep = _widgetFind widget cwenv newStartPath point _cmpRoot
|
||||
| otherwise = Nothing
|
||||
where
|
||||
widget = _instanceWidget _cmpRoot
|
||||
widget = _wiWidget _cmpRoot
|
||||
cwenv = convertWidgetEnv wenv _cmpGlobalKeys _cmpModel
|
||||
validStep = Seq.null startPath || Seq.index startPath 0 == 0
|
||||
newStartPath = Seq.drop 1 startPath
|
||||
@ -196,9 +196,9 @@ compositeHandleEvent
|
||||
-> Maybe (WidgetResult sp ep)
|
||||
compositeHandleEvent comp state wenv target evt widgetComp = result where
|
||||
CompositeState{..} = state
|
||||
widget = _instanceWidget _cmpRoot
|
||||
widget = _wiWidget _cmpRoot
|
||||
cwenv = convertWidgetEnv wenv _cmpGlobalKeys _cmpModel
|
||||
rootEnabled = _instanceEnabled _cmpRoot
|
||||
rootEnabled = _wiEnabled _cmpRoot
|
||||
processEvent = reduceResult comp state wenv widgetComp
|
||||
evtResult
|
||||
| rootEnabled = _widgetHandleEvent widget cwenv target evt _cmpRoot
|
||||
@ -222,7 +222,7 @@ compositeHandleMessage comp state@CompositeState{..} wenv target arg widgetComp
|
||||
Nothing -> Nothing
|
||||
| otherwise = fmap processEvent result where
|
||||
processEvent = reduceResult comp state wenv widgetComp
|
||||
cmpWidget = _instanceWidget _cmpRoot
|
||||
cmpWidget = _wiWidget _cmpRoot
|
||||
cwenv = convertWidgetEnv wenv _cmpGlobalKeys _cmpModel
|
||||
result = _widgetHandleMessage cmpWidget cwenv target arg _cmpRoot
|
||||
|
||||
@ -234,7 +234,7 @@ compositePreferredSize
|
||||
-> Tree SizeReq
|
||||
compositePreferredSize state wenv _ = preferredSize where
|
||||
CompositeState{..} = state
|
||||
widget = _instanceWidget _cmpRoot
|
||||
widget = _wiWidget _cmpRoot
|
||||
cwenv = convertWidgetEnv wenv _cmpGlobalKeys _cmpModel
|
||||
preferredSize = _widgetPreferredSize widget cwenv _cmpRoot
|
||||
|
||||
@ -251,16 +251,16 @@ compositeResize
|
||||
-> WidgetInstance sp ep
|
||||
compositeResize comp state wenv newView newArea reqs widgetComp = resized where
|
||||
CompositeState{..} = state
|
||||
widget = _instanceWidget _cmpRoot
|
||||
widget = _wiWidget _cmpRoot
|
||||
cwenv = convertWidgetEnv wenv _cmpGlobalKeys _cmpModel
|
||||
newRoot = _widgetResize widget cwenv newView newArea reqs _cmpRoot
|
||||
newState = state {
|
||||
_cmpRoot = newRoot
|
||||
}
|
||||
resized = widgetComp {
|
||||
_instanceWidget = createComposite comp newState,
|
||||
_instanceViewport = newView,
|
||||
_instanceRenderArea = newArea
|
||||
_wiWidget = createComposite comp newState,
|
||||
_wiViewport = newView,
|
||||
_wiRenderArea = newArea
|
||||
}
|
||||
|
||||
-- Render
|
||||
@ -274,7 +274,7 @@ compositeRender
|
||||
-> m ()
|
||||
compositeRender comp state renderer wenv _ = action where
|
||||
CompositeState{..} = state
|
||||
widget = _instanceWidget _cmpRoot
|
||||
widget = _wiWidget _cmpRoot
|
||||
cwenv = convertWidgetEnv wenv _cmpGlobalKeys _cmpModel
|
||||
action = _widgetRender widget renderer cwenv _cmpRoot
|
||||
|
||||
@ -295,7 +295,7 @@ reduceResult comp state wenv widgetComp widgetResult = newResult where
|
||||
ReducedEvents{..} = reduceCompEvents _cmpGlobalKeys evtHandler evtModel evts
|
||||
WidgetResult uReqs uEvts uWidget =
|
||||
updateComposite comp state wenv _reModel evtsRoot widgetComp
|
||||
currentPath = _instancePath widgetComp
|
||||
currentPath = _wiPath widgetComp
|
||||
newReqs = toParentReqs reqs
|
||||
<> tasksToRequests currentPath _reTasks
|
||||
<> producersToRequests currentPath _reProducers
|
||||
@ -323,7 +323,7 @@ updateComposite comp state wenv newModel widgetRoot widgetComp = result where
|
||||
result
|
||||
| changed = rebuildComposite comp state wenv newModel widgetRoot widgetComp
|
||||
| otherwise = resultWidget $ widgetComp {
|
||||
_instanceWidget = createComposite comp newState
|
||||
_wiWidget = createComposite comp newState
|
||||
}
|
||||
|
||||
rebuildComposite
|
||||
@ -338,7 +338,7 @@ rebuildComposite
|
||||
rebuildComposite comp state wenv newModel widgetRoot widgetComp = result where
|
||||
CompositeState{..} = state
|
||||
builtRoot = cascadeCtx widgetComp (_uiBuilder comp newModel)
|
||||
builtWidget = _instanceWidget builtRoot
|
||||
builtWidget = _wiWidget builtRoot
|
||||
cwenv = convertWidgetEnv wenv _cmpGlobalKeys newModel
|
||||
mergedResult = _widgetMerge builtWidget cwenv widgetRoot builtRoot
|
||||
resizedResult = resizeResult state wenv mergedResult widgetComp
|
||||
@ -357,11 +357,11 @@ resizeResult
|
||||
-> WidgetResult s e
|
||||
resizeResult state wenv result widgetComp = resizedResult where
|
||||
CompositeState{..} = state
|
||||
viewport = _instanceViewport widgetComp
|
||||
renderArea = _instanceRenderArea widgetComp
|
||||
viewport = _wiViewport widgetComp
|
||||
renderArea = _wiRenderArea widgetComp
|
||||
cwenv = convertWidgetEnv wenv _cmpGlobalKeys _cmpModel
|
||||
widgetRoot = _wrWidget result
|
||||
widget = _instanceWidget widgetRoot
|
||||
widget = _wiWidget widgetRoot
|
||||
newReqs = _widgetPreferredSize widget cwenv widgetRoot
|
||||
newRoot = _widgetResize widget cwenv viewport renderArea newReqs widgetRoot
|
||||
resizedResult = result {
|
||||
@ -394,7 +394,7 @@ reduceEvtResponse globalKeys curr@ReducedEvents{..} response = case response of
|
||||
Event event -> curr { _reEvents = _reEvents |> event }
|
||||
Message key message -> case M.lookup key globalKeys of
|
||||
Just inst -> curr {
|
||||
_reMessages = _reMessages |> SendMessage (_instancePath inst) message
|
||||
_reMessages = _reMessages |> SendMessage (_wiPath inst) message
|
||||
}
|
||||
Nothing -> curr
|
||||
Report report -> curr { _reReports = _reReports |> report }
|
||||
@ -431,9 +431,9 @@ collectGlobalKeys
|
||||
-> WidgetInstance s e
|
||||
-> Map WidgetKey (WidgetInstance s e)
|
||||
collectGlobalKeys keys widgetInst = foldl' collect updatedMap children where
|
||||
children = _instanceChildren widgetInst
|
||||
children = _wiChildren widgetInst
|
||||
collect currKeys child = collectGlobalKeys currKeys child
|
||||
updatedMap = case _instanceKey widgetInst of
|
||||
updatedMap = case _wiKey widgetInst of
|
||||
Just key -> M.insert key widgetInst keys
|
||||
_ -> keys
|
||||
|
||||
@ -450,11 +450,11 @@ convertWidgetEnv wenv globalKeys model = WidgetEnv {
|
||||
|
||||
cascadeCtx :: WidgetInstance sp ep -> WidgetInstance s e -> WidgetInstance s e
|
||||
cascadeCtx parent child = newChild where
|
||||
parentPath = _instancePath parent
|
||||
parentVisible = _instanceVisible parent
|
||||
parentEnabled = _instanceEnabled parent
|
||||
parentPath = _wiPath parent
|
||||
parentVisible = _wiVisible parent
|
||||
parentEnabled = _wiEnabled parent
|
||||
newChild = child {
|
||||
_instancePath = parentPath |> 0,
|
||||
_instanceVisible = _instanceVisible child && parentVisible,
|
||||
_instanceEnabled = _instanceEnabled child && parentEnabled
|
||||
_wiPath = parentPath |> 0,
|
||||
_wiVisible = _wiVisible child && parentVisible,
|
||||
_wiEnabled = _wiEnabled child && parentEnabled
|
||||
}
|
||||
|
@ -200,27 +200,27 @@ data Widget s e =
|
||||
data WidgetInstance s e =
|
||||
WidgetInstance {
|
||||
-- | Type of the widget
|
||||
_instanceType :: !WidgetType,
|
||||
_wiType :: !WidgetType,
|
||||
-- | Key/Identifier of the widget
|
||||
_instanceKey :: Maybe WidgetKey,
|
||||
_wiKey :: Maybe WidgetKey,
|
||||
-- | The path of the instance in the widget tree
|
||||
_instancePath :: !Path,
|
||||
_wiPath :: !Path,
|
||||
-- | The actual widget
|
||||
_instanceWidget :: Widget s e,
|
||||
_wiWidget :: Widget s e,
|
||||
-- | The children widget, if any
|
||||
_instanceChildren :: Seq (WidgetInstance s e),
|
||||
_wiChildren :: Seq (WidgetInstance s e),
|
||||
-- | Indicates if the widget is enabled for user interaction
|
||||
_instanceEnabled :: !Bool,
|
||||
_wiEnabled :: !Bool,
|
||||
-- | Indicates if the widget is visible
|
||||
_instanceVisible :: !Bool,
|
||||
_wiVisible :: !Bool,
|
||||
-- | Indicates whether the widget can receive focus
|
||||
_instanceFocusable :: !Bool,
|
||||
_wiFocusable :: !Bool,
|
||||
-- | The visible area of the screen assigned to the widget
|
||||
_instanceViewport :: !Rect,
|
||||
_wiViewport :: !Rect,
|
||||
-- | The area of the screen where the widget can draw
|
||||
-- | Usually equal to _instanceViewport, but may be larger if the widget is
|
||||
-- | Usually equal to _wiViewport, but may be larger if the widget is
|
||||
-- | wrapped in a scrollable container
|
||||
_instanceRenderArea :: !Rect,
|
||||
_wiRenderArea :: !Rect,
|
||||
-- | Style attributes of the widget instance
|
||||
_instanceStyle :: Style
|
||||
_wiStyle :: Style
|
||||
}
|
||||
|
@ -24,17 +24,17 @@ rootPath = Seq.empty
|
||||
|
||||
defaultWidgetInstance :: WidgetType -> Widget s e -> WidgetInstance s e
|
||||
defaultWidgetInstance widgetType widget = WidgetInstance {
|
||||
_instanceType = widgetType,
|
||||
_instanceKey = Nothing,
|
||||
_instancePath = Seq.empty,
|
||||
_instanceWidget = widget,
|
||||
_instanceChildren = Seq.empty,
|
||||
_instanceEnabled = True,
|
||||
_instanceVisible = True,
|
||||
_instanceFocusable = False,
|
||||
_instanceViewport = def,
|
||||
_instanceRenderArea = def,
|
||||
_instanceStyle = def
|
||||
_wiType = widgetType,
|
||||
_wiKey = Nothing,
|
||||
_wiPath = Seq.empty,
|
||||
_wiWidget = widget,
|
||||
_wiChildren = Seq.empty,
|
||||
_wiEnabled = True,
|
||||
_wiVisible = True,
|
||||
_wiFocusable = False,
|
||||
_wiViewport = def,
|
||||
_wiRenderArea = def,
|
||||
_wiStyle = def
|
||||
}
|
||||
|
||||
widgetValueGet :: s -> WidgetValue s a -> a
|
||||
@ -48,17 +48,17 @@ widgetValueSet (WidgetLens lens) value = [UpdateModel updateFn] where
|
||||
|
||||
key :: WidgetInstance s e -> Text -> WidgetInstance s e
|
||||
key widgetInst key = widgetInst {
|
||||
_instanceKey = Just (WidgetKey key)
|
||||
_wiKey = Just (WidgetKey key)
|
||||
}
|
||||
|
||||
style :: WidgetInstance s e -> Style -> WidgetInstance s e
|
||||
style widgetInst newStyle = widgetInst {
|
||||
_instanceStyle = newStyle
|
||||
_wiStyle = newStyle
|
||||
}
|
||||
|
||||
visible :: WidgetInstance s e -> Bool -> WidgetInstance s e
|
||||
visible widgetInst visibility = widgetInst {
|
||||
_instanceVisible = visibility
|
||||
_wiVisible = visibility
|
||||
}
|
||||
|
||||
resultWidget :: WidgetInstance s e -> WidgetResult s e
|
||||
@ -86,13 +86,13 @@ useState (Just (WidgetState state)) = cast state
|
||||
|
||||
instanceMatches :: WidgetInstance s e -> WidgetInstance s e -> Bool
|
||||
instanceMatches newInstance oldInstance = typeMatches && keyMatches where
|
||||
typeMatches = _instanceType oldInstance == _instanceType newInstance
|
||||
keyMatches = _instanceKey oldInstance == _instanceKey newInstance
|
||||
typeMatches = _wiType oldInstance == _wiType newInstance
|
||||
keyMatches = _wiKey oldInstance == _wiKey newInstance
|
||||
|
||||
updateSizeReq :: SizeReq -> WidgetInstance s e -> SizeReq
|
||||
updateSizeReq sizeReq widgetInst = newSizeReq where
|
||||
width = _styleWidth . _instanceStyle $ widgetInst
|
||||
height = _styleHeight . _instanceStyle $ widgetInst
|
||||
width = _styleWidth . _wiStyle $ widgetInst
|
||||
height = _styleHeight . _wiStyle $ widgetInst
|
||||
tempSizeReq
|
||||
| isNothing width = sizeReq
|
||||
| otherwise = sizeReq {
|
||||
@ -180,39 +180,39 @@ isMacOS :: WidgetEnv s e -> Bool
|
||||
isMacOS wenv = _wpOS (_wePlatform wenv) == "Mac OS X"
|
||||
|
||||
firstChildPath :: WidgetInstance s e -> Path
|
||||
firstChildPath widgetInst = _instancePath widgetInst |> 0
|
||||
firstChildPath widgetInst = _wiPath widgetInst |> 0
|
||||
|
||||
nextTargetStep :: Path -> WidgetInstance s e -> Maybe PathStep
|
||||
nextTargetStep target widgetInst = nextStep where
|
||||
currentPath = _instancePath widgetInst
|
||||
currentPath = _wiPath widgetInst
|
||||
nextStep = Seq.lookup (Seq.length currentPath) target
|
||||
|
||||
pointInViewport :: Point -> WidgetInstance s e -> Bool
|
||||
pointInViewport p inst = pointInRect p (_instanceViewport inst)
|
||||
pointInViewport p inst = pointInRect p (_wiViewport inst)
|
||||
|
||||
isFocused :: WidgetEnv s e -> WidgetInstance s e -> Bool
|
||||
isFocused ctx widgetInst = _weFocusedPath ctx == _instancePath widgetInst
|
||||
isFocused ctx widgetInst = _weFocusedPath ctx == _wiPath widgetInst
|
||||
|
||||
isFocusCandidate :: Path -> WidgetInstance s e -> Bool
|
||||
isFocusCandidate startFrom widgetInst = isValid where
|
||||
isBefore = isTargetBeforeCurrent startFrom widgetInst
|
||||
isFocusable = _instanceFocusable widgetInst
|
||||
isEnabled = _instanceVisible widgetInst && _instanceEnabled widgetInst
|
||||
isFocusable = _wiFocusable widgetInst
|
||||
isEnabled = _wiVisible widgetInst && _wiEnabled widgetInst
|
||||
isValid = isBefore && isFocusable && isEnabled
|
||||
|
||||
isTargetReached :: Path -> WidgetInstance s e -> Bool
|
||||
isTargetReached target widgetInst = target == _instancePath widgetInst
|
||||
isTargetReached target widgetInst = target == _wiPath widgetInst
|
||||
|
||||
isTargetValid :: Path -> WidgetInstance s e -> Bool
|
||||
isTargetValid target widgetInst = valid where
|
||||
children = _instanceChildren widgetInst
|
||||
children = _wiChildren widgetInst
|
||||
valid = case nextTargetStep target widgetInst of
|
||||
Just step -> step < Seq.length children
|
||||
Nothing -> False
|
||||
|
||||
isTargetBeforeCurrent :: Path -> WidgetInstance s e -> Bool
|
||||
isTargetBeforeCurrent target widgetInst = targetPrefix < currentPath where
|
||||
currentPath = _instancePath widgetInst
|
||||
currentPath = _wiPath widgetInst
|
||||
lenTarget = Seq.length target
|
||||
lenCurrent = Seq.length currentPath
|
||||
targetPrefix
|
||||
|
@ -54,7 +54,7 @@ makeButton config = widget where
|
||||
_ -> Nothing
|
||||
|
||||
preferredSize wenv widgetInst = singleNode sizeReq where
|
||||
Style{..} = _instanceStyle widgetInst
|
||||
Style{..} = _wiStyle widgetInst
|
||||
size = getTextBounds wenv _styleText (_btnLabel config)
|
||||
sizeReq = SizeReq size FlexibleSize StrictSize
|
||||
|
||||
@ -63,5 +63,5 @@ makeButton config = widget where
|
||||
drawStyledText_ renderer renderArea style (_btnLabel config)
|
||||
|
||||
where
|
||||
renderArea = _instanceRenderArea
|
||||
style = _instanceStyle
|
||||
renderArea = _wiRenderArea
|
||||
style = _wiStyle
|
||||
|
@ -35,8 +35,8 @@ container config managed = makeInstance (makeContainer config) managed
|
||||
|
||||
makeInstance :: Widget s e -> WidgetInstance s e -> WidgetInstance s e
|
||||
makeInstance widget managedWidget = (defaultWidgetInstance "container" widget) {
|
||||
_instanceChildren = Seq.singleton managedWidget,
|
||||
_instanceFocusable = False
|
||||
_wiChildren = Seq.singleton managedWidget,
|
||||
_wiFocusable = False
|
||||
}
|
||||
|
||||
makeContainer :: ContainerConfig s e -> Widget s e
|
||||
@ -73,5 +73,5 @@ makeContainer config = widget where
|
||||
|
||||
where
|
||||
point = statusMousePos (_weInputStatus wenv)
|
||||
viewport = _instanceViewport widgetInst
|
||||
Style{..} = _instanceStyle widgetInst
|
||||
viewport = _wiViewport widgetInst
|
||||
Style{..} = _wiStyle widgetInst
|
||||
|
@ -81,7 +81,7 @@ dropdown_ config = makeInstance (makeDropdown config newState) where
|
||||
|
||||
makeInstance :: Widget s e -> WidgetInstance s e
|
||||
makeInstance widget = (defaultWidgetInstance "dropdown" widget) {
|
||||
_instanceFocusable = True
|
||||
_wiFocusable = True
|
||||
}
|
||||
|
||||
makeDropdown :: (Eq a) => DropdownConfig s e a -> DropdownState -> Widget s e
|
||||
@ -102,10 +102,10 @@ makeDropdown config state = widget where
|
||||
|
||||
createDropdown wenv newState widgetInst = newInstance where
|
||||
selected = currentValue wenv
|
||||
path = _instancePath widgetInst
|
||||
path = _wiPath widgetInst
|
||||
newInstance = widgetInst {
|
||||
_instanceWidget = makeDropdown config newState,
|
||||
_instanceChildren = Seq.singleton $ makeListView config path selected
|
||||
_wiWidget = makeDropdown config newState,
|
||||
_wiChildren = Seq.singleton $ makeListView config path selected
|
||||
}
|
||||
|
||||
init wenv widgetInst = resultWidget $ createDropdown wenv state widgetInst
|
||||
@ -126,11 +126,11 @@ makeDropdown config state = widget where
|
||||
| otherwise -> Nothing
|
||||
|
||||
openRequired point widgetInst = not isOpen && inViewport where
|
||||
inViewport = pointInRect point (_instanceViewport widgetInst)
|
||||
inViewport = pointInRect point (_wiViewport widgetInst)
|
||||
|
||||
closeRequired point widgetInst = isOpen && not inOverlay where
|
||||
inOverlay = case Seq.lookup 0 (_instanceChildren widgetInst) of
|
||||
Just inst -> pointInRect point (_instanceViewport inst)
|
||||
inOverlay = case Seq.lookup 0 (_wiChildren widgetInst) of
|
||||
Just inst -> pointInRect point (_wiViewport inst)
|
||||
Nothing -> False
|
||||
|
||||
openDropdown wenv widgetInst = resultReqs requests newInstance where
|
||||
@ -138,17 +138,17 @@ makeDropdown config state = widget where
|
||||
selectedIdx = fromMaybe 0 (Seq.elemIndexL selected (_ddItems config))
|
||||
newState = DropdownState True
|
||||
newInstance = widgetInst {
|
||||
_instanceWidget = makeDropdown config newState
|
||||
_wiWidget = makeDropdown config newState
|
||||
}
|
||||
path = _instancePath widgetInst
|
||||
path = _wiPath widgetInst
|
||||
lvPath = firstChildPath widgetInst
|
||||
requests = [SetOverlay path, SetFocus lvPath]
|
||||
|
||||
closeDropdown wenv widgetInst = resultReqs requests newInstance where
|
||||
path = _instancePath widgetInst
|
||||
path = _wiPath widgetInst
|
||||
newState = DropdownState False
|
||||
newInstance = widgetInst {
|
||||
_instanceWidget = makeDropdown config newState
|
||||
_wiWidget = makeDropdown config newState
|
||||
}
|
||||
requests = [ResetOverlay, SetFocus path]
|
||||
|
||||
@ -163,7 +163,7 @@ makeDropdown config state = widget where
|
||||
result = WidgetResult (reqs <> newReqs) (events <> newEvents) newInstance
|
||||
|
||||
preferredSize wenv widgetInst children reqs = Node sizeReq reqs where
|
||||
Style{..} = _instanceStyle widgetInst
|
||||
Style{..} = _wiStyle widgetInst
|
||||
size = getTextBounds wenv _styleText (dropdownLabel wenv)
|
||||
sizeReq = SizeReq size FlexibleSize StrictSize
|
||||
|
||||
@ -190,12 +190,12 @@ makeDropdown config state = widget where
|
||||
createOverlay renderer $
|
||||
renderOverlay renderer wenv (fromJust listViewOverlay)
|
||||
where
|
||||
listViewOverlay = Seq.lookup 0 _instanceChildren
|
||||
renderArea = _instanceRenderArea
|
||||
style = _instanceStyle
|
||||
listViewOverlay = Seq.lookup 0 _wiChildren
|
||||
renderArea = _wiRenderArea
|
||||
style = _wiStyle
|
||||
|
||||
renderOverlay renderer wenv overlayInstance = renderAction where
|
||||
widget = _instanceWidget overlayInstance
|
||||
widget = _wiWidget overlayInstance
|
||||
renderAction = _widgetRender widget renderer wenv overlayInstance
|
||||
|
||||
dropdownLabel wenv = _ddItemToText config $ currentValue wenv
|
||||
|
@ -18,12 +18,12 @@ import Monomer.Widget.BaseContainer
|
||||
|
||||
hgrid :: (Traversable t) => t (WidgetInstance s e) -> WidgetInstance s e
|
||||
hgrid children = (defaultWidgetInstance "hgrid" (makeFixedGrid True)) {
|
||||
_instanceChildren = foldl' (|>) Empty children
|
||||
_wiChildren = foldl' (|>) Empty children
|
||||
}
|
||||
|
||||
vgrid :: (Traversable t) => t (WidgetInstance s e) -> WidgetInstance s e
|
||||
vgrid children = (defaultWidgetInstance "vgrid" (makeFixedGrid False)) {
|
||||
_instanceChildren = foldl' (|>) Empty children
|
||||
_wiChildren = foldl' (|>) Empty children
|
||||
}
|
||||
|
||||
makeFixedGrid :: Bool -> Widget s e
|
||||
@ -51,7 +51,7 @@ makeFixedGrid isHorizontal = widget where
|
||||
|
||||
resize wenv viewport renderArea children reqs widgetInst = resized where
|
||||
Rect l t w h = renderArea
|
||||
vchildren = Seq.filter _instanceVisible children
|
||||
vchildren = Seq.filter _wiVisible children
|
||||
cols = if isHorizontal then length vchildren else 1
|
||||
rows = if isHorizontal then 1 else length vchildren
|
||||
cw = if cols > 0 then w / fromIntegral cols else 0
|
||||
@ -63,8 +63,8 @@ makeFixedGrid isHorizontal = widget where
|
||||
| cols > 0 = t + fromIntegral (i `div` cols) * ch
|
||||
| otherwise = 0
|
||||
foldHelper (newAreas, index) child = (newAreas |> newArea, newIndex) where
|
||||
visible = _instanceVisible child
|
||||
newIndex = index + if _instanceVisible child then 1 else 0
|
||||
visible = _wiVisible child
|
||||
newIndex = index + if _wiVisible child then 1 else 0
|
||||
newViewport = if visible then calcViewport index else def
|
||||
newArea = (newViewport, newViewport)
|
||||
calcViewport i = Rect (cx i) (cy i) cw ch
|
||||
|
@ -24,10 +24,10 @@ makeLabel caption = widget where
|
||||
}
|
||||
|
||||
preferredSize wenv widgetInst = singleNode sizeReq where
|
||||
Style{..} = _instanceStyle widgetInst
|
||||
Style{..} = _wiStyle widgetInst
|
||||
size = getTextBounds wenv _styleText caption
|
||||
sizeReq = SizeReq size FlexibleSize StrictSize
|
||||
|
||||
render renderer wenv WidgetInstance{..} = do
|
||||
drawStyledBackground renderer _instanceRenderArea _instanceStyle
|
||||
drawStyledText_ renderer _instanceRenderArea _instanceStyle caption
|
||||
drawStyledBackground renderer _wiRenderArea _wiStyle
|
||||
drawStyledText_ renderer _wiRenderArea _wiStyle caption
|
||||
|
@ -86,7 +86,7 @@ listView_ config = makeInstance (makeListView config newState) where
|
||||
|
||||
makeInstance :: Widget s e -> WidgetInstance s e
|
||||
makeInstance widget = (defaultWidgetInstance "listView" widget) {
|
||||
_instanceFocusable = True
|
||||
_wiFocusable = True
|
||||
}
|
||||
|
||||
makeListView :: (Eq a) => ListViewConfig s e a -> ListViewState -> Widget s e
|
||||
@ -105,11 +105,11 @@ makeListView config state = widget where
|
||||
|
||||
createListView wenv newState widgetInst = newInstance where
|
||||
selected = currentValue wenv
|
||||
path = _instancePath widgetInst
|
||||
path = _wiPath widgetInst
|
||||
itemsList = makeItemsList config path selected (_highlighted newState)
|
||||
newInstance = widgetInst {
|
||||
_instanceWidget = makeListView config newState,
|
||||
_instanceChildren = Seq.singleton (scroll itemsList)
|
||||
_wiWidget = makeListView config newState,
|
||||
_wiChildren = Seq.singleton (scroll itemsList)
|
||||
}
|
||||
|
||||
init wenv widgetInst = resultWidget $ createListView wenv state widgetInst
|
||||
@ -150,7 +150,7 @@ makeListView config state = widget where
|
||||
-- ListView's merge uses the old widget's state. Since we want the newly
|
||||
-- created state, the old widget is replaced here
|
||||
oldInstance = widgetInst {
|
||||
_instanceWidget = newWidget
|
||||
_wiWidget = newWidget
|
||||
}
|
||||
-- ListView's tree will be rebuilt in merge, before merging its children,
|
||||
-- so it does not matter what we currently have
|
||||
@ -166,16 +166,16 @@ makeListView config state = widget where
|
||||
valueSetReq = widgetValueSet (_lvValue config) value
|
||||
scrollToReq = itemScrollTo widgetInst idx
|
||||
changeReqs = fmap ($ idx) (_lvOnChangeReq config)
|
||||
focusReq = [SetFocus $ _instancePath widgetInst]
|
||||
focusReq = [SetFocus $ _wiPath widgetInst]
|
||||
requests = valueSetReq ++ scrollToReq ++ changeReqs ++ focusReq
|
||||
newState = ListViewState idx
|
||||
newInstance = widgetInst {
|
||||
_instanceWidget = makeListView config newState
|
||||
_wiWidget = makeListView config newState
|
||||
}
|
||||
|
||||
itemScrollTo widgetInst idx = maybeToList (fmap scrollReq renderArea) where
|
||||
lookup idx inst = Seq.lookup idx (_instanceChildren inst)
|
||||
renderArea = fmap _instanceRenderArea $ pure widgetInst
|
||||
lookup idx inst = Seq.lookup idx (_wiChildren inst)
|
||||
renderArea = fmap _wiRenderArea $ pure widgetInst
|
||||
>>= lookup 0 -- scroll
|
||||
>>= lookup 0 -- vstack
|
||||
>>= lookup idx -- item
|
||||
|
@ -49,13 +49,13 @@ makeSandbox onClick state = widget where
|
||||
merge wenv oldState widgetInst = resultWidget newInstance where
|
||||
newState = fromMaybe state (useState oldState)
|
||||
newInstance = widgetInst {
|
||||
_instanceWidget = makeSandbox onClick newState
|
||||
_wiWidget = makeSandbox onClick newState
|
||||
}
|
||||
|
||||
handleEvent wenv target evt widgetInst = case evt of
|
||||
Click (Point x y) _ -> result where
|
||||
events = [onClick]
|
||||
requests = [RunTask (_instancePath widgetInst) runTask]
|
||||
requests = [RunTask (_wiPath widgetInst) runTask]
|
||||
newState = SandboxState (_clickCount state + 1)
|
||||
newInstance = makeInstance $ makeSandbox onClick newState
|
||||
result = Just $ resultReqsEvents requests events newInstance
|
||||
@ -73,10 +73,10 @@ makeSandbox onClick state = widget where
|
||||
Nothing -> Nothing
|
||||
|
||||
preferredSize wenv widgetInst = singleNode sizeReq where
|
||||
Style{..} = _instanceStyle widgetInst
|
||||
Style{..} = _wiStyle widgetInst
|
||||
size = getTextBounds wenv _styleText (T.pack label)
|
||||
sizeReq = SizeReq size FlexibleSize FlexibleSize
|
||||
|
||||
render renderer wenv WidgetInstance{..} = do
|
||||
drawStyledBackground renderer _instanceRenderArea _instanceStyle
|
||||
drawStyledText_ renderer _instanceRenderArea _instanceStyle (T.pack label)
|
||||
drawStyledBackground renderer _wiRenderArea _wiStyle
|
||||
drawStyledText_ renderer _wiRenderArea _wiStyle (T.pack label)
|
||||
|
@ -93,8 +93,8 @@ scroll_ config managed = makeInstance (makeScroll config defaultState) managed
|
||||
|
||||
makeInstance :: Widget s e -> WidgetInstance s e -> WidgetInstance s e
|
||||
makeInstance widget managedWidget = (defaultWidgetInstance "scroll" widget) {
|
||||
_instanceChildren = Seq.singleton managedWidget,
|
||||
_instanceFocusable = False
|
||||
_wiChildren = Seq.singleton managedWidget,
|
||||
_wiFocusable = False
|
||||
}
|
||||
|
||||
makeScroll :: ScrollConfig -> ScrollState -> Widget s e
|
||||
@ -115,7 +115,7 @@ makeScroll config state = widget where
|
||||
merge wenv oldState widgetInst = resultWidget newInstance where
|
||||
newState = fromMaybe state (useState oldState)
|
||||
newInstance = widgetInst {
|
||||
_instanceWidget = makeScroll config newState
|
||||
_wiWidget = makeScroll config newState
|
||||
}
|
||||
|
||||
handleEvent wenv target evt widgetInst = case evt of
|
||||
@ -135,7 +135,7 @@ makeScroll config state = widget where
|
||||
| btnReleased = state { _sstDragging = Nothing }
|
||||
| otherwise = state
|
||||
newInstance = widgetInst {
|
||||
_instanceWidget = makeScroll config newState
|
||||
_wiWidget = makeScroll config newState
|
||||
}
|
||||
handledResult = Just $ resultReqs [IgnoreChildrenEvents] newInstance
|
||||
result
|
||||
@ -176,8 +176,8 @@ makeScroll config state = widget where
|
||||
}
|
||||
_ -> Nothing
|
||||
where
|
||||
viewport = _instanceViewport widgetInst
|
||||
Rect vx vy vw vh = _instanceViewport widgetInst
|
||||
viewport = _wiViewport widgetInst
|
||||
Rect vx vy vw vh = _wiViewport widgetInst
|
||||
sctx@ScrollContext{..} = scrollStatus config wenv state viewport
|
||||
|
||||
scrollAxis reqDelta currScroll childPos vpLimit
|
||||
@ -194,7 +194,7 @@ makeScroll config state = widget where
|
||||
| rectInRect rect viewport = Nothing
|
||||
| otherwise = Just $ resultWidget newInstance
|
||||
where
|
||||
viewport = _instanceViewport widgetInst
|
||||
viewport = _wiViewport widgetInst
|
||||
Rect rx ry rw rh = rect
|
||||
Rect vx vy vw vh = viewport
|
||||
diffL = vx - rx
|
||||
@ -236,9 +236,9 @@ makeScroll config state = widget where
|
||||
|
||||
rebuildWidget wenv newState widgetInst reqs = newInst where
|
||||
newWidget = makeScroll config newState
|
||||
tempInst = widgetInst { _instanceWidget = newWidget }
|
||||
widget = _instanceViewport tempInst
|
||||
renderArea = _instanceRenderArea tempInst
|
||||
tempInst = widgetInst { _wiWidget = newWidget }
|
||||
widget = _wiViewport tempInst
|
||||
renderArea = _wiRenderArea tempInst
|
||||
newInst = scrollResize (Just newWidget) wenv widget renderArea reqs tempInst
|
||||
|
||||
preferredSize wenv widgetInst children reqs = Node sizeReq reqs where
|
||||
@ -247,7 +247,7 @@ makeScroll config state = widget where
|
||||
|
||||
scrollResize uWidget wenv viewport renderArea reqs widgetInst = newInst where
|
||||
Rect l t w h = renderArea
|
||||
child = Seq.index (_instanceChildren widgetInst) 0
|
||||
child = Seq.index (_wiChildren widgetInst) 0
|
||||
childReq = fromMaybe (singleNode def) (Seq.lookup 0 (nodeChildren reqs))
|
||||
|
||||
Size childWidth2 childHeight2 = _srSize $ nodeValue childReq
|
||||
@ -260,14 +260,14 @@ makeScroll config state = widget where
|
||||
_sstReqSize = reqs
|
||||
}
|
||||
newWidget = fromMaybe defWidget uWidget
|
||||
cWidget = _instanceWidget child
|
||||
cWidget = _wiWidget child
|
||||
newChild = _widgetResize cWidget wenv viewport cRenderArea childReq child
|
||||
|
||||
newInst = widgetInst {
|
||||
_instanceViewport = viewport,
|
||||
_instanceRenderArea = renderArea,
|
||||
_instanceWidget = newWidget,
|
||||
_instanceChildren = Seq.singleton newChild
|
||||
_wiViewport = viewport,
|
||||
_wiRenderArea = renderArea,
|
||||
_wiWidget = newWidget,
|
||||
_wiChildren = Seq.singleton newChild
|
||||
}
|
||||
|
||||
render renderer wenv widgetInst = do
|
||||
@ -288,7 +288,7 @@ makeScroll config state = widget where
|
||||
drawRect renderer vThumbRect (Just thumbColorV) Nothing
|
||||
|
||||
where
|
||||
viewport = _instanceViewport widgetInst
|
||||
viewport = _wiViewport widgetInst
|
||||
ScrollContext{..} = scrollStatus config wenv state viewport
|
||||
draggingH = _sstDragging state == Just HBar
|
||||
draggingV = _sstDragging state == Just VBar
|
||||
|
@ -19,12 +19,12 @@ import Monomer.Widget.Util
|
||||
|
||||
hstack :: (Traversable t) => t (WidgetInstance s e) -> WidgetInstance s e
|
||||
hstack children = (defaultWidgetInstance "hstack" (makeStack True)) {
|
||||
_instanceChildren = foldl' (|>) Empty children
|
||||
_wiChildren = foldl' (|>) Empty children
|
||||
}
|
||||
|
||||
vstack :: (Traversable t) => t (WidgetInstance s e) -> WidgetInstance s e
|
||||
vstack children = (defaultWidgetInstance "vstack" (makeStack False)) {
|
||||
_instanceChildren = foldl' (|>) Empty children
|
||||
_wiChildren = foldl' (|>) Empty children
|
||||
}
|
||||
|
||||
makeStack :: Bool -> Widget s e
|
||||
@ -83,7 +83,7 @@ makeStack isHorizontal = widget where
|
||||
FlexibleSize -> (1 + fExtra) * sizeSelector srSize
|
||||
RemainderSize -> rUnit
|
||||
result
|
||||
| not $ _instanceVisible childInstance = emptyRect
|
||||
| not $ _wiVisible childInstance = emptyRect
|
||||
| isHorizontal = hRect
|
||||
| otherwise = vRect
|
||||
|
||||
|
@ -64,7 +64,7 @@ textField_ config = makeInstance $ makeTextField config textFieldState
|
||||
|
||||
makeInstance :: Widget s e -> WidgetInstance s e
|
||||
makeInstance widget = (defaultWidgetInstance "textField" widget) {
|
||||
_instanceFocusable = True
|
||||
_wiFocusable = True
|
||||
}
|
||||
|
||||
makeTextField :: TextFieldConfig s e -> TextFieldState -> Widget s e
|
||||
@ -86,7 +86,7 @@ makeTextField config state = widget where
|
||||
currText = currentValue wenv
|
||||
newState = TextFieldState currText 0
|
||||
newInstance = widgetInst {
|
||||
_instanceWidget = makeTextField config newState
|
||||
_wiWidget = makeTextField config newState
|
||||
}
|
||||
|
||||
merge wenv oldState widgetInst = resultWidget newInstance where
|
||||
@ -96,7 +96,7 @@ makeTextField config state = widget where
|
||||
| otherwise -> oldPos
|
||||
newState = TextFieldState currText newPos
|
||||
newInstance = widgetInst {
|
||||
_instanceWidget = makeTextField config newState
|
||||
_wiWidget = makeTextField config newState
|
||||
}
|
||||
|
||||
handleKeyPress txt tp code
|
||||
@ -108,13 +108,13 @@ makeTextField config state = widget where
|
||||
|
||||
handleEvent wenv target evt widgetInst = case evt of
|
||||
Click (Point x y) _ -> Just $ resultReqs reqs widgetInst where
|
||||
reqs = [SetFocus $ _instancePath widgetInst]
|
||||
reqs = [SetFocus $ _wiPath widgetInst]
|
||||
|
||||
KeyAction mod code KeyPressed -> Just $ resultReqs reqs newInstance where
|
||||
(newText, newPos) = handleKeyPress currText currPos code
|
||||
isPaste = isClipboardPaste wenv evt
|
||||
isCopy = isClipboardCopy wenv evt
|
||||
reqGetClipboard = [GetClipboard (_instancePath widgetInst) | isPaste]
|
||||
reqGetClipboard = [GetClipboard (_wiPath widgetInst) | isPaste]
|
||||
reqSetClipboard = [SetClipboard (ClipboardText currText) | isCopy]
|
||||
reqUpdateModel
|
||||
| currText /= newText = widgetValueSet (_tfcValue config) newText
|
||||
@ -122,7 +122,7 @@ makeTextField config state = widget where
|
||||
reqs = reqGetClipboard ++ reqSetClipboard ++ reqUpdateModel
|
||||
newState = TextFieldState newText newPos
|
||||
newInstance = widgetInst {
|
||||
_instanceWidget = makeTextField config newState
|
||||
_wiWidget = makeTextField config newState
|
||||
}
|
||||
|
||||
TextInput newText -> insertText wenv widgetInst newText
|
||||
@ -137,16 +137,16 @@ makeTextField config state = widget where
|
||||
newState = TextFieldState newText newPos
|
||||
reqs = widgetValueSet (_tfcValue config) newText
|
||||
newInst = widgetInst {
|
||||
_instanceWidget = makeTextField config newState
|
||||
_wiWidget = makeTextField config newState
|
||||
}
|
||||
|
||||
preferredSize wenv widgetInst = singleNode sizeReq where
|
||||
Style{..} = _instanceStyle widgetInst
|
||||
Style{..} = _wiStyle widgetInst
|
||||
size = getTextBounds wenv _styleText currText
|
||||
sizeReq = SizeReq size FlexibleSize StrictSize
|
||||
|
||||
render renderer wenv widgetInst = do
|
||||
drawStyledBackground renderer renderArea _instanceStyle
|
||||
drawStyledBackground renderer renderArea _wiStyle
|
||||
Rect tl tt _ _ <- drawText renderer renderArea textStyle currText
|
||||
|
||||
when (isFocused wenv widgetInst) $ do
|
||||
@ -156,8 +156,8 @@ makeTextField config state = widget where
|
||||
where
|
||||
WidgetInstance{..} = widgetInst
|
||||
ts = _weTimestamp wenv
|
||||
renderArea@(Rect rl rt rw rh) = _instanceRenderArea
|
||||
textStyle = _styleText _instanceStyle
|
||||
renderArea@(Rect rl rt rw rh) = _wiRenderArea
|
||||
textStyle = _styleText _wiStyle
|
||||
caretAlpha
|
||||
| isFocused wenv widgetInst = fromIntegral (ts `mod` 1000) / 1000.0
|
||||
| otherwise = 0
|
||||
|
@ -36,13 +36,13 @@ mockWenv model = WidgetEnv {
|
||||
|
||||
initWidget :: WidgetEnv s e -> WidgetInstance s e -> WidgetInstance s e
|
||||
initWidget wenv inst = newInst where
|
||||
WidgetResult _ _ inst2 = _widgetInit (_instanceWidget inst) wenv inst
|
||||
WidgetResult _ _ inst2 = _widgetInit (_wiWidget inst) wenv inst
|
||||
Size w h = _weScreenSize wenv
|
||||
vp = Rect 0 0 w h
|
||||
reqs = _widgetPreferredSize (_instanceWidget inst2) wenv inst2
|
||||
newInst = _widgetResize (_instanceWidget inst2) wenv vp vp reqs inst2
|
||||
reqs = _widgetPreferredSize (_wiWidget inst2) wenv inst2
|
||||
newInst = _widgetResize (_wiWidget inst2) wenv vp vp reqs inst2
|
||||
|
||||
instancePreferredSize :: WidgetEnv s e -> WidgetInstance s e -> SizeReq
|
||||
instancePreferredSize wenv inst = nodeValue reqs where
|
||||
widget = _instanceWidget inst
|
||||
widget = _wiWidget inst
|
||||
reqs = _widgetPreferredSize widget wenv inst
|
||||
|
@ -35,7 +35,7 @@ handleEvent = describe "handleEvent" $ do
|
||||
where
|
||||
wenv = mockWenv ()
|
||||
btn = initWidget wenv (button BtnClick "Click")
|
||||
widget = _instanceWidget btn
|
||||
widget = _wiWidget btn
|
||||
click p = _widgetHandleEvent widget wenv rootPath (Click p LeftBtn) btn
|
||||
events p = maybe Seq.empty _wrEvents (click p)
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user