fjvallarino/monomer
1
1
Fork 0
mirror of https://github.com/fjvallarino/monomer.git synced 2024-11-10 11:21:50 +03:00
Code Issues Projects Releases Wiki Activity

Improve naming convention of node related utility functions

Browse Source
This commit is contained in:
Francisco Vallarino 2021-01-15 14:41:17 -03:00
parent 4280524c51
commit 4b88a3a369
14 changed files with 57 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Monomer/Event/Util.hs
View File

@ -14,12 +14,6 @@ isButtonPressed inputStatus button = status == PressedBtn where
currentStatus = M.lookup button (_ipsButtons inputStatus)
status = fromMaybe ReleasedBtn currentStatus
isButtonPressedInRect :: InputStatus -> Button -> Rect -> Bool
isButtonPressedInRect inputStatus button rect = pressed && inRect where
mousePos = _ipsMousePos inputStatus
inRect = pointInRect mousePos rect
pressed = isButtonPressed inputStatus button
getKeyStatus :: InputStatus -> KeyCode -> KeyStatus
getKeyStatus inputStatus code = status where
keys = _ipsKeys inputStatus

6
src/Monomer/Widgets/Button.hs
View File

@ -217,14 +217,14 @@ makeButton config state = widget where
where
isSelectKey code = isKeyReturn code || isKeySpace code
Click p _
| pointInViewport p node -> Just result
| isPointInNodeVp p node -> Just result
ButtonAction p btn ReleasedBtn clicks
| mainBtn btn && focused && pointInVp p && clicks > 1 -> Just result
_ -> Nothing
where
mainBtn btn = btn == wenv ^. L.mainButton
focused = isFocused wenv node
pointInVp p = pointInViewport p node
focused = isNodeFocused wenv node
pointInVp p = isPointInNodeVp p node
requests = _btnOnClickReq config
events = _btnOnClick config
result = resultReqsEvts node requests events

2
src/Monomer/Widgets/Checkbox.hs
View File

@ -130,7 +130,7 @@ makeCheckbox widgetData config = widget where
Focus -> handleFocusChange _ckcOnFocus _ckcOnFocusReq config node
Blur -> handleFocusChange _ckcOnBlur _ckcOnBlurReq config node
Click p _
| pointInViewport p node -> Just $ resultReqsEvts node clickReqs events
| isPointInNodeVp p node -> Just $ resultReqsEvts node clickReqs events
KeyAction mod code KeyPressed
| isSelectKey code -> Just $ resultReqsEvts node reqs events
_ -> Nothing

2
src/Monomer/Widgets/Container.hs
View File

@ -563,7 +563,7 @@ findByPointWrapper container wenv start point node = result where
ignoreEmpty = containerIgnoreEmptyArea container
handler = containerFindByPoint container
isVisible = node ^. L.info . L.visible
inVp = pointInViewport point node
inVp = isPointInNodeVp point node
path = node ^. L.info . L.path
children = node ^. L.children
newStartPath = Seq.drop 1 start

14
src/Monomer/Widgets/InputField.hs
View File

@ -303,7 +303,7 @@ makeInputField config state = widget where
-- Enter regular edit mode if widget has custom drag handler
DblClick point btn
| dragHandleExt btn -> Just (resultReqs node reqs) where
focusReq = [SetFocus path | not (isFocused wenv node)]
focusReq = [SetFocus path | not (isNodeFocused wenv node)]
reqs = SetCursorIcon CursorIBeam : focusReq
-- Begin regular text selection
@ -315,7 +315,7 @@ makeInputField config state = widget where
newState = newTextState wenv node state currVal currText newPos Nothing
newNode = node
& L.widget .~ makeInputField config newState
newReqs = [ SetFocus path | not (isFocused wenv node) ]
newReqs = [ SetFocus path | not (isNodeFocused wenv node) ]
result = resultReqs newNode newReqs
-- Begin custom drag
@ -359,7 +359,7 @@ makeInputField config state = widget where
-- Handle regular text selection
Move point
| isPressed wenv node && dragSelActive -> Just result where
| isNodePressed wenv node && dragSelActive -> Just result where
style = activeStyle wenv node
contentArea = getContentArea style node
newPos = findClosestGlyphPos state point
@ -371,7 +371,7 @@ makeInputField config state = widget where
-- Handle custom drag
Move point
| isPressed wenv node && not dragSelActive -> Just result where
| isNodePressed wenv node && not dragSelActive -> Just result where
(_, stPoint) = fromJust $ wenv ^. L.mainBtnPress
handlerRes = fromJust dragHandler state stPoint point
(newText, newPos, newSel) = handlerRes
@ -430,7 +430,7 @@ makeInputField config state = widget where
where
path = node ^. L.info . L.path
viewport = node ^. L.info . L.viewport
focused = isFocused wenv node
focused = isNodeFocused wenv node
dragSelectText btn
= wenv ^. L.mainButton == btn
&& dragSelActive
@ -534,9 +534,9 @@ makeInputField config state = widget where
nglyphs = Seq.length currGlyphs
glyph idx = Seq.index currGlyphs (min idx (nglyphs - 1))
ts = _weTimestamp wenv
selRequired = isFocused wenv node
selRequired = isNodeFocused wenv node
selColor = styleHlColor style
caretRequired = isFocused wenv node && ts `mod` 1000 < 500
caretRequired = isNodeFocused wenv node && ts `mod` 1000 < 500
caretColor = styleFontColor style
caretPos
| currPos == 0 = 0

2
src/Monomer/Widgets/ListView.hs
View File

@ -339,7 +339,7 @@ makeListView widgetData items makeRow config state = widget where
focusReq = SetFocus $ node ^. L.info . L.path
tempResult = selectItem wenv node idx
result
| isFocused wenv node = tempResult
| isNodeFocused wenv node = tempResult
| otherwise = tempResult & L.requests %~ (|> focusReq)
highlightItem wenv node nextIdx = Just result where

4
src/Monomer/Widgets/Radio.hs
View File

@ -136,7 +136,7 @@ makeRadio field option config = widget where
getActiveStyle wenv node = style where
radioArea = getRadioArea wenv node config
style = activeStyle_ (isHoveredEllipse_ radioArea) wenv node
style = activeStyle_ (isNodeHoveredEllipse_ radioArea) wenv node
handleEvent wenv target evt node = case evt of
Focus -> handleFocusChange _rdcOnFocus _rdcOnFocusReq config node
@ -171,7 +171,7 @@ makeRadio field option config = widget where
value = widgetDataGet model field
radioArea = getRadioArea wenv node config
radioBW = max 1 (_rW radioArea * 0.1)
style_ = activeStyle_ (isHoveredEllipse_ radioArea) wenv node
style_ = activeStyle_ (isNodeHoveredEllipse_ radioArea) wenv node
fgColor = styleFgColor style_
getRadioArea :: WidgetEnv s e -> WidgetNode s e -> RadioCfg s e a -> Rect

2
src/Monomer/Widgets/Scroll.hs
View File

@ -455,7 +455,7 @@ makeScroll config state = widget where
scrollActiveStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
scrollActiveStyle wenv node
| isFocused wenv child = focusedStyle wenv node
| isNodeFocused wenv child = focusedStyle wenv node
| otherwise = activeStyle wenv node
where
child = node ^. L.children ^?! ix 0

2
src/Monomer/Widgets/Single.hs
View File

@ -294,7 +294,7 @@ defaultFindNextFocus wenv direction startFrom node
defaultFindByPoint :: SingleFindByPointHandler s e
defaultFindByPoint wenv path point node
| isVisible && pointInViewport point node = Just path
| isVisible && isPointInNodeVp point node = Just path
| otherwise = Nothing
where
isVisible = node ^. L.info . L.visible

2
src/Monomer/Widgets/Split.hs
View File

@ -96,7 +96,7 @@ makeSplit isHorizontal config state = widget where
vp = node ^. L.info . L.viewport
ra = node ^. L.info . L.renderArea
isTarget = target == node ^. L.info . L.path
isDragging = isPressed wenv node
isDragging = isNodePressed wenv node
isHandle p = pointInRect p handleRect
cursorIconReq
| isHorizontal = SetCursorIcon CursorSizeH

12
src/Monomer/Widgets/Util/Focus.hs
View File

@ -1,7 +1,7 @@
module Monomer.Widgets.Util.Focus (
isNodeFocused,
parentPath,
nextTargetStep,
isFocused,
isFocusCandidate,
isTargetReached,
isTargetValid,
@ -25,6 +25,9 @@ import Monomer.Widgets.Util.Widget
import qualified Monomer.Lens as L
isNodeFocused :: WidgetEnv s e -> WidgetNode s e -> Bool
isNodeFocused wenv node = wenv ^. L.focusedPath == node ^. L.info . L.path
parentPath :: WidgetNode s e -> Path
parentPath node = Seq.take (Seq.length path - 1) path where
path = node ^. L.info . L.path
@ -34,9 +37,6 @@ nextTargetStep target node = nextStep where
currentPath = node ^. L.info . L.path
nextStep = Seq.lookup (Seq.length currentPath) target
isFocused :: WidgetEnv s e -> WidgetNode s e -> Bool
isFocused wenv node = wenv ^. L.focusedPath == node ^. L.info . L.path
isFocusCandidate :: FocusDirection -> Path -> WidgetNode s e -> Bool
isFocusCandidate FocusFwd = isFocusFwdCandidate
isFocusCandidate FocusBwd = isFocusBwdCandidate
@ -105,8 +105,8 @@ handleFocusRequest wenv evt node mResult = newResult where
_ -> Nothing
isFocusReq = btnPressed == Just (wenv ^. L.mainButton)
&& isFocusable
&& not (isFocused wenv node)
&& isTopLevel wenv node
&& not (isNodeFocused wenv node)
&& isNodeTopLevel wenv node
&& isNothing (Seq.findIndexL isFocusRequest prevReqs)
focusReq = SetFocus (node ^. L.info . L.path)
newResult

48
src/Monomer/Widgets/Util/Hover.hs
View File

@ -1,11 +1,10 @@
module Monomer.Widgets.Util.Hover (
pointInViewport,
isMainBtnPressed,
isPressed,
isHovered,
isHoveredEllipse_,
isTopLevel,
isInOverlay
isPointInNodeVp,
isNodePressed,
isNodeHovered,
isNodeHoveredEllipse_,
isNodeTopLevel,
isNodeInOverlay
) where
import Control.Lens ((&), (^.), (^?), _1, _Just)
@ -21,42 +20,37 @@ import Monomer.Graphics.Types
import qualified Monomer.Lens as L
pointInViewport :: Point -> WidgetNode s e -> Bool
pointInViewport p node = pointInRect p (node ^. L.info . L.viewport)
isPointInNodeVp :: Point -> WidgetNode s e -> Bool
isPointInNodeVp p node = pointInRect p (node ^. L.info . L.viewport)
isMainBtnPressed :: WidgetEnv s e -> WidgetNode s e -> Bool
isMainBtnPressed wenv node = isPressed where
inputStatus = wenv ^. L.inputStatus
mainBtn = wenv ^. L.mainButton
viewport = node ^. L.info . L.viewport
isPressed = isButtonPressedInRect inputStatus mainBtn viewport
isPressed :: WidgetEnv s e -> WidgetNode s e -> Bool
isPressed wenv node = Just path == pressed where
isNodePressed :: WidgetEnv s e -> WidgetNode s e -> Bool
isNodePressed wenv node = Just path == pressed where
path = node ^. L.info . L.path
pressed = wenv ^. L.mainBtnPress ^? _Just . _1
isHovered :: WidgetEnv s e -> WidgetNode s e -> Bool
isHovered wenv node = validPos && validPress && isTopLevel wenv node where
isNodeHovered :: WidgetEnv s e -> WidgetNode s e -> Bool
isNodeHovered wenv node = validPos && validPress && topLevel where
viewport = node ^. L.info . L.viewport
mousePos = wenv ^. L.inputStatus . L.mousePos
validPos = pointInRect mousePos viewport
pressed = wenv ^. L.mainBtnPress ^? _Just . _1
validPress = isNothing pressed || isPressed wenv node
validPress = isNothing pressed || isNodePressed wenv node
topLevel = isNodeTopLevel wenv node
isHoveredEllipse_ :: Rect -> WidgetEnv s e -> WidgetNode s e -> Bool
isHoveredEllipse_ area wenv node = validPos && isTopLevel wenv node where
isNodeHoveredEllipse_ :: Rect -> WidgetEnv s e -> WidgetNode s e -> Bool
isNodeHoveredEllipse_ area wenv node = validPos && topLevel where
mousePos = wenv ^. L.inputStatus . L.mousePos
validPos = pointInEllipse mousePos area
topLevel = isNodeTopLevel wenv node
isTopLevel :: WidgetEnv s e -> WidgetNode s e -> Bool
isTopLevel wenv node = maybe inTopLayer isPrefix (wenv ^. L.overlayPath) where
isNodeTopLevel :: WidgetEnv s e -> WidgetNode s e -> Bool
isNodeTopLevel wenv node = maybe inTopLayer isPrefix (wenv ^. L.overlayPath) where
mousePos = wenv ^. L.inputStatus . L.mousePos
inTopLayer = wenv ^. L.inTopLayer $ mousePos
path = node ^. L.info . L.path
isPrefix parent = Seq.take (Seq.length parent) path == parent
isInOverlay :: WidgetEnv s e -> WidgetNode s e -> Bool
isInOverlay wenv node = maybe False isPrefix (wenv ^. L.overlayPath) where
isNodeInOverlay :: WidgetEnv s e -> WidgetNode s e -> Bool
isNodeInOverlay wenv node = maybe False isPrefix (wenv ^. L.overlayPath) where
path = node ^. L.info . L.path
isPrefix overlayPath = Seq.take (Seq.length overlayPath) path == overlayPath

21
src/Monomer/Widgets/Util/Style.hs
View File

@ -35,7 +35,7 @@ import qualified Monomer.Lens as L
-- Do not use in findByPoint
activeStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
activeStyle wenv node = activeStyle_ isHovered wenv node
activeStyle wenv node = activeStyle_ isNodeHovered wenv node
activeStyle_ :: IsHovered s e -> WidgetEnv s e -> WidgetNode s e -> StyleState
activeStyle_ isHoveredFn wenv node = fromMaybe def styleState where
@ -43,18 +43,18 @@ activeStyle_ isHoveredFn wenv node = fromMaybe def styleState where
mousePos = wenv ^. L.inputStatus . L.mousePos
isEnabled = node ^. L.info . L.enabled
isHover = isHoveredFn wenv node
isFocus = isFocused wenv node
isPressed = isMainBtnPressed wenv node
isFocus = isNodeFocused wenv node
isPress = isNodePressed wenv node
styleState
| not isEnabled = _styleDisabled
| isHover && isPressed = _styleActive
| isHover && isPress = _styleActive
| isHover && isFocus = _styleFocusHover
| isHover = _styleHover
| isFocus = _styleFocus
| otherwise = _styleBasic
focusedStyle :: WidgetEnv s e -> WidgetNode s e -> StyleState
focusedStyle wenv node = focusedStyle_ isHovered wenv node
focusedStyle wenv node = focusedStyle_ isNodeHovered wenv node
focusedStyle_ :: IsHovered s e -> WidgetEnv s e -> WidgetNode s e -> StyleState
focusedStyle_ isHoveredFn wenv node = fromMaybe def styleState where
@ -65,7 +65,7 @@ focusedStyle_ isHoveredFn wenv node = fromMaybe def styleState where
| otherwise = _styleFocus
activeTheme :: WidgetEnv s e -> WidgetNode s e -> ThemeState
activeTheme wenv node = activeTheme_ isHovered wenv node
activeTheme wenv node = activeTheme_ isNodeHovered wenv node
activeTheme_ :: IsHovered s e -> WidgetEnv s e -> WidgetNode s e -> ThemeState
activeTheme_ isHoveredFn wenv node = themeState where
@ -73,11 +73,11 @@ activeTheme_ isHoveredFn wenv node = themeState where
mousePos = wenv ^. L.inputStatus . L.mousePos
isEnabled = node ^. L.info . L.enabled
isHover = isHoveredFn wenv node
isFocus = isFocused wenv node
isPressed = isMainBtnPressed wenv node
isFocus = isNodeFocused wenv node
isPress = isNodePressed wenv node
themeState
| not isEnabled = _themeDisabled theme
| isHover && isPressed = _themeActive theme
| isHover && isPress = _themeActive theme
| isHover = _themeHover theme
| isFocus = _themeFocus theme
| otherwise = _themeBasic theme
@ -156,7 +156,8 @@ handleCursorChange wenv target evt style cfg node = reqs where
isCursorEvt = cfg ^. L.cursorEvt
isTarget = node ^. L.info . L.path == target
curIcon = wenv ^. L.currentCursor
notInOverlay = isJust (wenv ^. L.overlayPath) && not (isInOverlay wenv node)
inOverlay = isNodeInOverlay wenv node
notInOverlay = isJust (wenv ^. L.overlayPath) && not inOverlay
newIcon
| notInOverlay = CursorArrow
| otherwise = fromMaybe CursorArrow (style ^. L.cursorIcon <|> cfgIcon)

2
src/Monomer/Widgets/ZStack.hs
View File

@ -73,7 +73,7 @@ makeZStack config = widget where
children = newNode ^. L.children
focusedPath = wenv ^. L.focusedPath
isFocusParent = isWidgetParentOfPath focusedPath newNode
topLevel = isTopLevel wenv newNode
topLevel = isNodeTopLevel wenv newNode
childrenChanged = visibleChildrenChanged oldNode newNode
topVisibleIdx = fromMaybe 0 (Seq.findIndexL (^.L.info . L.visible) children)
needsFocus = isFocusParent && topLevel && childrenChanged