Drezil/pioneers
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

revising preliminary inflexible button handling callback

Browse Source
This commit is contained in:
tpajenka 2014-05-15 21:43:26 +02:00
parent 45fe3f8493
commit 51c48e62db
3 changed files with 68 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Main.hs
View File

@ -162,7 +162,7 @@ main =
{ _uiHasChanged = True
, _uiMap = guiMap
, _uiRoots = guiRoots
, _uiButtonState = UI.UIButtonState 0 Nothing
, _uiButtonState = UI.UIButtonState 0 Nothing False
}
}

69
src/UI/Callbacks.hs
View File

@ -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, ...

1
src/UI/UIBase.hs
View File

@ -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'.