From 8a84e7ba952be4cfbcd659005b574a3578f980c5 Mon Sep 17 00:00:00 2001 From: tpajenka Date: Wed, 21 May 2014 11:51:40 +0200 Subject: [PATCH] press/release handlers receive boolean as parameter to indicate if the click is inside widget --- src/UI/Callbacks.hs | 34 ++-------------------------------- src/UI/UIBase.hs | 29 +++++++++++++++++------------ 2 files changed, 19 insertions(+), 44 deletions(-) diff --git a/src/UI/Callbacks.hs b/src/UI/Callbacks.hs index 459b1a1..4231b33 100644 --- a/src/UI/Callbacks.hs +++ b/src/UI/Callbacks.hs @@ -141,7 +141,7 @@ eventCallback e = do _ -> 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 () mouseButtonHandler transFunc btn px = do state <- get @@ -151,7 +151,7 @@ mouseButtonHandler transFunc btn px = do Just (wid, px') -> do let target = toGUIAny hMap wid 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 modify $ ui.uiMap %~ Map.insert wid target' return () @@ -260,36 +260,6 @@ mouseMoveHandler px = do 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 -- --TODO: should be done asynchronously at one point. diff --git a/src/UI/UIBase.hs b/src/UI/UIBase.hs index c6219b8..efa3167 100644 --- a/src/UI/UIBase.hs +++ b/src/UI/UIBase.hs @@ -121,16 +121,23 @@ data EventHandler m = -- |The function 'onMousePressed' is called when a button is pressed -- while the button is mouse-active. -- - -- The function returns the altered widget resulting from the button press - _onMousePress :: MouseButton -> Pixel -> GUIWidget m -> m (GUIWidget m) + -- The boolean value indicates if the button press happened within the widget + -- ('_isInside'). + -- + -- The function returns the altered widget resulting from the button press + _onMousePress :: MouseButton -> Pixel -> Bool -> GUIWidget m -> m (GUIWidget m) , -- |The function 'onMouseReleased' is called when a button is released -- while the widget is mouse-active. -- -- Thus, the mouse is either within the widget or outside while still dragging. -- - -- The function returns the altered widget resulting from the button press - _onMouseRelease :: MouseButton -> Pixel -> GUIWidget m -> m (GUIWidget m) + -- + -- The boolean value indicates if the button release happened within the widget + -- ('_isInside'). + -- + -- The function returns the altered widget resulting from the button press + _onMouseRelease :: MouseButton -> Pixel -> Bool -> GUIWidget m -> m (GUIWidget m) } | -- |Handler to control the functionality of a 'GUIWidget' on mouse movement. @@ -241,11 +248,11 @@ setMouseStateActions :: (Monad m) => EventHandler m setMouseStateActions = MouseHandler press' release' where -- |Change 'MouseButtonState'’s '_mouseIsDragging' to @True@. - press' b _ w = + press' b _ _ w = return $ w & widgetStates.(ix MouseStateKey).mouseStates.(ix b).mouseIsDragging .~ True -- |Change 'MouseButtonState'’s '_mouseIsDragging' and '_mouseIsDeferred' to @False@. - release' b _ w = + release' b _ _ w = return $ w & widgetStates.(ix MouseStateKey).mouseStates.(ix b) %~ (mouseIsDragging .~ False) . (mouseIsDeferred .~ False) @@ -282,10 +289,9 @@ buttonMouseActions :: (Monad m) => (MouseButton -> GUIWidget m -> Pixel -> m (GU -> EventHandler m buttonMouseActions a = MouseHandler press' release' where - press' _ _ = return + press' _ _ _ = return - release' b p w = do fire <- (w ^. baseProperties.isInside) w p - if fire then a b w p else return w + release' b p inside w = if inside then a b w p else return w -- TODO: make only fire if press started within widget -- |Creates a 'MouseHandler' that reacts on mouse clicks. @@ -295,10 +301,9 @@ buttonSingleMouseActions :: (Monad m) => (GUIWidget m -> Pixel -> m (GUIWidget m -> MouseButton -> EventHandler m buttonSingleMouseActions a btn = MouseHandler press' release' where - press' _ _ = return + press' _ _ _ = return - release' b p w = do fire <- liftM (b == btn &&) $ (w ^. baseProperties.isInside) w p - if fire then a w p else return w + release' b p inside w = if inside && b == btn then a w p else return w emptyGraphics :: (Monad m) => GUIGraphics m emptyGraphics = Graphics (return 3)