From ddb99e35923f26055c466531bb14d3f7d78bfbb8 Mon Sep 17 00:00:00 2001 From: tpajenka Date: Fri, 28 Feb 2014 14:56:00 +0100 Subject: [PATCH 1/5] removed llvm dependency --- Pioneers.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Pioneers.cabal b/Pioneers.cabal index 2a39666..f9aef18 100644 --- a/Pioneers.cabal +++ b/Pioneers.cabal @@ -6,7 +6,7 @@ author: sdressel executable Pioneers hs-source-dirs: src - ghc-options: -Wall -Odph -rtsopts -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -optlo-O3 -fllvm + ghc-options: -Wall -Odph -rtsopts -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -optlo-O3 other-modules: Map.Map, Render.Misc, From 734cabb75951b72a5bb08cb14d0ba89c06a63355 Mon Sep 17 00:00:00 2001 From: tpajenka Date: Tue, 4 Mar 2014 14:31:00 +0100 Subject: [PATCH 2/5] system dependant ghc-options --- Pioneers.cabal | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/Pioneers.cabal b/Pioneers.cabal index f9aef18..1fbb7ce 100644 --- a/Pioneers.cabal +++ b/Pioneers.cabal @@ -6,7 +6,11 @@ author: sdressel executable Pioneers hs-source-dirs: src - ghc-options: -Wall -Odph -rtsopts -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -optlo-O3 + if os(windows) { + ghc-options: -Wall -Odph -rtsopts -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -optlo-O3 + } else { + ghc-options: -Wall -Odph -rtsopts -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -optlo-O3 -fllvm + } other-modules: Map.Map, Render.Misc, From be0da410a0ba522d8d06fb3487af431bd5327687 Mon Sep 17 00:00:00 2001 From: tpajenka Date: Wed, 5 Mar 2014 13:27:48 +0100 Subject: [PATCH 3/5] started creating a GUI overlay image --- Pioneers.cabal | 4 +++- src/Main.hs | 3 ++- src/UI/GUIOverlay.hs | 20 ++++++++++++++++++++ 3 files changed, 25 insertions(+), 2 deletions(-) create mode 100644 src/UI/GUIOverlay.hs diff --git a/Pioneers.cabal b/Pioneers.cabal index 1fbb7ce..03f8b90 100644 --- a/Pioneers.cabal +++ b/Pioneers.cabal @@ -11,12 +11,14 @@ executable Pioneers } else { ghc-options: -Wall -Odph -rtsopts -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -optlo-O3 -fllvm } - other-modules: + other-module Map.Map, Render.Misc, Render.Render, Render.RenderObject, UI.Callbacks, + Types, + UI.SurfaceOverlay Types main-is: Main.hs build-depends: diff --git a/src/Main.hs b/src/Main.hs index 142b6cf..bf6bb7e 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -40,6 +40,7 @@ import Render.Misc (checkError, import Render.Render (initRendering, initShader) import UI.Callbacks +import UI.GUIOverlay import Types import qualified Debug.Trace as D (trace) @@ -53,7 +54,7 @@ main = do ,WindowResizable -- and resizable ,WindowInputFocus -- focused (=> active) ,WindowMouseFocus -- Mouse into it - ,WindowInputGrabbed-- never let go of input (KB/Mouse) + --,WindowInputGrabbed-- never let go of input (KB/Mouse) ] $ \window -> do withOpenGL window $ do (Size fbWidth fbHeight) <- glGetDrawableSize window diff --git a/src/UI/GUIOverlay.hs b/src/UI/GUIOverlay.hs new file mode 100644 index 0000000..4114bda --- /dev/null +++ b/src/UI/GUIOverlay.hs @@ -0,0 +1,20 @@ +module UI.GUIOverlay where + +import Data.Int +import Graphics.UI.SDL.Surface +import Graphics.UI.SDL.Color +import Graphics.UI.SDL.Rect +import Graphics.UI.SDL.Types + +--createRGBSurface :: Int32 -> Int32 -> Int32 -> Word32 -> Word32 -> Word32 -> Word32 -> IO Surface +-- width height depth rFilter gFilter bFilter aFilter + +updateGUI :: Int32 -> Int32 -> IO Surface +updateGUI width height = do + overlay <- createRGBSurface width height 32 0xFF000000 0x00FF0000 0x0000FF00 0x000000FF + fillRect overlay (Rect 10 10 400 300) (Color 255 0 128 255) + return overlay + + +--createTextureFromSurface :: Renderer -> Surface -> IO Texture +--createSoftwareRenderer :: Surface -> IO Renderer \ No newline at end of file From d4b4f706b6438b3f567ae46318ff15a2ab958681 Mon Sep 17 00:00:00 2001 From: tpajenka Date: Sun, 9 Mar 2014 13:46:49 +0100 Subject: [PATCH 4/5] GUI data structure experiments --- src/UI/Callbacks.hs | 10 +++++++++- src/UI/GUIOverlay.hs | 2 ++ 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/src/UI/Callbacks.hs b/src/UI/Callbacks.hs index b4daff3..4218384 100644 --- a/src/UI/Callbacks.hs +++ b/src/UI/Callbacks.hs @@ -1,14 +1,22 @@ +{-# LANGUAGE ExistentialQuantification #-} + module UI.Callbacks where import Control.Monad.Trans (liftIO) import Types +import UI.UITypes 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. -- Indicates a primary click on something (e.g. left-click, touch on Touchpad, fire on Gamepad, ... 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. -- Indicates an alternate click on something (e.g. right-click, touch&hold on Touchpad, ... diff --git a/src/UI/GUIOverlay.hs b/src/UI/GUIOverlay.hs index 4114bda..f69ddd1 100644 --- a/src/UI/GUIOverlay.hs +++ b/src/UI/GUIOverlay.hs @@ -5,9 +5,11 @@ import Graphics.UI.SDL.Surface import Graphics.UI.SDL.Color import Graphics.UI.SDL.Rect import Graphics.UI.SDL.Types +import UI.UITypes --createRGBSurface :: Int32 -> Int32 -> Int32 -> Word32 -> Word32 -> Word32 -> Word32 -> IO Surface -- width height depth rFilter gFilter bFilter aFilter +-- createRGBSurface width height 32 0xFF000000 0x00FF0000 0x0000FF00 0x000000FF updateGUI :: Int32 -> Int32 -> IO Surface updateGUI width height = do From 2de621d73fbccd4d595879bf231ccabda09e9523 Mon Sep 17 00:00:00 2001 From: tpajenka Date: Sun, 9 Mar 2014 13:51:44 +0100 Subject: [PATCH 5/5] 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