From 2de621d73fbccd4d595879bf231ccabda09e9523 Mon Sep 17 00:00:00 2001 From: tpajenka Date: Sun, 9 Mar 2014 13:51:44 +0100 Subject: [PATCH] forgot to commit a file (GUI data structure experiments) --- src/UI/UITypes.hs | 68 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 68 insertions(+) create mode 100644 src/UI/UITypes.hs diff --git a/src/UI/UITypes.hs b/src/UI/UITypes.hs new file mode 100644 index 0000000..8960f7b --- /dev/null +++ b/src/UI/UITypes.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE InstanceSigs, ExistentialQuantification #-} + +module UI.UITypes where + + +type IntScreen = Int + +data GUIAny = forall wg. GUIWidget wg => GUIAny wg + +class GUIWidget uiw where + -- |The 'getBoundary' function gives the outer extents of the 'UIWidget'. + -- The bounding box wholly contains all children components. + getBoundary :: uiw -> (IntScreen, IntScreen, IntScreen ,IntScreen) -- ^@(x, y, width, height)@ in pixels (screen coordinates) + + -- |The 'getChildren' function returns all children associated with this widget. + -- + -- All children must be wholly inside the parent's bounding box specified by 'getBoundary'. + getChildren :: uiw -> [GUIAny] + getChildren _ = [] + + -- |The function 'isInsideSelf' tests whether a point is inside the widget itself. + -- A screen position may be inside the bounding box of a widget but not considered part of the component. + isInsideSelf :: IntScreen -- ^screen x coordinate + -> IntScreen -- ^screen y coordinate + -> uiw -- ^the parent widget + -> Bool + isInsideSelf x' y' wg = let (x, y, w, h) = getBoundary wg + in (x' - x <= w) && (x' - x >= 0) && (y' - y <= h) && (y' - y >= 0) + + -- |The function 'isInside' tests whether a point is inside the widget or any child. + -- 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 have no hit children or 'Nothing' if the point neither hits any + -- component nor the parent widget itself. + isInside :: IntScreen -- ^screen x coordinate + -> IntScreen -- ^screen y coordinate + -> uiw -- ^the parent widget + -> [GUIAny] + isInside x' y' wg = + case isInsideSelf x' y' wg of -- test inside parent's bounding box + False -> [] + True -> case concat $ map (isInside x' y') (getChildren wg) of + [] -> [GUIAny wg] + l -> l + --TODO: Priority queue? + + -- |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. + getPriority :: uiw -> Int + getPriority _ = 0 + + +instance GUIWidget GUIAny where + getBoundary (GUIAny wg) = getBoundary wg + isInsideSelf x y (GUIAny wg) = isInsideSelf x y wg + isInside x y (GUIAny wg) = isInside x y wg + getChildren (GUIAny wg) = getChildren wg + getPriority (GUIAny wg) = getPriority wg + +data GUIContainer = GUIContainer {_screenX :: IntScreen, _screenY :: IntScreen + , _width :: IntScreen, _height :: IntScreen + , _children :: [GUIAny] + , _priority :: Int} + +instance GUIWidget GUIContainer where + getBoundary :: GUIContainer -> (IntScreen, IntScreen, IntScreen ,IntScreen) + getBoundary cnt = (_screenX cnt, _screenY cnt, _width cnt, _height cnt) + getChildren cnt = _children cnt + getPriority cnt = _priority cnt \ No newline at end of file