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-14 13:19:00 +02:00
parent 5f29ce7610
commit 45fe3f8493
5 changed files with 82 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Main.hs
View File

@ -44,6 +44,7 @@ import Render.Types
import UI.Callbacks
import Map.Graphics
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
}
}

1
src/Types.hs
View File

@ -137,6 +137,7 @@ data UIState = UIState
{ _uiHasChanged :: !Bool
, _uiMap :: Map.HashMap UIId (GUIWidget Pioneers)
, _uiRoots :: [UIId]
, _uiButtonState :: UIButtonState
}
data State = State

33
src/UI/Callbacks.hs
View File

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

57
src/UI/UIBase.hs
View File

@ -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)

6
src/UI/UIOperations.hs
View File

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