we can haz GUI?
we can.
This commit is contained in:
Stefan Dresselhaus
13
src/Main.hs
13
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
|
||||
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
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
@@ -109,7 +109,7 @@ data GLState = GLState
|
||||
}
|
||||
|
||||
data UIState = UIState
|
||||
{
|
||||
{ _uiHasChanged :: !Bool
|
||||
}
|
||||
|
||||
data State = State
|
||||
|
||||
@@ -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?
|
||||
|
||||
Reference in New Issue
Block a user