This commit is contained in:
tpajenka 2014-05-20 20:34:05 +02:00
parent 696269c1b5
commit 74fc3af201
3 changed files with 50 additions and 52 deletions

View File

@ -311,7 +311,7 @@ prepareGUI = do
modify $ ui.uiHasChanged .~ False modify $ ui.uiHasChanged .~ False
--TODO: Perform border-checking ... is xoff + width and yoff+height inside the screen-coordinates.. --TODO: Perform border-checking ... is xoff + width and yoff+height inside the screen-coordinates..
copyGUI :: GL.TextureObject -> Pixel -- ^current view's offset copyGUI :: GL.TextureObject -> Pixel -- ^current views offset
-> GUIWidget Pioneers -- ^the widget to draw -> GUIWidget Pioneers -- ^the widget to draw
-> Pioneers () -> Pioneers ()
copyGUI tex (vX, vY) widget = do copyGUI tex (vX, vY) widget = do

View File

@ -24,7 +24,7 @@ merge :: (a -> b -> c) -> (a, a) -> (b, b) -> (c, c)
merge f (x, y) (x', y') = (f x x', f y y') merge f (x, y) (x', y') = (f x x', f y y')
{-# INLINABLE merge #-} {-# INLINABLE merge #-}
-- |Maps the over the elements of a tuple. Designed for use with 'Pixel'. -- |Maps over the elements of a tuple. Designed for use with 'Pixel'.
(>:) :: (a -> b) -> (a, a) -> (b, b) (>:) :: (a -> b) -> (a, a) -> (b, b)
f >: (x, y) = (f x, f y) f >: (x, y) = (f x, f y)
{-# INLINABLE (>:) #-} {-# INLINABLE (>:) #-}
@ -114,52 +114,50 @@ instance Hashable EventKey where -- TODO: generic deriving creates functions tha
-- |A handler to react on certain events. -- |A handler to react on certain events.
data EventHandler m = data EventHandler m =
-- |Handler to control the functionality of a 'GUIWidget' on mouse button events. -- |Handler to control the functionality of a 'GUIWidget' on mouse button events.
--
-- All screen coordinates are widget-local coordinates.
MouseHandler MouseHandler
{ {
-- |The function 'onMousePressed' is called when a button is pressed -- |The function 'onMousePressed' is called when a button is pressed
-- while the widget is mouse-active. -- while the button is mouse-active.
-- --
-- A widget becomes mouse-active if no other button is currently pressed and the mouse -- The function returns the altered widget resulting from the button press
-- coordinates are within the widget's extent ('isInside') until no button is pressed any _onMousePress :: MouseButton -> Pixel -> GUIWidget m -> m (GUIWidget m)
-- 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 -- |The function 'onMouseReleased' is called when a button is released
-- while the widget is mouse-active. -- while the widget is mouse-active.
-- --
-- Thus, the mouse is either within the widget or outside while still dragging. -- Thus, the mouse is either within the widget or outside while still dragging.
_onMouseRelease :: MouseButton -- ^the released button --
-> Pixel -- ^screen position -- The function returns the altered widget resulting from the button press
-> GUIWidget m -- ^widget the event is invoked on _onMouseRelease :: MouseButton -> Pixel -> GUIWidget m -> m (GUIWidget m)
-> m (GUIWidget m) -- ^widget after the event and the altered handler
} }
| |
-- |Handler to control the functionality of a 'GUIWidget' on mouse movement. -- |Handler to control the functionality of a 'GUIWidget' on mouse movement.
--
-- All screen coordinates are widget-local coordinates.
MouseMotionHandler MouseMotionHandler
{ {
-- |The function 'onMouseMove' is invoked when the mouse is moved inside the -- |The function 'onMouseMove' is invoked when the mouse is moved inside the
-- widget's extent ('isInside') while no button is pressed or when the mouse is inside the -- widgets 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 -- widgets extent while another button loses its mouse-active state. Triggered after
-- '_onMouseEnter'. -- '_onMouseEnter'.
_onMouseMove :: Pixel -- ^screen position --
-> GUIWidget m -- ^widget the event is invoked on -- The function returns the altered widget resulting from the button press
-> m (GUIWidget m) -- ^widget after the event and the altered handler _onMouseMove :: Pixel -> GUIWidget m -> m (GUIWidget m)
, ,
-- |The function 'onMouseMove' is invoked when the mouse enters the -- |The function 'onMouseMove' is invoked when the mouse enters the
-- widget's extent ('isInside') or when the mouse is inside the -- widgets extent ('isInside') or when the mouse is inside the
-- widget's extent while another button loses its mouse-active state.. -- widgets extent while another button loses its mouse-active state.
_onMouseEnter :: Pixel -- ^screen position --
-> GUIWidget m -- ^widget the event is invoked on -- The function returns the altered widget resulting from the button press
-> m (GUIWidget m) -- ^widget after the event and the altered handler _onMouseEnter :: Pixel -> GUIWidget m -> m (GUIWidget m)
, ,
-- |The function 'onMouseLeave' is invoked when the mouse leaves the -- |The function 'onMouseLeave' is invoked when the mouse leaves the
-- widget's extent ('isInside') while no other widget is mouse-active. -- widgets extent ('isInside') while no other widget is mouse-active.
_onMouseLeave :: Pixel -- ^screen position --
-> GUIWidget m -- ^widget the event is invoked on -- The function returns the altered widget resulting from the button press
-> m (GUIWidget m) -- ^widget after the event and the altered handler _onMouseLeave :: Pixel -> GUIWidget m -> m (GUIWidget m)
} }
deriving () deriving ()
@ -186,7 +184,7 @@ data GUIBaseProperties m = BaseProperties
, ,
-- |The @_getChildren@ function returns all children associated with this widget. -- |The @_getChildren@ function returns all children associated with this widget.
-- --
-- All children must be wholly inside the parent's bounding box specified by '_boundary'. -- All children must be wholly inside the parents bounding box specified by '_boundary'.
_children :: m [UIId] _children :: m [UIId]
, ,
-- |The function @_isInside@ tests whether a point is inside the widget itself. -- |The function @_isInside@ tests whether a point is inside the widget itself.
@ -195,9 +193,9 @@ data GUIBaseProperties m = BaseProperties
-- --
-- The default implementations tests if the point is within the rectangle specified by the -- The default implementations tests if the point is within the rectangle specified by the
-- 'getBoundary' function. -- 'getBoundary' function.
_isInside :: GUIWidget m --
-> Pixel -- ^local coordinates -- The passed coordinates are widget-local coordinates.
-> m Bool _isInside :: GUIWidget m -> Pixel -> m Bool
, ,
-- |The @_getPriority@ function returns the priority score of a @GUIWidget@. -- |The @_getPriority@ function returns the priority score of a @GUIWidget@.
-- A widget with a high score is more in the front than a low scored widget. -- A widget with a high score is more in the front than a low scored widget.
@ -223,12 +221,12 @@ $(makeLenses ''GUIWidget)
$(makeLenses ''GUIBaseProperties) $(makeLenses ''GUIBaseProperties)
$(makeLenses ''GUIGraphics) $(makeLenses ''GUIGraphics)
-- |Creates a default @MouseButtonState@.
initialButtonState :: MouseButtonState initialButtonState :: MouseButtonState
initialButtonState = MouseButtonState False False initialButtonState = MouseButtonState False False
{-# INLINE initialButtonState #-} {-# INLINE initialButtonState #-}
-- |Creates a @UIMouseState@ its @_mouseStates@ are valid 'UIMouseStateSingle' for any @MouseButton@ -- |Creates a 'MouseState' its @_mouseStates@ are valid 'MouseButtonState's for any 'MouseButton'.
-- provided in the passed list.
initialMouseState :: WidgetState initialMouseState :: WidgetState
initialMouseState = MouseState (array (minBound, maxBound) [(i, initialButtonState) | i <- range (minBound, maxBound)]) initialMouseState = MouseState (array (minBound, maxBound) [(i, initialButtonState) | i <- range (minBound, maxBound)])
False (0, 0) False (0, 0)
@ -237,21 +235,21 @@ initialMouseState = MouseState (array (minBound, maxBound) [(i, initialButtonSta
-- TODO: combined mouse handler -- TODO: combined mouse handler
-- TODO? breaks if button array not of sufficient size -- will be avoided by excluding constructor export -- 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, -- |Creates a 'MouseHandler' that sets a widgets 'MouseButtonState' properties if present,
-- only fully functional in conjunction with 'setMouseMotionStateActions'. -- only fully functional in conjunction with 'setMouseMotionStateActions'.
setMouseStateActions :: (Monad m) => EventHandler m setMouseStateActions :: (Monad m) => EventHandler m
setMouseStateActions = MouseHandler press' release' setMouseStateActions = MouseHandler press' release'
where where
-- |Change 'MouseButtonState's '_mouseIsDragging' to @True@. -- |Change 'MouseButtonState's '_mouseIsDragging' to @True@.
press' b _ w = press' b _ w =
return $ w & widgetStates.(ix MouseStateKey).mouseStates.(ix b).mouseIsDragging .~ True return $ w & widgetStates.(ix MouseStateKey).mouseStates.(ix b).mouseIsDragging .~ True
-- |Change 'MouseButtonState's '_mouseIsDragging' and '_mouseIsDeferred' to @False@. -- |Change 'MouseButtonState's '_mouseIsDragging' and '_mouseIsDeferred' to @False@.
release' b _ w = release' b _ w =
return $ w & widgetStates.(ix MouseStateKey).mouseStates.(ix b) %~ return $ w & widgetStates.(ix MouseStateKey).mouseStates.(ix b) %~
(mouseIsDragging .~ False) . (mouseIsDeferred .~ False) (mouseIsDragging .~ False) . (mouseIsDeferred .~ False)
-- |Creates a 'MouseHandler' that sets a widget's 'WidgetState MouseState' properties if present, -- |Creates a 'MouseHandler' that sets a widgets 'MouseState' properties if present,
-- only fully functional in conjunction with 'setMouseStateActions'. -- only fully functional in conjunction with 'setMouseStateActions'.
setMouseMotionStateActions :: (Monad m) => EventHandler m setMouseMotionStateActions :: (Monad m) => EventHandler m
setMouseMotionStateActions = MouseMotionHandler move' enter' leave' setMouseMotionStateActions = MouseMotionHandler move' enter' leave'
@ -259,7 +257,7 @@ setMouseMotionStateActions = MouseMotionHandler move' enter' leave'
-- |Updates mouse position. -- |Updates mouse position.
move' p w = return $ w & widgetStates.(ix MouseStateKey).mousePixel .~ p move' p w = return $ w & widgetStates.(ix MouseStateKey).mousePixel .~ p
-- |Sets '_mouseIsReady' to @True@, changes '_mouseIsDeferred' to '_mouseIsDragging's current -- |Sets '_mouseIsReady' to @True@, changes '_mouseIsDeferred' to '_mouseIsDragging's current
-- value and sets '_mouseIsDragging' to @False@. -- value and sets '_mouseIsDragging' to @False@.
enter' p w = return $ w & widgetStates.(ix MouseStateKey) enter' p w = return $ w & widgetStates.(ix MouseStateKey)
%~ (mouseIsReady .~ True) . (mousePixel .~ p) %~ (mouseIsReady .~ True) . (mousePixel .~ p)
@ -268,7 +266,7 @@ setMouseMotionStateActions = MouseMotionHandler move' enter' leave'
. (\sState -> sState & mouseIsDragging .~ not (sState ^. mouseIsDeferred))) . (\sState -> sState & mouseIsDragging .~ not (sState ^. mouseIsDeferred)))
-- |Sets '_mouseIsReady' to @False@, changes '_mouseIsDragging' to '_mouseIsDeferred's current -- |Sets '_mouseIsReady' to @False@, changes '_mouseIsDragging' to '_mouseIsDeferred's current
-- value and sets '_mouseIsDeferred' to @False@. -- value and sets '_mouseIsDeferred' to @False@.
leave' p w = return $ w & widgetStates.(ix MouseStateKey) leave' p w = return $ w & widgetStates.(ix MouseStateKey)
%~ (mouseIsReady .~ False) . (mousePixel .~ p) %~ (mouseIsReady .~ False) . (mousePixel .~ p)
@ -277,9 +275,9 @@ setMouseMotionStateActions = MouseMotionHandler move' enter' leave'
. (\sState -> sState & mouseIsDeferred .~ not (sState ^. mouseIsDragging))) . (\sState -> sState & mouseIsDeferred .~ not (sState ^. mouseIsDragging)))
-- TODO: make only fire if press started within widget -- TODO: make only fire if press started within widget
-- |Creates a MouseHandler that reacts on mouse clicks. -- |Creates a 'MouseHandler' that reacts on mouse clicks.
-- --
-- Does /not/ update 'WidgetState MouseState'! -- Does /not/ update the widgets 'MouseState'!
buttonMouseActions :: (Monad m) => (MouseButton -> GUIWidget m -> Pixel -> m (GUIWidget m)) -- ^action on button press buttonMouseActions :: (Monad m) => (MouseButton -> GUIWidget m -> Pixel -> m (GUIWidget m)) -- ^action on button press
-> EventHandler m -> EventHandler m
buttonMouseActions a = MouseHandler press' release' buttonMouseActions a = MouseHandler press' release'
@ -290,9 +288,9 @@ buttonMouseActions a = MouseHandler press' release'
if fire then a b w p else return w if fire then a b w p else return w
-- TODO: make only fire if press started within widget -- TODO: make only fire if press started within widget
-- |Creates a MouseHandler that reacts on mouse clicks. -- |Creates a 'MouseHandler' that reacts on mouse clicks.
-- --
-- Does /not/ update 'WidgetState MouseState'! -- Does /not/ update the widgets 'MouseState'!
buttonSingleMouseActions :: (Monad m) => (GUIWidget m -> Pixel -> m (GUIWidget m)) -- ^action on button press buttonSingleMouseActions :: (Monad m) => (GUIWidget m -> Pixel -> m (GUIWidget m)) -- ^action on button press
-> MouseButton -> EventHandler m -> MouseButton -> EventHandler m
buttonSingleMouseActions a btn = MouseHandler press' release' buttonSingleMouseActions a btn = MouseHandler press' release'
@ -310,7 +308,7 @@ extractExtent :: (ScreenUnit, ScreenUnit, ScreenUnit, ScreenUnit) -> (ScreenUnit
extractExtent (_,_,w,h) = (w,h) extractExtent (_,_,w,h) = (w,h)
{-# INLINABLE extractExtent #-} {-# INLINABLE extractExtent #-}
-- |Calculates whether a point's value exceed the given width and height. -- |Calculates whether a points value exceed the given width and height.
isInsideExtent :: (ScreenUnit, ScreenUnit) -> Pixel -> Bool isInsideExtent :: (ScreenUnit, ScreenUnit) -> Pixel -> Bool
isInsideExtent (w,h) (x',y') = (x' <= w) && (x' >= 0) && (y' <= h) && (y' >= 0) isInsideExtent (w,h) (x',y') = (x' <= w) && (x' >= 0) && (y' <= h) && (y' >= 0)

View File

@ -31,7 +31,7 @@ isInsideFast wg px = do
-- |The function 'getInsideId' returns child widgets that overlap with a -- |The function 'getInsideId' returns child widgets that overlap with a
-- specific screen position and the pixel's local coordinates. -- specific screen position and the pixels local coordinates.
-- --
-- A screen position may be inside the bounding box of a widget but not -- A screen position may be inside the bounding box of a widget but not
-- considered part of the component. The function returns all hit widgets that -- considered part of the component. The function returns all hit widgets that
@ -46,7 +46,7 @@ getInsideId px uid = do
(bX, bY, _, _) <- wg ^. baseProperties.boundary (bX, bY, _, _) <- wg ^. baseProperties.boundary
let px' = px -: (bX, bY) let px' = px -: (bX, bY)
inside <- isInsideFast wg px' inside <- isInsideFast wg px'
if inside -- test inside parent's bounding box if inside -- test inside parents bounding box
then do then do
childrenIds <- wg ^. baseProperties.children childrenIds <- wg ^. baseProperties.children
hitChildren <- liftM concat $ mapM (getInsideId px') childrenIds hitChildren <- liftM concat $ mapM (getInsideId px') childrenIds