diff --git a/src/Main.hs b/src/Main.hs index 9f6c15e..5187e3d 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -45,6 +45,7 @@ import UI.Callbacks import Map.Graphics import Map.Creation (exportedMap) import Types +import qualified UI.UIBase as UI import Importer.IQM.Parser --import Data.Attoparsec.Char8 (parseTest) --import qualified Data.ByteString as B @@ -161,6 +162,7 @@ main = { _uiHasChanged = True , _uiMap = guiMap , _uiRoots = guiRoots + , _uiButtonState = UI.UIButtonState 0 Nothing } } diff --git a/src/Types.hs b/src/Types.hs index d9795bf..75932ea 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -156,6 +156,7 @@ data UIState = UIState { _uiHasChanged :: !Bool , _uiMap :: Map.HashMap UIId (GUIWidget Pioneers) , _uiRoots :: [UIId] + , _uiButtonState :: UIButtonState } data State = State diff --git a/src/UI/Callbacks.hs b/src/UI/Callbacks.hs index e49b4b1..1f77d10 100644 --- a/src/UI/Callbacks.hs +++ b/src/UI/Callbacks.hs @@ -134,6 +134,37 @@ eventCallback e = do _ -> liftIO $ putStrLn $ unwords ["Not processing Event:", show e] +mouseButtonHandler :: (EventHandler Pioneers -> MouseButton -> Pixel -> GUIWidget Pioneers -> Pioneers (GUIWidget Pioneers)) + -> MouseButton -> Pixel -> Pioneers () +mouseButtonHandler transFunc btn px = do + modify $ ui.uiButtonState %~ (mousePressed %~ (+1)) -- TODO: what happens if released outside window? not reset properly? + state <- get + let hMap = state ^. ui.uiMap + currentWidget = state ^. ui.uiButtonState.mouseCurrentWidget + case currentWidget of + Just (wui, px') -> do + let target = toGUIAny hMap wui + target' <- case target ^. eventHandlers.(at MouseEvent) of + Just ma -> transFunc ma btn (px -: px') target -- TODO unsafe fromJust + Nothing -> return target + modify $ ui.uiMap %~ Map.insert wui target' + return () + Nothing -> return () + +mousePressHandler :: MouseButton -> Pixel -> Pioneers () +mousePressHandler btn px = do + modify $ ui.uiButtonState %~ (mousePressed %~ (+1)) -- TODO: what happens if released outside window? not reset properly? + mouseButtonHandler (\ma -> fromJust (ma ^? onMousePress)) btn px + +mouseReleaseHandler :: MouseButton -> Pixel -> Pioneers () +mouseReleaseHandler btn px = do + modify $ ui.uiButtonState %~ (mousePressed %~ flip (-) 1) -- TODO: what happens if pressed outside window? not set properly? + mouseButtonHandler (\ma -> fromJust (ma ^? onMouseRelease)) btn px + -- TODO: trigger move/enter/leave + +mouseMoveHandler :: Pixel -> Pioneers () +mouseMoveHandler px = undefined + -- | Handler for UI-Inputs. -- Indicates a primary click on something (e.g. left-click, touch on Touchpad, fire on Gamepad, ... clickHandler :: MouseButton -> Pixel -> Pioneers () @@ -154,7 +185,7 @@ clickHandler btn pos@(x,y) = do ++ 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' True w' -- TODO unsafe fromJust + w'' <- fromJust (ma ^? onMouseRelease) btn pos' w' -- TODO unsafe fromJust return $ Just (uid, w'') Nothing -> return Nothing ) hits diff --git a/src/UI/UIBase.hs b/src/UI/UIBase.hs index 0c31527..9ecf55e 100644 --- a/src/UI/UIBase.hs +++ b/src/UI/UIBase.hs @@ -70,6 +70,15 @@ instance Hashable WidgetStateKey where -- TODO: generic deriving creates functio hash = fromEnum hashWithSalt salt x = (salt * 16777619) `xor` hash x +-- |Global tracking of mouse actions to determine event handling. +data UIButtonState = UIButtonState + { _mousePressed :: Int -- ^amount of currently pressed buttons + , _mouseCurrentWidget :: Maybe (UIId, Pixel) + -- ^the current mouse-active widget and its global coordinates. + -- If @_mousePressed == 0@: widget the mouse is hovering over, + -- otherwise: widget the first button has been pressed on. + } deriving (Show, Eq) + -- |The button dependant state of a 'MouseState'. data MouseButtonState = MouseButtonState { _mouseIsDragging :: Bool -- ^firing if pressed but not confirmed @@ -107,19 +116,22 @@ data EventHandler m = MouseHandler { -- |The function 'onMousePressed' is called when a button is pressed - -- while inside a screen coordinate within the widget ('isInside'). + -- while the widget is mouse-active. + -- + -- A widget becomes mouse-active if no other button is currently pressed and the mouse + -- coordinates are within the widget's extent ('isInside') until no button is pressed any + -- more. _onMousePress :: MouseButton -- ^the pressed button -> Pixel -- ^screen position -> GUIWidget m -- ^widget the event is invoked on -> m (GUIWidget m) -- ^widget after the event and the possibly altered mouse handler , -- |The function 'onMouseReleased' is called when a button is released - -- while the pressing event occured within the widget ('isInside'). + -- while the widget is mouse-active. -- -- Thus, the mouse is either within the widget or outside while still dragging. _onMouseRelease :: MouseButton -- ^the released button -> Pixel -- ^screen position - -> Bool -- ^@True@ if the event occured inside the widget -> GUIWidget m -- ^widget the event is invoked on -> m (GUIWidget m) -- ^widget after the event and the altered handler } @@ -128,19 +140,22 @@ data EventHandler m = MouseMotionHandler { -- |The function 'onMouseMove' is invoked when the mouse is moved inside the - -- widget's space ('isInside'). + -- widget's extent ('isInside') while no button is pressed or when the mouse is inside the + -- widget's extent while another button loses its mouse-active state. Triggered after + -- '_onMouseEnter'. _onMouseMove :: Pixel -- ^screen position -> GUIWidget m -- ^widget the event is invoked on -> m (GUIWidget m) -- ^widget after the event and the altered handler , -- |The function 'onMouseMove' is invoked when the mouse enters the - -- widget's space ('isInside'). + -- widget's extent ('isInside') or when the mouse is inside the + -- widget's extent while another button loses its mouse-active state.. _onMouseEnter :: Pixel -- ^screen position -> GUIWidget m -- ^widget the event is invoked on -> m (GUIWidget m) -- ^widget after the event and the altered handler , - -- |The function 'onMouseMove' is invoked when the mouse leaves the - -- widget's space ('isInside'). + -- |The function 'onMouseLeave' is invoked when the mouse leaves the + -- widget's extent ('isInside') while no other widget is mouse-active. _onMouseLeave :: Pixel -- ^screen position -> GUIWidget m -- ^widget the event is invoked on -> m (GUIWidget m) -- ^widget after the event and the altered handler @@ -199,10 +214,9 @@ data GUIBaseProperties m = BaseProperties data GUIGraphics m = Graphics {temp :: m Int} -$(makeLenses ''WidgetStateKey) +$(makeLenses ''UIButtonState) $(makeLenses ''WidgetState) $(makeLenses ''MouseButtonState) -$(makeLenses ''EventKey) $(makeLenses ''EventHandler) $(makeLenses ''GUIWidget) $(makeLenses ''GUIBaseProperties) @@ -221,6 +235,7 @@ initialMouseState = MouseState (array (minBound, maxBound) [(i, initialButtonSta -- TODO: combined mouse handler +-- TODO? breaks if button array not of sufficient size -- will be avoided by excluding constructor export -- |Creates a 'MouseHandler' that sets a widget's 'MouseButtonState' properties if present, -- only fully functional in conjunction with 'setMouseMotionStateActions'. setMouseStateActions :: (Monad m) => EventHandler m @@ -231,7 +246,7 @@ setMouseStateActions = MouseHandler press' release' 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) @@ -260,8 +275,7 @@ setMouseMotionStateActions = MouseMotionHandler move' enter' leave' -- following line executed BEFORE above line . (\sState -> sState & mouseIsDeferred .~ not (sState ^. mouseIsDragging))) - --- TODO? breaks if array not of sufficient size -- will be avoided by excluding constructor export +-- TODO: make only fire if press started within widget -- |Creates a MouseHandler that reacts on mouse clicks. -- -- Does /not/ update 'WidgetState MouseState'! @@ -271,10 +285,21 @@ buttonMouseActions a = MouseHandler press' release' where press' _ _ = return - release' b p isIn w = - if isIn - then a b w p - else return w + release' b p w = do fire <- (w ^. baseProperties.isInside) w p + if fire 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. +-- +-- Does /not/ update 'WidgetState MouseState'! +buttonSingleMouseActions :: (Monad m) => (GUIWidget m -> Pixel -> m (GUIWidget m)) -- ^action on button press + -> MouseButton -> EventHandler m +buttonSingleMouseActions a btn = MouseHandler press' release' + where + 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 emptyGraphics :: (Monad m) => GUIGraphics m emptyGraphics = Graphics (return 3) diff --git a/src/UI/UIOperations.hs b/src/UI/UIOperations.hs index a0908a5..5c54f27 100644 --- a/src/UI/UIOperations.hs +++ b/src/UI/UIOperations.hs @@ -10,7 +10,7 @@ import UI.UIBase -- TODO: test GUI function to scan for overlapping widgets -toGUIAny :: Map.HashMap UIId (GUIWidget m) -> UIId -> GUIWidget m +toGUIAny :: Map.HashMap UIId (GUIWidget m) -> UIId -> GUIWidget m -- TODO: what to do if widget not inside map -> inconsistent state toGUIAny m uid = fromMaybe (error "map does not contain requested key") (Map.lookup uid m) {-# INLINABLE toGUIAny #-} @@ -46,4 +46,8 @@ getInsideId hMap px uid = do else return [] --TODO: Priority queue? - +getLeadingWidget :: [(UIId, Pixel)] -- ^widgets and their screen positions + -> Pioneers (Maybe (UIId, Pixel)) -- ^the leading widget +getLeadingWidget [] = return Nothing +getLeadingWidget (x:_) = return $ Just x +