diff --git a/Pioneers.cabal b/Pioneers.cabal index 2a39666..03f8b90 100644 --- a/Pioneers.cabal +++ b/Pioneers.cabal @@ -6,13 +6,19 @@ 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 - other-modules: + 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-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 67d30fd..a1d3adb 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -42,6 +42,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) @@ -55,7 +56,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 --TTF.withInit $ do 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 new file mode 100644 index 0000000..f69ddd1 --- /dev/null +++ b/src/UI/GUIOverlay.hs @@ -0,0 +1,22 @@ +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 +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 + 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 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