mirror of
https://github.com/fjvallarino/monomer.git
synced 2024-09-11 12:05:35 +03:00
Add boxFilterEvent config option, exposing Container's filterEvent functionality (#146)
* Add boxFilterEvent to box, exposing Container's filterEvent functionality * Add unit tests * Update Changelog
This commit is contained in:
parent
fe8bdb8bc4
commit
d6def462d1
@ -4,6 +4,7 @@
|
||||
|
||||
- Support for switching vertical wheel scrolling to horizontal in scroll widget by pressing the shift key ([PR #137](https://github.com/fjvallarino/monomer/pull/137)).
|
||||
- Drawing and theme utility functions ([PR #138](https://github.com/fjvallarino/monomer/pull/138)).
|
||||
- `boxFilterEvent` config option, exposing Container's filterEvent functionality ([PR #146](https://github.com/fjvallarino/monomer/pull/146)).
|
||||
|
||||
## 1.4.0.0
|
||||
|
||||
|
@ -258,7 +258,7 @@ type ContainerFindByPointHandler s e
|
||||
|
||||
{-|
|
||||
Receives a System event and, optionally, modifies the event, its target, or
|
||||
cancels the event propagation by returning null.
|
||||
stops the event propagation by returning Nothing.
|
||||
|
||||
Examples can be found in "Monomer.Widgets.Containers.Base.LabeledItem".
|
||||
-}
|
||||
|
@ -58,7 +58,8 @@ module Monomer.Widgets.Containers.Box (
|
||||
-- * Constructors
|
||||
box,
|
||||
box_,
|
||||
expandContent
|
||||
expandContent,
|
||||
boxFilterEvent
|
||||
) where
|
||||
|
||||
import Control.Applicative ((<|>))
|
||||
@ -101,11 +102,13 @@ Configuration options for box:
|
||||
- 'onClickEmptyReq': generates a WidgetRequest on click in empty area.
|
||||
- 'expandContent': if the inner widget should use all the available space. To be
|
||||
able to use alignment options, this must be False (the default).
|
||||
- 'boxFilterEvent': allows filtering or modifying a 'SystemEvent'.
|
||||
-}
|
||||
data BoxCfg s e = BoxCfg {
|
||||
_boxExpandContent :: Maybe Bool,
|
||||
_boxIgnoreEmptyArea :: Maybe Bool,
|
||||
_boxSizeReqUpdater :: [SizeReqUpdater],
|
||||
_boxFilterEvent :: Maybe (ContainerFilterHandler s e),
|
||||
_boxMergeRequired :: Maybe (WidgetEnv s e -> s -> s -> Bool),
|
||||
_boxAlignH :: Maybe AlignH,
|
||||
_boxAlignV :: Maybe AlignV,
|
||||
@ -124,6 +127,7 @@ instance Default (BoxCfg s e) where
|
||||
_boxExpandContent = Nothing,
|
||||
_boxIgnoreEmptyArea = Nothing,
|
||||
_boxSizeReqUpdater = [],
|
||||
_boxFilterEvent = Nothing,
|
||||
_boxMergeRequired = Nothing,
|
||||
_boxAlignH = Nothing,
|
||||
_boxAlignV = Nothing,
|
||||
@ -142,6 +146,7 @@ instance Semigroup (BoxCfg s e) where
|
||||
_boxExpandContent = _boxExpandContent t2 <|> _boxExpandContent t1,
|
||||
_boxIgnoreEmptyArea = _boxIgnoreEmptyArea t2 <|> _boxIgnoreEmptyArea t1,
|
||||
_boxSizeReqUpdater = _boxSizeReqUpdater t1 <> _boxSizeReqUpdater t2,
|
||||
_boxFilterEvent = _boxFilterEvent t2 <|> _boxFilterEvent t1,
|
||||
_boxMergeRequired = _boxMergeRequired t2 <|> _boxMergeRequired t1,
|
||||
_boxAlignH = _boxAlignH t2 <|> _boxAlignH t1,
|
||||
_boxAlignV = _boxAlignV t2 <|> _boxAlignV t1,
|
||||
@ -295,6 +300,15 @@ expandContent = def {
|
||||
_boxExpandContent = Just True
|
||||
}
|
||||
|
||||
{-|
|
||||
Receives a System event and, optionally, modifies the event, its target, or
|
||||
stops the event propagation by returning Nothing.
|
||||
-}
|
||||
boxFilterEvent :: ContainerFilterHandler s e -> BoxCfg s e
|
||||
boxFilterEvent handler = def {
|
||||
_boxFilterEvent = Just handler
|
||||
}
|
||||
|
||||
newtype BoxState s = BoxState {
|
||||
_bxsModel :: Maybe s
|
||||
}
|
||||
@ -330,6 +344,7 @@ makeBox config state = widget where
|
||||
containerInit = init,
|
||||
containerMergeChildrenReq = mergeRequired,
|
||||
containerMerge = merge,
|
||||
containerFilterEvent = filterEvent,
|
||||
containerHandleEvent = handleEvent,
|
||||
containerGetSizeReq = getSizeReq,
|
||||
containerResize = resize
|
||||
@ -358,6 +373,10 @@ makeBox config state = widget where
|
||||
currentStyleConfig = def
|
||||
& L.isActive .~ isNodeTreeActive
|
||||
|
||||
filterEvent = case _boxFilterEvent config of
|
||||
Just handler -> handler
|
||||
_ -> \wenv node target evt -> Just (target, evt)
|
||||
|
||||
handleEvent wenv node target evt = case evt of
|
||||
Focus prev -> handleFocusChange node prev (_boxOnFocusReq config)
|
||||
Blur next -> handleFocusChange node next (_boxOnBlurReq config)
|
||||
|
@ -26,6 +26,7 @@ import Monomer.Graphics
|
||||
import Monomer.TestEventUtil
|
||||
import Monomer.TestUtil
|
||||
import Monomer.Widgets.Containers.Box
|
||||
import Monomer.Widgets.Containers.Grid
|
||||
import Monomer.Widgets.Containers.ZStack
|
||||
import Monomer.Widgets.Singles.Button
|
||||
import Monomer.Widgets.Singles.Label
|
||||
@ -45,6 +46,7 @@ data TestEvent
|
||||
spec :: Spec
|
||||
spec = describe "Box" $ do
|
||||
mergeReq
|
||||
filterEvent
|
||||
handleEvent
|
||||
handleEventIgnoreEmpty
|
||||
handleEventSinkEmpty
|
||||
@ -75,6 +77,29 @@ mergeReq = describe "mergeReq" $ do
|
||||
oldNode2 = nodeInit wenv oldNode
|
||||
result = widgetMerge (newNode ^. L.widget) wenv newNode oldNode2
|
||||
|
||||
filterEvent :: Spec
|
||||
filterEvent = describe "filterEvent" $ do
|
||||
it "should click the first button, since the click event was directed to it" $
|
||||
evts False [evtClick point1] `shouldBe` Seq.singleton (BtnClick 1)
|
||||
|
||||
it "should click the second button, since the click event's target was modified" $
|
||||
evts True [evtClick point1] `shouldBe` Seq.singleton (BtnClick 2)
|
||||
|
||||
where
|
||||
wenv = mockWenv ()
|
||||
point1 = Point 320 200
|
||||
point2 = Point 320 400
|
||||
|
||||
filterEvent wenv node target evt = Just (target & ix 2 .~ 1, evtClick point2)
|
||||
|
||||
btnBox ignore = box_ (expandContent : [boxFilterEvent filterEvent | ignore]) $
|
||||
vgrid [
|
||||
button "Button 1" (BtnClick 1),
|
||||
button "Button 2" (BtnClick 2)
|
||||
]
|
||||
evts ignore es = nodeHandleEventEvts wenv es $
|
||||
nodeInit wenv (btnBox ignore)
|
||||
|
||||
handleEvent :: Spec
|
||||
handleEvent = describe "handleEvent" $ do
|
||||
it "should not generate an event if clicked outside" $
|
||||
|
Loading…
Reference in New Issue
Block a user