From 51c48e62db3b0c26bf0a278144a73e45a230f8b0 Mon Sep 17 00:00:00 2001
From: tpajenka <tpajenka@foo>
Date: Thu, 15 May 2014 21:43:26 +0200
Subject: [PATCH] revising preliminary inflexible button handling callback

---
 src/Main.hs         |  2 +-
 src/UI/Callbacks.hs | 69 +++++++++++++++++++++++++++++++++++++++++++--
 src/UI/UIBase.hs    |  1 +
 3 files changed, 68 insertions(+), 4 deletions(-)

diff --git a/src/Main.hs b/src/Main.hs
index bd85254..92d1005 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -162,7 +162,7 @@ main =
                         { _uiHasChanged        = True
                         , _uiMap = guiMap
                         , _uiRoots = guiRoots
-                        , _uiButtonState = UI.UIButtonState 0 Nothing
+                        , _uiButtonState = UI.UIButtonState 0 Nothing False
                         }
               }
 
diff --git a/src/UI/Callbacks.hs b/src/UI/Callbacks.hs
index 1f77d10..b9ef1bf 100644
--- a/src/UI/Callbacks.hs
+++ b/src/UI/Callbacks.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DoAndIfThenElse #-}
 module UI.Callbacks where
 
 
@@ -145,7 +146,7 @@ mouseButtonHandler transFunc btn px = do
          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
+                             Just ma -> transFunc ma btn (px -: px') target
                              Nothing  -> return target
              modify $ ui.uiMap %~ Map.insert wui target'
              return ()
@@ -160,10 +161,72 @@ 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
+    state <- get
+    case state ^. ui.uiButtonState.mouseCurrentWidget of
+         Just (wui, px') -> do
+             let target = toGUIAny (state ^. ui.uiMap) wui
+             target' <- case target ^. eventHandlers.(at MouseMotionEvent) of --existing handler?
+                             Just ma -> do
+                                  target_ <- fromJust (ma ^? onMouseEnter) px' target -- TODO unsafe fromJust
+                                  fromJust (ma ^? onMouseMove) px' target_ -- TODO unsafe fromJust
+                             Nothing  -> return target
+             modify $ ui.uiMap %~ Map.insert wui target'
+         Nothing -> return ()
+    mouseSwitchMouseActive px -- TODO leave current
 
+mouseSwitchMouseActive :: Pixel -> Pioneers ()
+mouseSwitchMouseActive px = do
+    state <- get
+    let hMap = state ^. ui.uiMap
+    roots <- getRootIds
+    hits <- liftM concat $ mapM (getInsideId hMap px) roots
+    leading <- getLeadingWidget hits
+    case leading of
+         Just (wui, px') -> do
+             let target = toGUIAny hMap wui
+             modify $ ui.uiButtonState %~ (mouseCurrentWidget .~ Just (wui, px -: px')) . (mouseInside .~ True)
+             target' <- case target ^. eventHandlers.(at MouseMotionEvent) of --existing handler?
+                             Just ma -> do
+                                  target_ <- fromJust (ma ^? onMouseEnter) px' target -- TODO unsafe fromJust
+                                  fromJust (ma ^? onMouseMove) px' target_ -- TODO unsafe fromJust
+                             Nothing  -> return target
+             modify $ ui.uiMap %~ Map.insert wui target'
+         Nothing -> modify $ ui.uiButtonState %~ (mouseCurrentWidget .~ Nothing) . (mouseInside .~ False)
+    
 mouseMoveHandler :: Pixel -> Pioneers ()
-mouseMoveHandler px = undefined
+mouseMoveHandler px = do
+    state <- get
+    case state ^. ui.uiButtonState.mouseCurrentWidget of -- existing mouse-active widget?
+         Just (uiw, px') -> do
+             let target = toGUIAny (state ^. ui.uiMap) uiw
+             isIn <- (target ^. baseProperties.isInside) target (px -: px')
+             if isIn == state ^. ui.uiButtonState.mouseInside -- > moving inside or outside
+               then case target ^. eventHandlers.(at MouseMotionEvent) of --existing handler?
+                         Just ma -> do target' <- fromJust (ma ^? onMouseMove) px' target
+                                       modify $ ui.uiMap %~ Map.insert uiw target'
+                         Nothing -> return () 
+               else if isIn -- && not mouseInside --> entering
+                 then do modify $ ui.uiButtonState.mouseInside .~ True
+                         case target ^. eventHandlers.(at MouseMotionEvent) of --existing handler?
+                              Just ma -> do
+                                  target_ <- fromJust (ma ^? onMouseEnter) (px -: px') target --TODO unsafe fromJust
+                                  target' <- fromJust (ma ^? onMouseMove) (px -: px') target_ --TODO unsafe fromJust
+                                  modify $ ui.uiMap %~ Map.insert uiw target'
+                              Nothing -> return ()
+               else --  not isIn && mouseInside --> leaving
+                      do modify $ ui.uiButtonState.mouseInside .~ False
+                         case target ^. eventHandlers.(at MouseMotionEvent) of --existing handler?
+                              Just ma -> do
+                                  target_ <- fromJust (ma ^? onMouseLeave) (px -: px') target --TODO unsafe fromJust
+                                  target' <- fromJust (ma ^? onMouseMove) (px -: px') target_  -- TODO unsafe fromJust
+                                  modify $ ui.uiMap %~ Map.insert uiw target'
+                              Nothing -> return ()
+                         if state ^. ui.uiButtonState.mousePressed <= 0  -- change mouse-active widget?
+                           then mouseSwitchMouseActive px
+                           else return ()
+         Nothing -> do
+             mouseSwitchMouseActive px
+             
 
 -- | Handler for UI-Inputs.
 --   Indicates a primary click on something (e.g. left-click, touch on Touchpad, fire on Gamepad, ...
diff --git a/src/UI/UIBase.hs b/src/UI/UIBase.hs
index 9ecf55e..441d31d 100644
--- a/src/UI/UIBase.hs
+++ b/src/UI/UIBase.hs
@@ -77,6 +77,7 @@ data UIButtonState = UIButtonState
       -- ^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.
+    , _mouseInside :: Bool -- ^@True@ if the mouse is currently within the mouse-active widget
     } deriving (Show, Eq)
 
 -- |The button dependant state of a 'MouseState'.