2014-03-09 13:46:49 +01:00
|
|
|
{-# LANGUAGE ExistentialQuantification #-}
|
|
|
|
|
2014-02-05 21:06:19 +01:00
|
|
|
module UI.Callbacks where
|
|
|
|
|
|
|
|
import Control.Monad.Trans (liftIO)
|
|
|
|
import Types
|
2014-03-09 13:46:49 +01:00
|
|
|
import UI.UITypes
|
2014-02-05 21:06:19 +01:00
|
|
|
|
|
|
|
data Pixel = Pixel Int Int
|
|
|
|
|
2014-03-09 13:46:49 +01:00
|
|
|
getGUI :: [GUIAny]
|
2014-04-03 20:05:49 +02:00
|
|
|
getGUI = [ toGUIAny $ GUIContainer 0 0 120 80 [] 1
|
|
|
|
, toGUIAny $ GUIPanel $ GUIContainer 0 0 0 0
|
|
|
|
[toGUIAny $ GUIContainer 0 80 100 200 [] 4
|
2014-04-04 15:47:16 +02:00
|
|
|
,toGUIAny $GUIButton 50 400 200 175 2 defaultUIState testMessage
|
2014-04-03 20:05:49 +02:00
|
|
|
] 3
|
|
|
|
]
|
|
|
|
|
|
|
|
testMessage :: (Show w) => w -> ScreenUnit -> ScreenUnit -> IO w
|
|
|
|
testMessage w x y = do
|
|
|
|
putStrLn ("\tclick on " ++ show x ++ "," ++ show y)
|
|
|
|
return w
|
2014-03-09 13:46:49 +01:00
|
|
|
|
2014-02-05 21:06:19 +01:00
|
|
|
-- | Handler for UI-Inputs.
|
|
|
|
-- Indicates a primary click on something (e.g. left-click, touch on Touchpad, fire on Gamepad, ...
|
|
|
|
clickHandler :: Pixel -> Pioneers ()
|
2014-04-03 20:05:49 +02:00
|
|
|
clickHandler (Pixel x y) = case concatMap (isInside x y) getGUI of
|
2014-03-09 13:46:49 +01:00
|
|
|
[] -> liftIO $ putStrLn $ unwords ["button press on (",show x,",",show y,")"]
|
2014-04-03 20:05:49 +02:00
|
|
|
hit -> liftIO $ do
|
|
|
|
_ <- sequence $ map (\w ->
|
|
|
|
case w of
|
2014-04-04 15:47:16 +02:00
|
|
|
(GUIAnyB b h) -> do
|
2014-04-03 20:05:49 +02:00
|
|
|
putStrLn $ "hitting " ++ getShorthand w ++ ": " ++ show (getBoundary w) ++ " " ++ show (getPriority w)
|
|
|
|
++ " at ["++show x++","++show y++"]"
|
2014-04-04 15:47:16 +02:00
|
|
|
(b', h') <- onMousePressed x y b h
|
|
|
|
_ <- onMouseReleased x y b' h'
|
2014-04-03 20:05:49 +02:00
|
|
|
return ()
|
|
|
|
_ -> putStrLn $ "hitting " ++ getShorthand w ++ ": " ++ show (getBoundary w) ++ " " ++ show (getPriority w)
|
|
|
|
++ " at ["++show x++","++show y++"]"
|
|
|
|
) hit
|
|
|
|
return ()
|
|
|
|
|
2014-02-05 21:06:19 +01:00
|
|
|
|
|
|
|
-- | Handler for UI-Inputs.
|
|
|
|
-- Indicates an alternate click on something (e.g. right-click, touch&hold on Touchpad, ...
|
|
|
|
alternateClickHandler :: Pixel -> Pioneers ()
|
|
|
|
alternateClickHandler (Pixel x y) = liftIO $ putStrLn $ unwords ["alternate press on (",show x,",",show y,")"]
|
|
|
|
|
|
|
|
|
2014-03-24 08:21:30 +01:00
|
|
|
-- | informs the GUI to prepare a blitting of state ^. gl.hudTexture
|
|
|
|
--
|
|
|
|
--TODO: should be done asynchronously at one point.
|
|
|
|
prepareGUI :: Pioneers ()
|
|
|
|
prepareGUI = do
|
|
|
|
return ()
|
|
|
|
|
2014-02-05 21:06:19 +01:00
|
|
|
--TODO: Add scroll-Handler, return (Pioneers Bool) to indicate event-bubbling etc.
|
|
|
|
--TODO: Maybe queues are better?
|