press/release handlers receive boolean as parameter to indicate if the click is inside widget

This commit is contained in:
tpajenka 2014-05-21 11:51:40 +02:00
parent e72e8c9333
commit 8a84e7ba95
2 changed files with 19 additions and 44 deletions

View File

@ -141,7 +141,7 @@ eventCallback e = do
_ -> liftIO $ putStrLn $ unwords ["Not processing Event:", show e] _ -> liftIO $ putStrLn $ unwords ["Not processing Event:", show e]
mouseButtonHandler :: (EventHandler Pioneers -> MouseButton -> Pixel -> GUIWidget Pioneers -> Pioneers (GUIWidget Pioneers)) mouseButtonHandler :: (EventHandler Pioneers -> MouseButton -> Pixel -> Bool -> GUIWidget Pioneers -> Pioneers (GUIWidget Pioneers))
-> MouseButton -> Pixel -> Pioneers () -> MouseButton -> Pixel -> Pioneers ()
mouseButtonHandler transFunc btn px = do mouseButtonHandler transFunc btn px = do
state <- get state <- get
@ -151,7 +151,7 @@ mouseButtonHandler transFunc btn px = do
Just (wid, px') -> do Just (wid, px') -> do
let target = toGUIAny hMap wid let target = toGUIAny hMap wid
target' <- case target ^. eventHandlers.(at MouseEvent) of target' <- case target ^. eventHandlers.(at MouseEvent) of
Just ma -> transFunc ma btn (px -: px') target Just ma -> transFunc ma btn (px -: px') (state ^. ui.uiButtonState.mouseInside) target
Nothing -> return target Nothing -> return target
modify $ ui.uiMap %~ Map.insert wid target' modify $ ui.uiMap %~ Map.insert wid target'
return () return ()
@ -260,36 +260,6 @@ mouseMoveHandler px = do
mouseSetMouseActive px mouseSetMouseActive px
-- | Handler for UI-Inputs.
-- Indicates a primary click on something (e.g. left-click, touch on Touchpad, fire on Gamepad, ...
clickHandler :: MouseButton -> Pixel -> Pioneers ()
clickHandler btn pos@(x,y) = do
roots <- getRootIds
hits <- liftM concat $ mapM (getInsideId pos) roots
case hits of
[] -> liftIO $ putStrLn $ unwords [show btn ++ ":press on (",show x,",",show y,")"]
_ -> do
changes <- mapM (\(uid, pos') -> do
state <- get
let w = toGUIAny (state ^. ui.uiMap) uid
short = w ^. baseProperties.shorthand
bound <- w ^. baseProperties.boundary
prio <- w ^. baseProperties.priority
liftIO $ putStrLn $ "hitting(" ++ show btn ++ ") " ++ short ++ ": " ++ show bound ++ " "
++ show prio ++ " at [" ++ show x ++ "," ++ show y ++ "]"
case w ^. eventHandlers.(at MouseEvent) of
Just ma -> do w' <- fromJust (ma ^? onMousePress) btn pos' w -- TODO unsafe fromJust
w'' <- fromJust (ma ^? onMouseRelease) btn pos' w' -- TODO unsafe fromJust
return $ Just (uid, w'')
Nothing -> return Nothing
) hits
state <- get
let hMap = state ^. ui.uiMap
newMap = foldl' (\hm (uid, w') -> Map.insert uid w' hm) hMap $ catMaybes changes
modify $ ui.uiMap .~ newMap
return ()
-- | informs the GUI to prepare a blitting of state ^. gl.glHud.hudTexture -- | informs the GUI to prepare a blitting of state ^. gl.glHud.hudTexture
-- --
--TODO: should be done asynchronously at one point. --TODO: should be done asynchronously at one point.

View File

@ -121,16 +121,23 @@ data EventHandler m =
-- |The function 'onMousePressed' is called when a button is pressed -- |The function 'onMousePressed' is called when a button is pressed
-- while the button is mouse-active. -- while the button is mouse-active.
-- --
-- The boolean value indicates if the button press happened within the widget
-- ('_isInside').
--
-- The function returns the altered widget resulting from the button press -- The function returns the altered widget resulting from the button press
_onMousePress :: MouseButton -> Pixel -> GUIWidget m -> m (GUIWidget m) _onMousePress :: MouseButton -> Pixel -> Bool -> GUIWidget m -> m (GUIWidget m)
, ,
-- |The function 'onMouseReleased' is called when a button is released -- |The function 'onMouseReleased' is called when a button is released
-- while the widget is mouse-active. -- while the widget is mouse-active.
-- --
-- Thus, the mouse is either within the widget or outside while still dragging. -- Thus, the mouse is either within the widget or outside while still dragging.
-- --
--
-- The boolean value indicates if the button release happened within the widget
-- ('_isInside').
--
-- The function returns the altered widget resulting from the button press -- The function returns the altered widget resulting from the button press
_onMouseRelease :: MouseButton -> Pixel -> GUIWidget m -> m (GUIWidget m) _onMouseRelease :: MouseButton -> Pixel -> Bool -> GUIWidget m -> m (GUIWidget m)
} }
| |
-- |Handler to control the functionality of a 'GUIWidget' on mouse movement. -- |Handler to control the functionality of a 'GUIWidget' on mouse movement.
@ -241,11 +248,11 @@ setMouseStateActions :: (Monad m) => EventHandler m
setMouseStateActions = MouseHandler press' release' setMouseStateActions = MouseHandler press' release'
where where
-- |Change 'MouseButtonState's '_mouseIsDragging' to @True@. -- |Change 'MouseButtonState's '_mouseIsDragging' to @True@.
press' b _ w = press' b _ _ w =
return $ w & widgetStates.(ix MouseStateKey).mouseStates.(ix b).mouseIsDragging .~ True return $ w & widgetStates.(ix MouseStateKey).mouseStates.(ix b).mouseIsDragging .~ True
-- |Change 'MouseButtonState's '_mouseIsDragging' and '_mouseIsDeferred' to @False@. -- |Change 'MouseButtonState's '_mouseIsDragging' and '_mouseIsDeferred' to @False@.
release' b _ w = release' b _ _ w =
return $ w & widgetStates.(ix MouseStateKey).mouseStates.(ix b) %~ return $ w & widgetStates.(ix MouseStateKey).mouseStates.(ix b) %~
(mouseIsDragging .~ False) . (mouseIsDeferred .~ False) (mouseIsDragging .~ False) . (mouseIsDeferred .~ False)
@ -282,10 +289,9 @@ buttonMouseActions :: (Monad m) => (MouseButton -> GUIWidget m -> Pixel -> m (GU
-> EventHandler m -> EventHandler m
buttonMouseActions a = MouseHandler press' release' buttonMouseActions a = MouseHandler press' release'
where where
press' _ _ = return press' _ _ _ = return
release' b p w = do fire <- (w ^. baseProperties.isInside) w p release' b p inside w = if inside then a b w p else return w
if fire then a b w p else return w
-- TODO: make only fire if press started within widget -- TODO: make only fire if press started within widget
-- |Creates a 'MouseHandler' that reacts on mouse clicks. -- |Creates a 'MouseHandler' that reacts on mouse clicks.
@ -295,10 +301,9 @@ buttonSingleMouseActions :: (Monad m) => (GUIWidget m -> Pixel -> m (GUIWidget m
-> MouseButton -> EventHandler m -> MouseButton -> EventHandler m
buttonSingleMouseActions a btn = MouseHandler press' release' buttonSingleMouseActions a btn = MouseHandler press' release'
where where
press' _ _ = return press' _ _ _ = return
release' b p w = do fire <- liftM (b == btn &&) $ (w ^. baseProperties.isInside) w p release' b p inside w = if inside && b == btn then a w p else return w
if fire then a w p else return w
emptyGraphics :: (Monad m) => GUIGraphics m emptyGraphics :: (Monad m) => GUIGraphics m
emptyGraphics = Graphics (return 3) emptyGraphics = Graphics (return 3)