GUI data structure experiments

This commit is contained in:
tpajenka 2014-03-09 13:46:49 +01:00
parent be0da410a0
commit d4b4f706b6
2 changed files with 11 additions and 1 deletions

View File

@ -1,14 +1,22 @@
{-# LANGUAGE ExistentialQuantification #-}
module UI.Callbacks where module UI.Callbacks where
import Control.Monad.Trans (liftIO) import Control.Monad.Trans (liftIO)
import Types import Types
import UI.UITypes
data Pixel = Pixel Int Int data Pixel = Pixel Int Int
getGUI :: [GUIAny]
getGUI = (GUIAny $ GUIContainer 0 0 120 80 [] 1):(GUIAny $ GUIContainer 50 60 300 700 [(GUIAny $ GUIContainer 55 65 200 400 [] 5)] 1):[]
-- | Handler for UI-Inputs. -- | Handler for UI-Inputs.
-- Indicates a primary click on something (e.g. left-click, touch on Touchpad, fire on Gamepad, ... -- Indicates a primary click on something (e.g. left-click, touch on Touchpad, fire on Gamepad, ...
clickHandler :: Pixel -> Pioneers () clickHandler :: Pixel -> Pioneers ()
clickHandler (Pixel x y) = liftIO $ putStrLn $ unwords ["button press on (",show x,",",show y,")"] clickHandler (Pixel x y) = case concat $ map (isInside x y) getGUI of
[] -> liftIO $ putStrLn $ unwords ["button press on (",show x,",",show y,")"]
hit -> liftIO $ putStrLn $ unwords $ foldl (++) ["hitting"] ([map (\w -> (show.getBoundary) w ++ ' ':(show.getPriority) w) hit])
-- | Handler for UI-Inputs. -- | Handler for UI-Inputs.
-- Indicates an alternate click on something (e.g. right-click, touch&hold on Touchpad, ... -- Indicates an alternate click on something (e.g. right-click, touch&hold on Touchpad, ...

View File

@ -5,9 +5,11 @@ import Graphics.UI.SDL.Surface
import Graphics.UI.SDL.Color import Graphics.UI.SDL.Color
import Graphics.UI.SDL.Rect import Graphics.UI.SDL.Rect
import Graphics.UI.SDL.Types import Graphics.UI.SDL.Types
import UI.UITypes
--createRGBSurface :: Int32 -> Int32 -> Int32 -> Word32 -> Word32 -> Word32 -> Word32 -> IO Surface --createRGBSurface :: Int32 -> Int32 -> Int32 -> Word32 -> Word32 -> Word32 -> Word32 -> IO Surface
-- width height depth rFilter gFilter bFilter aFilter -- width height depth rFilter gFilter bFilter aFilter
-- createRGBSurface width height 32 0xFF000000 0x00FF0000 0x0000FF00 0x000000FF
updateGUI :: Int32 -> Int32 -> IO Surface updateGUI :: Int32 -> Int32 -> IO Surface
updateGUI width height = do updateGUI width height = do