From 26903deb1993df74b91e85ffe2eb9da7ca9e36c7 Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Sat, 5 Apr 2014 23:09:57 +0200 Subject: [PATCH] we can haz GUI? we can. --- src/Main.hs | 15 +++++++++----- src/Render/Misc.hs | 6 ++++++ src/Types.hs | 2 +- src/UI/Callbacks.hs | 48 +++++++++++++++++++++++++++++++++++++++++++-- 4 files changed, 63 insertions(+), 8 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 548ed70..b3f83b3 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -5,8 +5,8 @@ import Data.Int (Int8) import Graphics.Rendering.OpenGL.GL.Texturing.Specification (TextureSize2D) import Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable (PixelInternalFormat(..)) import Graphics.Rendering.OpenGL.GL.Texturing.Specification (texImage2D) -import Foreign.Marshal.Array (pokeArray) import Control.Monad (liftM) +import Foreign.Marshal.Array (pokeArray) import Foreign.Marshal.Alloc (allocaBytes) import Graphics.Rendering.OpenGL.GL.Texturing.Parameters (textureFilter) import Graphics.Rendering.OpenGL.GL.Texturing.Specification (TextureTarget2D(Texture2D)) @@ -53,7 +53,8 @@ import Graphics.Rendering.OpenGL.Raw.ARB.TessellationShader import Map.Map import Render.Misc (checkError, createFrustum, getCam, - curb, tryWithTexture) + curb, tryWithTexture, + genColorData) import Render.Render (initRendering, initMapShader, initHud) @@ -191,7 +192,7 @@ main = do { } , _ui = UIState - { + { _uiHasChanged = True } } @@ -227,7 +228,10 @@ draw = do tessFac = state ^. gl.glMap.stateTessellationFactor window = env ^. windowObject rb = state ^. gl.glRenderbuffer - prepareGUI + if state ^. ui.uiHasChanged then + prepareGUI + else + return () liftIO $ do --bind renderbuffer and set sample 0 as target --GL.bindRenderbuffer GL.Renderbuffer GL.$= rb @@ -470,7 +474,7 @@ adjustWindow = do allocaBytes (fbWidth*fbHeight*4) $ \ptr -> do --default to ugly pink to see if --somethings go wrong. - let imData = take (fbWidth*fbHeight*4) (cycle [255,0,255,0] :: [Int8]) + let imData = genColorData (fbWidth*fbHeight) [255,0,255,0] --putStrLn $ show imData pokeArray ptr imData -- HUD @@ -486,6 +490,7 @@ adjustWindow = do checkError "setting up HUD-Tex" return renderBuffer modify $ gl.glRenderbuffer .~ rb + modify $ ui.uiHasChanged .~ True processEvents :: Pioneers () processEvents = do diff --git a/src/Render/Misc.hs b/src/Render/Misc.hs index f4422dc..4a2e705 100644 --- a/src/Render/Misc.hs +++ b/src/Render/Misc.hs @@ -3,6 +3,7 @@ module Render.Misc where import Control.Monad import qualified Data.ByteString as B (ByteString) +import Data.Int (Int8) import Graphics.Rendering.OpenGL.GL.Shaders import Graphics.Rendering.OpenGL.GL.StateVar import Graphics.Rendering.OpenGL.GL.StringQueries @@ -125,3 +126,8 @@ tryWithTexture t f fail' = Just tex -> f tex _ -> fail' +genColorData :: Int -- ^ Amount + -> [Int8] -- ^ [r,g,b,a], [r,g,b] - whatever should be repeatet. + -> [Int8] +genColorData n c = take ((length c)*n) (cycle c) + diff --git a/src/Types.hs b/src/Types.hs index d3811ea..29d9638 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -109,7 +109,7 @@ data GLState = GLState } data UIState = UIState - { + { _uiHasChanged :: !Bool } data State = State diff --git a/src/UI/Callbacks.hs b/src/UI/Callbacks.hs index 84f113d..ad7a825 100644 --- a/src/UI/Callbacks.hs +++ b/src/UI/Callbacks.hs @@ -6,6 +6,14 @@ import Control.Monad.Trans (liftIO) import Types import UI.UITypes +import qualified Graphics.Rendering.OpenGL.GL as GL +import Control.Lens ((^.), (.~), (%~)) +import Render.Misc (genColorData) +import Foreign.Marshal.Array (pokeArray) +import Foreign.Marshal.Alloc (allocaBytes) +import Control.Monad.RWS.Strict (get, liftIO, modify) + + data Pixel = Pixel Int Int getGUI :: [GUIAny] @@ -47,12 +55,48 @@ alternateClickHandler :: Pixel -> Pioneers () alternateClickHandler (Pixel x y) = liftIO $ putStrLn $ unwords ["alternate press on (",show x,",",show y,")"] --- | informs the GUI to prepare a blitting of state ^. gl.hudTexture +-- | informs the GUI to prepare a blitting of state ^. gl.glHud.hudTexture -- --TODO: should be done asynchronously at one point. +-- -> can't. if 2 Threads bind Textures its not sure +-- on which one the GPU will work. +-- "GL.textureBinding GL.Texture2D" is a State set +-- to the texture all following works on. +-- +-- https://www.opengl.org/wiki/GLAPI/glTexSubImage2D for copy prepareGUI :: Pioneers () prepareGUI = do - return () + state <- get + let tex = (state ^. gl.glHud.hudTexture) + liftIO $ do + -- bind texture - all later calls work on this one. + GL.textureBinding GL.Texture2D GL.$= Just tex + mapM_ (copyGUI tex) getGUI + modify $ ui.uiHasChanged .~ False + +--TODO: Perform border-checking ... is xoff + width and yoff+height inside the screen-coordinates.. +copyGUI :: GL.TextureObject -> GUIAny -> IO () +copyGUI tex widget = do + let (xoff, yoff, width, height) = getBoundary widget + int = fromInteger.toInteger --conversion between Int8, GLInt, Int, ... + --temporary color here. lateron better some getData-function to + --get a list of pixel-data or a texture. + color = case widget of + (GUIAnyC _) -> [255,0,0,128] + (GUIAnyB _ _) -> [255,255,0,255] + (GUIAnyP _) -> [128,128,128,255] + _ -> [255,0,255,255] + allocaBytes (width*height*4) $ \ptr -> do + --copy data into C-Array + pokeArray ptr (genColorData (width*height) color) + GL.texSubImage2D + GL.Texture2D + 0 + (GL.TexturePosition2D (int xoff) (int yoff)) + (GL.TextureSize2D (int width) (int height)) + (GL.PixelData GL.RGBA GL.UnsignedByte ptr) + mapM_ (copyGUI tex) (getChildren widget) +copyGUI _ _ = return () --TODO: Add scroll-Handler, return (Pioneers Bool) to indicate event-bubbling etc. --TODO: Maybe queues are better?