haddock
This commit is contained in:
parent
696269c1b5
commit
74fc3af201
@ -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 view’s 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
|
||||||
|
@ -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
|
-- 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
|
-- widget’s 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
|
-- widget’s extent ('isInside') or when the mouse is inside the
|
||||||
-- widget's extent while another button loses its mouse-active state..
|
-- widget’s 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.
|
-- widget’s 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 parent’s 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 widget’s '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 widget’s '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 widget’s '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 widget’s '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 point’s 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)
|
||||||
|
|
||||||
|
@ -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 pixel’s 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 parent’s 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
|
||||||
|
Loading…
Reference in New Issue
Block a user