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

Add previous/next path to Focus/Blur events

Browse Source
This commit is contained in:
Francisco Vallarino 2021-05-04 17:51:55 -03:00
parent d36f777bc6
commit 1a4a41e82c
21 changed files with 114 additions and 105 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
app/Main.hs
View File

@ -139,8 +139,8 @@ handleAppEvent wenv node model evt = case evt of
]
IgnoreEvt -> []
UpdateColor col -> trace "Change" []
FocusColor -> trace "Focus" []
BlurColor -> trace "Blur" []
FocusColor prev -> trace "Focus" []
BlurColor next -> trace "Blur" []
_ -> []
buildUI :: WidgetEnv App AppEvent -> App -> WidgetNode App AppEvent

4
app/Types.hs
View File

@ -109,6 +109,6 @@ data AppEvent
| StartAnimation
| StopAnimation
| UpdateColor Color
| FocusColor
| BlurColor
| FocusColor Path
| BlurColor Path
deriving (Eq, Show)

8
src/Monomer/Core/Combinators.hs
View File

@ -171,14 +171,14 @@ class CmbOnDispose t e | t -> e where
class CmbOnResize t a e | t -> e where
onResize :: (a -> e) -> t
class CmbOnFocus t e | t -> e where
onFocus :: e -> t
class CmbOnFocus t e a | t -> e a where
onFocus :: (a -> e) -> t
class CmbOnFocusReq t s e | t -> s e where
onFocusReq :: WidgetRequest s e -> t
class CmbOnBlur t e | t -> e where
onBlur :: e -> t
class CmbOnBlur t e a | t -> e a where
onBlur :: (a -> e) -> t
class CmbOnBlurReq t s e | t -> s e where
onBlurReq :: WidgetRequest s e -> t

4
src/Monomer/Event/Types.hs
View File

@ -63,8 +63,8 @@ data SystemEvent
| KeyAction KeyMod KeyCode KeyStatus
| TextInput Text
| Clipboard ClipboardData
| Focus
| Blur
| Focus Path -- Previous target
| Blur Path -- Next target
| Enter Point
| Move Point
| Leave Point

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

@ -85,11 +85,11 @@ isAltPressed :: KeyMod -> Bool
isAltPressed keyMod = _kmLeftAlt keyMod || _kmRightAlt keyMod
isOnFocus :: SystemEvent -> Bool
isOnFocus Focus = True
isOnFocus Focus{} = True
isOnFocus _ = False
isOnBlur :: SystemEvent -> Bool
isOnBlur Blur = True
isOnBlur Blur{} = True
isOnBlur _ = False
isOnEnter :: SystemEvent -> Bool

20
src/Monomer/Main/Handlers.hs
View File

@ -68,8 +68,8 @@ getTargetPath wenv root pressed overlay target event = case event of
Click{} -> pathEvent target
DblClick{} -> pathEvent target
WheelScroll point _ _ -> pointEvent point
Focus -> pathEvent target
Blur -> pathEvent target
Focus{} -> pathEvent target
Blur{} -> pathEvent target
Enter{} -> pathEvent target
Move point -> pointEvent point
Leave{} -> pathEvent target
@ -282,8 +282,11 @@ handleMoveFocus
-> m (HandlerStep s e)
handleMoveFocus startFromWid dir (wenv, root, reqs) = do
oldFocus <- getFocusedPath
let wenv0 = wenv & L.focusedPath .~ emptyPath
(wenv1, root1, reqs1) <- handleSystemEvent wenv0 root Blur oldFocus
tmpOverlay <- getOverlayPath
let tmpFocusWni = findNextFocus wenv dir oldFocus tmpOverlay root
let tmpFocus = tmpFocusWni ^. L.path
let blurEvt = Blur tmpFocus
(wenv1, root1, reqs1) <- handleSystemEvent wenv root blurEvt oldFocus
currFocus <- getFocusedPath
currOverlay <- getOverlayPath
@ -294,10 +297,11 @@ handleMoveFocus startFromWid dir (wenv, root, reqs) = do
let newFocusWni = findNextFocus wenv1 dir searchFrom currOverlay root1
let newFocus = newFocusWni ^. L.path
let wenvF = wenv1 & L.focusedPath .~ newFocus
let focusEvt = Focus oldFocus
L.focusedWidgetId .= newFocusWni ^. L.widgetId
L.renderRequested .= True
(wenv2, root2, reqs2) <- handleSystemEvent wenvF root1 Focus newFocus
(wenv2, root2, reqs2) <- handleSystemEvent wenvF root1 focusEvt newFocus
return (wenv2, root2, reqs <> reqs1 <> reqs2)
else
@ -312,12 +316,14 @@ handleSetFocus newFocusWid (wenv, root, reqs) = do
if oldFocus /= newFocus
then do
let wenv0 = wenv & L.focusedPath .~ newFocus
(wenv1, root1, reqs1) <- handleSystemEvent wenv0 root Blur oldFocus
let blurEvt = Blur newFocus
(wenv1, root1, reqs1) <- handleSystemEvent wenv0 root blurEvt oldFocus
let wenvF = wenv1 & L.focusedPath .~ newFocus
let focusEvt = Focus oldFocus
L.focusedWidgetId .= newFocusWid
L.renderRequested .= True
(wenv2, root2, reqs2) <- handleSystemEvent wenvF root1 Focus newFocus
(wenv2, root2, reqs2) <- handleSystemEvent wenvF root1 focusEvt newFocus
return (wenv2, root2, reqs <> reqs1 <> reqs2)
else

20
src/Monomer/Widgets/Containers/Dropdown.hs
View File

@ -41,9 +41,9 @@ data DropdownCfg s e a = DropdownCfg {
_ddcListStyle :: Maybe Style,
_ddcItemStyle :: Maybe Style,
_ddcItemSelectedStyle :: Maybe Style,
_ddcOnFocus :: [e],
_ddcOnFocus :: [Path -> e],
_ddcOnFocusReq :: [WidgetRequest s e],
_ddcOnBlur :: [e],
_ddcOnBlur :: [Path -> e],
_ddcOnBlurReq :: [WidgetRequest s e],
_ddcOnChange :: [a -> e],
_ddcOnChangeReq :: [WidgetRequest s e],
@ -86,7 +86,7 @@ instance Semigroup (DropdownCfg s e a) where
instance Monoid (DropdownCfg s e a) where
mempty = def
instance CmbOnFocus (DropdownCfg s e a) e where
instance CmbOnFocus (DropdownCfg s e a) e Path where
onFocus fn = def {
_ddcOnFocus = [fn]
}
@ -96,7 +96,7 @@ instance CmbOnFocusReq (DropdownCfg s e a) s e where
_ddcOnFocusReq = [req]
}
instance CmbOnBlur (DropdownCfg s e a) e where
instance CmbOnBlur (DropdownCfg s e a) e Path where
onBlur fn = def {
_ddcOnBlur = [fn]
}
@ -290,17 +290,17 @@ makeDropdown widgetData items makeMain makeRow config state = widget where
| not isOpen && isPointInNodeVp point mainNode = Just mainIdx
| otherwise = Nothing
ddFocusChange evts reqs node = Just newResult where
tmpResult = handleFocusChange evts reqs config node
ddFocusChange evts reqs prev node = Just newResult where
tmpResult = handleFocusChange evts reqs config prev node
newResult = fromMaybe (resultWidget node) tmpResult
& L.requests %~ (|> IgnoreChildrenEvents)
handleEvent wenv node target evt = case evt of
Focus
| not isOpen -> ddFocusChange _ddcOnFocus _ddcOnFocusReq node
Blur
Focus prev
| not isOpen -> ddFocusChange _ddcOnFocus _ddcOnFocusReq prev node
Blur next
| not isOpen && not (seqStartsWith path focusedPath)
-> ddFocusChange _ddcOnBlur _ddcOnBlurReq node
-> ddFocusChange _ddcOnBlur _ddcOnBlurReq next node
Enter{} -> Just result where
newIcon = fromMaybe CursorHand (style ^. L.cursorIcon)
result = resultReqs node [SetCursorIcon widgetId CursorHand]

14
src/Monomer/Widgets/Containers/ListView.hs
View File

@ -45,9 +45,9 @@ data ListViewCfg s e a = ListViewCfg {
_lvcItemStyle :: Maybe Style,
_lvcItemSelectedStyle :: Maybe Style,
_lvcMergeRequired :: Maybe (Seq a -> Seq a -> Bool),
_lvcOnFocus :: [e],
_lvcOnFocus :: [Path -> e],
_lvcOnFocusReq :: [WidgetRequest s e],
_lvcOnBlur :: [e],
_lvcOnBlur :: [Path -> e],
_lvcOnBlurReq :: [WidgetRequest s e],
_lvcOnChange :: [a -> e],
_lvcOnChangeReq :: [WidgetRequest s e],
@ -90,7 +90,7 @@ instance Semigroup (ListViewCfg s e a) where
instance Monoid (ListViewCfg s e a) where
mempty = def
instance CmbOnFocus (ListViewCfg s e a) e where
instance CmbOnFocus (ListViewCfg s e a) e Path where
onFocus fn = def {
_lvcOnFocus = [fn]
}
@ -100,7 +100,7 @@ instance CmbOnFocusReq (ListViewCfg s e a) s e where
_lvcOnFocusReq = [req]
}
instance CmbOnBlur (ListViewCfg s e a) e where
instance CmbOnBlur (ListViewCfg s e a) e Path where
onBlur fn = def {
_lvcOnBlur = [fn]
}
@ -297,14 +297,14 @@ makeListView widgetData items makeRow config state = widget where
ButtonAction _ btn PressedBtn _
| btn == wenv ^. L.mainButton -> result where
result = Just $ resultReqs node [SetFocus (node ^. L.info . L.widgetId)]
Focus -> handleFocusChange _lvcOnFocus _lvcOnFocusReq config node
Blur -> result where
Focus prev -> handleFocusChange _lvcOnFocus _lvcOnFocusReq config prev node
Blur next -> result where
isTabPressed = getKeyStatus (_weInputStatus wenv) keyTab == KeyPressed
changeReq = isTabPressed && _lvcSelectOnBlur config == Just True
WidgetResult tempNode tempReqs
| changeReq = selectItem wenv node (_hlIdx state)
| otherwise = resultWidget node
evts = RaiseEvent <$> Seq.fromList (_lvcOnBlur config)
evts = RaiseEvent <$> Seq.fromList (($ next) <$> _lvcOnBlur config)
reqs = tempReqs <> Seq.fromList (_lvcOnBlurReq config)
mergedResult = Just $ WidgetResult tempNode (reqs <> evts)
result

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

@ -265,7 +265,7 @@ makeScroll config state = widget where
& L.widget .~ makeScroll config oldState
handleEvent wenv node target evt = case evt of
Focus -> result where
Focus{} -> result where
follow = fromMaybe (theme ^. L.scrollFollowFocus) (_scFollowFocus config)
focusPath = wenv ^. L.focusedPath
focusInst = widgetFindByPath (node ^. L.widget) wenv node focusPath

12
src/Monomer/Widgets/Singles/Button.hs
View File

@ -35,9 +35,9 @@ data ButtonCfg s e = ButtonCfg {
_btnTextMaxLines :: Maybe Int,
_btnFactorW :: Maybe Double,
_btnFactorH :: Maybe Double,
_btnOnFocus :: [e],
_btnOnFocus :: [Path -> e],
_btnOnFocusReq :: [WidgetRequest s e],
_btnOnBlur :: [e],
_btnOnBlur :: [Path -> e],
_btnOnBlurReq :: [WidgetRequest s e],
_btnOnClick :: [e],
_btnOnClickReq :: [WidgetRequest s e]
@ -100,7 +100,7 @@ instance CmbMaxLines (ButtonCfg s e) where
_btnTextMaxLines = Just count
}
instance CmbOnFocus (ButtonCfg s e) e where
instance CmbOnFocus (ButtonCfg s e) e Path where
onFocus fn = def {
_btnOnFocus = [fn]
}
@ -110,7 +110,7 @@ instance CmbOnFocusReq (ButtonCfg s e) s e where
_btnOnFocusReq = [req]
}
instance CmbOnBlur (ButtonCfg s e) e where
instance CmbOnBlur (ButtonCfg s e) e Path where
onBlur fn = def {
_btnOnBlur = [fn]
}
@ -216,8 +216,8 @@ makeButton caption config = widget where
result = resultWidget (createChildNode wenv node)
handleEvent wenv node target evt = case evt of
Focus -> handleFocusChange _btnOnFocus _btnOnFocusReq config node
Blur -> handleFocusChange _btnOnBlur _btnOnBlurReq config node
Focus prev -> handleFocusChange _btnOnFocus _btnOnFocusReq config prev node
Blur next -> handleFocusChange _btnOnBlur _btnOnBlurReq config next node
KeyAction mode code status
| isSelectKey code && status == KeyPressed -> Just result
where

12
src/Monomer/Widgets/Singles/Checkbox.hs
View File

@ -32,9 +32,9 @@ data CheckboxMark
data CheckboxCfg s e = CheckboxCfg {
_ckcMark :: Maybe CheckboxMark,
_ckcWidth :: Maybe Double,
_ckcOnFocus :: [e],
_ckcOnFocus :: [Path -> e],
_ckcOnFocusReq :: [WidgetRequest s e],
_ckcOnBlur :: [e],
_ckcOnBlur :: [Path -> e],
_ckcOnBlurReq :: [WidgetRequest s e],
_ckcOnChange :: [Bool -> e],
_ckcOnChangeReq :: [WidgetRequest s e]
@ -72,7 +72,7 @@ instance CmbWidth (CheckboxCfg s e) where
_ckcWidth = Just w
}
instance CmbOnFocus (CheckboxCfg s e) e where
instance CmbOnFocus (CheckboxCfg s e) e Path where
onFocus fn = def {
_ckcOnFocus = [fn]
}
@ -82,7 +82,7 @@ instance CmbOnFocusReq (CheckboxCfg s e) s e where
_ckcOnFocusReq = [req]
}
instance CmbOnBlur (CheckboxCfg s e) e where
instance CmbOnBlur (CheckboxCfg s e) e Path where
onBlur fn = def {
_ckcOnBlur = [fn]
}
@ -144,8 +144,8 @@ makeCheckbox widgetData config = widget where
style = collectTheme wenv L.checkboxStyle
handleEvent wenv node target evt = case evt of
Focus -> handleFocusChange _ckcOnFocus _ckcOnFocusReq config node
Blur -> handleFocusChange _ckcOnBlur _ckcOnBlurReq config node
Focus prev -> handleFocusChange _ckcOnFocus _ckcOnFocusReq config prev node
Blur next -> handleFocusChange _ckcOnBlur _ckcOnBlurReq config next node
Click p _
| isPointInNodeVp p node -> Just $ resultReqsEvts node reqs events
KeyAction mod code KeyPressed

29
src/Monomer/Widgets/Singles/ColorPicker.hs
View File

@ -11,6 +11,8 @@ module Monomer.Widgets.Singles.ColorPicker (
colorPickerD_
) where
import Debug.Trace
import Control.Applicative ((<|>))
import Control.Lens ((&), (^.), (.~), ALens', abbreviatedFields, makeLensesWith)
import Data.Default
@ -32,9 +34,9 @@ import qualified Monomer.Lens as L
data ColorPickerCfg s e = ColorPickerCfg {
_cpcShowAlpha :: Maybe Bool,
_cpcOnFocus :: [e],
_cpcOnFocus :: [Path -> e],
_cpcOnFocusReq :: [WidgetRequest s e],
_cpcOnBlur :: [e],
_cpcOnBlur :: [Path -> e],
_cpcOnBlurReq :: [WidgetRequest s e],
_cpcOnChange :: [Color -> e],
_cpcOnChangeReq :: [WidgetRequest s e]
@ -65,7 +67,7 @@ instance Semigroup (ColorPickerCfg s e) where
instance Monoid (ColorPickerCfg s e) where
mempty = def
instance CmbOnFocus (ColorPickerCfg s e) e where
instance CmbOnFocus (ColorPickerCfg s e) e Path where
onFocus fn = def {
_cpcOnFocus = [fn]
}
@ -75,7 +77,7 @@ instance CmbOnFocusReq (ColorPickerCfg s e) s e where
_cpcOnFocusReq = [req]
}
instance CmbOnBlur (ColorPickerCfg s e) e where
instance CmbOnBlur (ColorPickerCfg s e) e Path where
onBlur fn = def {
_cpcOnBlur = [fn]
}
@ -101,8 +103,8 @@ colorPickerAlpha show = def {
}
data ColorPickerEvt
= PickerFocus
| PickerBlur
= PickerFocus Path
| PickerBlur Path
| ColorChanged Int
| AlphaChanged Double
deriving (Eq, Show)
@ -191,16 +193,15 @@ handleEvent
-> ColorPickerEvt
-> [EventResponse Color ColorPickerEvt sp ep]
handleEvent cfg wenv node model evt = case evt of
PickerFocus -> reportFocus
PickerBlur -> reportBlur
PickerFocus prev
| not (isNodeParentOfPath prev node) -> reportFocus prev
PickerBlur next
| not (isNodeParentOfPath next node) -> reportBlur next
ColorChanged _ -> reportChange
AlphaChanged _ -> reportChange
_ -> []
where
report evts reqs = (Report <$> evts) ++ (RequestParent <$> reqs)
reportFocus
| not (isNodeParentOfFocused wenv node) = []
| otherwise = report (_cpcOnFocus cfg) (_cpcOnFocusReq cfg)
reportBlur
| isNodeParentOfFocused wenv node = []
| otherwise = report (_cpcOnBlur cfg) (_cpcOnBlurReq cfg)
reportFocus prev = report (($ prev) <$> _cpcOnFocus cfg) (_cpcOnFocusReq cfg)
reportBlur next = report (($ next) <$> _cpcOnBlur cfg) (_cpcOnBlurReq cfg)
reportChange = report (($ model) <$> _cpcOnChange cfg) (_cpcOnChangeReq cfg)

12
src/Monomer/Widgets/Singles/Dial.hs
View File

@ -33,9 +33,9 @@ type DialValue a = (Eq a, Show a, Real a, FromFractional a, Typeable a)
data DialCfg s e a = DialCfg {
_dlcWidth :: Maybe Double,
_dlcDragRate :: Maybe Rational,
_dlcOnFocus :: [e],
_dlcOnFocus :: [Path -> e],
_dlcOnFocusReq :: [WidgetRequest s e],
_dlcOnBlur :: [e],
_dlcOnBlur :: [Path -> e],
_dlcOnBlurReq :: [WidgetRequest s e],
_dlcOnChange :: [a -> e],
_dlcOnChangeReq :: [WidgetRequest s e]
@ -73,7 +73,7 @@ instance CmbDragRate (DialCfg s e a) Rational where
_dlcDragRate = Just rate
}
instance CmbOnFocus (DialCfg s e a) e where
instance CmbOnFocus (DialCfg s e a) e Path where
onFocus fn = def {
_dlcOnFocus = [fn]
}
@ -83,7 +83,7 @@ instance CmbOnFocusReq (DialCfg s e a) s e where
_dlcOnFocusReq = [req]
}
instance CmbOnBlur (DialCfg s e a) e where
instance CmbOnBlur (DialCfg s e a) e Path where
onBlur fn = def {
_dlcOnBlur = [fn]
}
@ -208,8 +208,8 @@ makeDial field minVal maxVal config state = widget where
(_, dialArea) = getDialInfo wenv node config
handleEvent wenv node target evt = case evt of
Focus -> handleFocusChange _dlcOnFocus _dlcOnFocusReq config node
Blur -> handleFocusChange _dlcOnBlur _dlcOnBlurReq config node
Focus prev -> handleFocusChange _dlcOnFocus _dlcOnFocusReq config prev node
Blur next -> handleFocusChange _dlcOnBlur _dlcOnBlurReq config next node
KeyAction mod code KeyPressed
| isCtrl && isKeyUp code -> handleNewPos (pos + warpSpeed)
| isCtrl && isKeyDown code -> handleNewPos (pos - warpSpeed)

12
src/Monomer/Widgets/Singles/ExternalLink.hs
View File

@ -30,9 +30,9 @@ data ExternalLinkCfg s e = ExternalLinkCfg {
_elcTextMaxLines :: Maybe Int,
_elcFactorW :: Maybe Double,
_elcFactorH :: Maybe Double,
_elcOnFocus :: [e],
_elcOnFocus :: [Path -> e],
_elcOnFocusReq :: [WidgetRequest s e],
_elcOnBlur :: [e],
_elcOnBlur :: [Path -> e],
_elcOnBlurReq :: [WidgetRequest s e]
}
@ -87,7 +87,7 @@ instance CmbMaxLines (ExternalLinkCfg s e) where
_elcTextMaxLines = Just count
}
instance CmbOnFocus (ExternalLinkCfg s e) e where
instance CmbOnFocus (ExternalLinkCfg s e) e Path where
onFocus fn = def {
_elcOnFocus = [fn]
}
@ -97,7 +97,7 @@ instance CmbOnFocusReq (ExternalLinkCfg s e) s e where
_elcOnFocusReq = [req]
}
instance CmbOnBlur (ExternalLinkCfg s e) e where
instance CmbOnBlur (ExternalLinkCfg s e) e Path where
onBlur fn = def {
_elcOnBlur = [fn]
}
@ -181,8 +181,8 @@ makeExternalLink caption url config = widget where
result = resultWidget (createChildNode wenv node)
handleEvent wenv node target evt = case evt of
Focus -> handleFocusChange _elcOnFocus _elcOnFocusReq config node
Blur -> handleFocusChange _elcOnBlur _elcOnBlurReq config node
Focus prev -> handleFocusChange _elcOnFocus _elcOnFocusReq config prev node
Blur next -> handleFocusChange _elcOnBlur _elcOnBlurReq config next node
KeyAction mode code status
| isSelectKey code && status == KeyPressed -> Just result
where

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

@ -51,9 +51,9 @@ data InputFieldCfg s e a = InputFieldCfg {
_ifcStyle :: Maybe (ALens' ThemeState StyleState),
_ifcDragHandler :: Maybe (InputDragHandler a),
_ifcDragCursor :: Maybe CursorIcon,
_ifcOnFocus :: [e],
_ifcOnFocus :: [Path -> e],
_ifcOnFocusReq :: [WidgetRequest s e],
_ifcOnBlur :: [e],
_ifcOnBlur :: [Path -> e],
_ifcOnBlurReq :: [WidgetRequest s e],
_ifcOnChange :: [a -> e],
_ifcOnChangeReq :: [WidgetRequest s e]
@ -420,7 +420,7 @@ makeInputField config state = widget where
result = insertTextRes wenv node newText
-- Handle focus, maybe select all and disable custom drag handlers
Focus -> Just result where
Focus prev -> Just result where
tmpState
| _ifcSelectOnFocus config && T.length currText > 0 = state {
_ifsSelStart = Just 0,
@ -432,16 +432,16 @@ makeInputField config state = widget where
& L.widget .~ makeInputField config newState
reqs = [RenderEvery widgetId caretMs Nothing, StartTextInput viewport]
newResult = resultReqs newNode reqs
focusResult = handleFocusChange _ifcOnFocus _ifcOnFocusReq config newNode
result = maybe newResult (newResult <>) focusResult
focusRs = handleFocusChange _ifcOnFocus _ifcOnFocusReq config prev newNode
result = maybe newResult (newResult <>) focusRs
-- Handle blur and disable custom drag handlers
Blur -> Just result where
Blur next -> Just result where
newState = state { _ifsDragSelActive = False }
newNode = node & L.widget .~ makeInputField config newState
reqs = [RenderStop widgetId, StopTextInput]
newResult = resultReqs newNode reqs
blurResult = handleFocusChange _ifcOnBlur _ifcOnBlurReq config newNode
blurResult = handleFocusChange _ifcOnBlur _ifcOnBlurReq config next newNode
result = maybe newResult (newResult <>) blurResult
_ -> Nothing

8
src/Monomer/Widgets/Singles/NumericField.hs
View File

@ -44,9 +44,9 @@ data NumericFieldCfg s e a = NumericFieldCfg {
_nfcDragRate :: Maybe Double,
_nfcResizeOnChange :: Maybe Bool,
_nfcSelectOnFocus :: Maybe Bool,
_nfcOnFocus :: [e],
_nfcOnFocus :: [Path -> e],
_nfcOnFocusReq :: [WidgetRequest s e],
_nfcOnBlur :: [e],
_nfcOnBlur :: [Path -> e],
_nfcOnBlurReq :: [WidgetRequest s e],
_nfcOnChange :: [a -> e],
_nfcOnChangeReq :: [WidgetRequest s e]
@ -124,7 +124,7 @@ instance CmbDecimals (NumericFieldCfg s e a) where
_nfcDecimals = Just num
}
instance CmbOnFocus (NumericFieldCfg s e a) e where
instance CmbOnFocus (NumericFieldCfg s e a) e Path where
onFocus fn = def {
_nfcOnFocus = [fn]
}
@ -134,7 +134,7 @@ instance CmbOnFocusReq (NumericFieldCfg s e a) s e where
_nfcOnFocusReq = [req]
}
instance CmbOnBlur (NumericFieldCfg s e a) e where
instance CmbOnBlur (NumericFieldCfg s e a) e Path where
onBlur fn = def {
_nfcOnBlur = [fn]
}

12
src/Monomer/Widgets/Singles/Radio.hs
View File

@ -22,9 +22,9 @@ import qualified Monomer.Lens as L
data RadioCfg s e a = RadioCfg {
_rdcWidth :: Maybe Double,
_rdcOnFocus :: [e],
_rdcOnFocus :: [Path -> e],
_rdcOnFocusReq :: [WidgetRequest s e],
_rdcOnBlur :: [e],
_rdcOnBlur :: [Path -> e],
_rdcOnBlurReq :: [WidgetRequest s e],
_rdcOnChange :: [a -> e],
_rdcOnChangeReq :: [WidgetRequest s e]
@ -60,7 +60,7 @@ instance CmbWidth (RadioCfg s e a) where
_rdcWidth = Just w
}
instance CmbOnFocus (RadioCfg s e a) e where
instance CmbOnFocus (RadioCfg s e a) e Path where
onFocus fn = def {
_rdcOnFocus = [fn]
}
@ -70,7 +70,7 @@ instance CmbOnFocusReq (RadioCfg s e a) s e where
_rdcOnFocusReq = [req]
}
instance CmbOnBlur (RadioCfg s e a) e where
instance CmbOnBlur (RadioCfg s e a) e Path where
onBlur fn = def {
_rdcOnBlur = [fn]
}
@ -135,8 +135,8 @@ makeRadio field option config = widget where
style = activeStyle_ (activeStyleConfig radioArea) wenv node
handleEvent wenv node target evt = case evt of
Focus -> handleFocusChange _rdcOnFocus _rdcOnFocusReq config node
Blur -> handleFocusChange _rdcOnBlur _rdcOnBlurReq config node
Focus prev -> handleFocusChange _rdcOnFocus _rdcOnFocusReq config prev node
Blur next -> handleFocusChange _rdcOnBlur _rdcOnBlurReq config next node
Click p _
| pointInEllipse p rdArea -> Just $ resultReqsEvts node reqs events
KeyAction mod code KeyPressed

12
src/Monomer/Widgets/Singles/Slider.hs
View File

@ -40,9 +40,9 @@ data SliderCfg s e a = SliderCfg {
_slcRadius :: Maybe Double,
_slcWidth :: Maybe Double,
_slcDragRate :: Maybe Rational,
_slcOnFocus :: [e],
_slcOnFocus :: [Path -> e],
_slcOnFocusReq :: [WidgetRequest s e],
_slcOnBlur :: [e],
_slcOnBlur :: [Path -> e],
_slcOnBlurReq :: [WidgetRequest s e],
_slcOnChange :: [a -> e],
_slcOnChangeReq :: [WidgetRequest s e]
@ -82,7 +82,7 @@ instance CmbDragRate (SliderCfg s e a) Rational where
_slcDragRate = Just rate
}
instance CmbOnFocus (SliderCfg s e a) e where
instance CmbOnFocus (SliderCfg s e a) e Path where
onFocus fn = def {
_slcOnFocus = [fn]
}
@ -92,7 +92,7 @@ instance CmbOnFocusReq (SliderCfg s e a) s e where
_slcOnFocusReq = [req]
}
instance CmbOnBlur (SliderCfg s e a) e where
instance CmbOnBlur (SliderCfg s e a) e Path where
onBlur fn = def {
_slcOnBlur = [fn]
}
@ -247,8 +247,8 @@ makeSlider isHz field minVal maxVal config state = widget where
& L.widget .~ makeSlider isHz field minVal maxVal config newState
handleEvent wenv node target evt = case evt of
Focus -> handleFocusChange _slcOnFocus _slcOnFocusReq config node
Blur -> handleFocusChange _slcOnBlur _slcOnBlurReq config node
Focus prev -> handleFocusChange _slcOnFocus _slcOnFocusReq config prev node
Blur next -> handleFocusChange _slcOnBlur _slcOnBlurReq config next node
KeyAction mod code KeyPressed
| isCtrl && isInc code -> handleNewPos (pos + warpSpeed)
| isCtrl && isDec code -> handleNewPos (pos - warpSpeed)

8
src/Monomer/Widgets/Singles/TextField.hs
View File

@ -30,9 +30,9 @@ data TextFieldCfg s e = TextFieldCfg {
_tfcMaxLength :: Maybe Int,
_tfcResizeOnChange :: Maybe Bool,
_tfcSelectOnFocus :: Maybe Bool,
_tfcOnFocus :: [e],
_tfcOnFocus :: [Path -> e],
_tfcOnFocusReq :: [WidgetRequest s e],
_tfcOnBlur :: [e],
_tfcOnBlur :: [Path -> e],
_tfcOnBlurReq :: [WidgetRequest s e],
_tfcOnChange :: [Text -> e],
_tfcOnChangeReq :: [WidgetRequest s e]
@ -89,7 +89,7 @@ instance CmbMaxLength (TextFieldCfg s e) where
_tfcMaxLength = Just len
}
instance CmbOnFocus (TextFieldCfg s e) e where
instance CmbOnFocus (TextFieldCfg s e) e Path where
onFocus fn = def {
_tfcOnFocus = [fn]
}
@ -99,7 +99,7 @@ instance CmbOnFocusReq (TextFieldCfg s e) s e where
_tfcOnFocusReq = [req]
}
instance CmbOnBlur (TextFieldCfg s e) e where
instance CmbOnBlur (TextFieldCfg s e) e Path where
onBlur fn = def {
_tfcOnBlur = [fn]
}

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

@ -99,13 +99,14 @@ isNodeBeforePath path node = result where
handleFocusChange
:: Typeable e
=> (c -> [e])
=> (c -> [Path -> e])
-> (c -> [WidgetRequest s e])
-> c
-> Path
-> WidgetNode s e
-> Maybe (WidgetResult s e)
handleFocusChange evtFn reqFn config node = result where
evts = evtFn config
handleFocusChange evtFn reqFn config path node = result where
evts = ($ path) <$> evtFn config
reqs = reqFn config
result
| not (null evts && null reqs) = Just $ resultReqsEvts node reqs evts

1
tasks.md
View File

@ -605,6 +605,7 @@ Next
- Add externalLink component
- https://stackoverflow.com/questions/3037088/how-to-open-the-default-web-browser-in-windows-in-c/54334181
- Review onChangeReq (a parameter should be provided)
- Also reorder type parameters to be consistent (same order always)
- Create ContextMenu (could work similarly to Tooltip)
- Rename ListView -> SelectList
- Add support for multiple selection