Merge branch 'ui' into tessallation

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
                         }
               }
 

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

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

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
+        -- |The function 'onMouseLeave' is invoked when the mouse leaves the
-        --  widget's space ('isInside').
+        --  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: make only fire if press started within widget                            
--- TODO? breaks if array not of sufficient size -- will be avoided by excluding constructor export
 -- |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 =
+    release' b p w = do fire <- (w ^. baseProperties.isInside) w p
-      if isIn
+                        if fire then a b w p else return w
-      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)

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
+