we can haz GUI?
we can.
This commit is contained in:
parent
a24b562a88
commit
26903deb19
15
src/Main.hs
15
src/Main.hs
@ -5,8 +5,8 @@ import Data.Int (Int8)
|
|||||||
import Graphics.Rendering.OpenGL.GL.Texturing.Specification (TextureSize2D)
|
import Graphics.Rendering.OpenGL.GL.Texturing.Specification (TextureSize2D)
|
||||||
import Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable (PixelInternalFormat(..))
|
import Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable (PixelInternalFormat(..))
|
||||||
import Graphics.Rendering.OpenGL.GL.Texturing.Specification (texImage2D)
|
import Graphics.Rendering.OpenGL.GL.Texturing.Specification (texImage2D)
|
||||||
import Foreign.Marshal.Array (pokeArray)
|
|
||||||
import Control.Monad (liftM)
|
import Control.Monad (liftM)
|
||||||
|
import Foreign.Marshal.Array (pokeArray)
|
||||||
import Foreign.Marshal.Alloc (allocaBytes)
|
import Foreign.Marshal.Alloc (allocaBytes)
|
||||||
import Graphics.Rendering.OpenGL.GL.Texturing.Parameters (textureFilter)
|
import Graphics.Rendering.OpenGL.GL.Texturing.Parameters (textureFilter)
|
||||||
import Graphics.Rendering.OpenGL.GL.Texturing.Specification (TextureTarget2D(Texture2D))
|
import Graphics.Rendering.OpenGL.GL.Texturing.Specification (TextureTarget2D(Texture2D))
|
||||||
@ -53,7 +53,8 @@ import Graphics.Rendering.OpenGL.Raw.ARB.TessellationShader
|
|||||||
import Map.Map
|
import Map.Map
|
||||||
import Render.Misc (checkError,
|
import Render.Misc (checkError,
|
||||||
createFrustum, getCam,
|
createFrustum, getCam,
|
||||||
curb, tryWithTexture)
|
curb, tryWithTexture,
|
||||||
|
genColorData)
|
||||||
import Render.Render (initRendering,
|
import Render.Render (initRendering,
|
||||||
initMapShader,
|
initMapShader,
|
||||||
initHud)
|
initHud)
|
||||||
@ -191,7 +192,7 @@ main = do
|
|||||||
{
|
{
|
||||||
}
|
}
|
||||||
, _ui = UIState
|
, _ui = UIState
|
||||||
{
|
{ _uiHasChanged = True
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -227,7 +228,10 @@ draw = do
|
|||||||
tessFac = state ^. gl.glMap.stateTessellationFactor
|
tessFac = state ^. gl.glMap.stateTessellationFactor
|
||||||
window = env ^. windowObject
|
window = env ^. windowObject
|
||||||
rb = state ^. gl.glRenderbuffer
|
rb = state ^. gl.glRenderbuffer
|
||||||
prepareGUI
|
if state ^. ui.uiHasChanged then
|
||||||
|
prepareGUI
|
||||||
|
else
|
||||||
|
return ()
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
--bind renderbuffer and set sample 0 as target
|
--bind renderbuffer and set sample 0 as target
|
||||||
--GL.bindRenderbuffer GL.Renderbuffer GL.$= rb
|
--GL.bindRenderbuffer GL.Renderbuffer GL.$= rb
|
||||||
@ -470,7 +474,7 @@ adjustWindow = do
|
|||||||
allocaBytes (fbWidth*fbHeight*4) $ \ptr -> do
|
allocaBytes (fbWidth*fbHeight*4) $ \ptr -> do
|
||||||
--default to ugly pink to see if
|
--default to ugly pink to see if
|
||||||
--somethings go wrong.
|
--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
|
--putStrLn $ show imData
|
||||||
pokeArray ptr imData
|
pokeArray ptr imData
|
||||||
-- HUD
|
-- HUD
|
||||||
@ -486,6 +490,7 @@ adjustWindow = do
|
|||||||
checkError "setting up HUD-Tex"
|
checkError "setting up HUD-Tex"
|
||||||
return renderBuffer
|
return renderBuffer
|
||||||
modify $ gl.glRenderbuffer .~ rb
|
modify $ gl.glRenderbuffer .~ rb
|
||||||
|
modify $ ui.uiHasChanged .~ True
|
||||||
|
|
||||||
processEvents :: Pioneers ()
|
processEvents :: Pioneers ()
|
||||||
processEvents = do
|
processEvents = do
|
||||||
|
@ -3,6 +3,7 @@ module Render.Misc where
|
|||||||
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import qualified Data.ByteString as B (ByteString)
|
import qualified Data.ByteString as B (ByteString)
|
||||||
|
import Data.Int (Int8)
|
||||||
import Graphics.Rendering.OpenGL.GL.Shaders
|
import Graphics.Rendering.OpenGL.GL.Shaders
|
||||||
import Graphics.Rendering.OpenGL.GL.StateVar
|
import Graphics.Rendering.OpenGL.GL.StateVar
|
||||||
import Graphics.Rendering.OpenGL.GL.StringQueries
|
import Graphics.Rendering.OpenGL.GL.StringQueries
|
||||||
@ -125,3 +126,8 @@ tryWithTexture t f fail' =
|
|||||||
Just tex -> f tex
|
Just tex -> f tex
|
||||||
_ -> fail'
|
_ -> 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
|
data UIState = UIState
|
||||||
{
|
{ _uiHasChanged :: !Bool
|
||||||
}
|
}
|
||||||
|
|
||||||
data State = State
|
data State = State
|
||||||
|
@ -6,6 +6,14 @@ import Control.Monad.Trans (liftIO)
|
|||||||
import Types
|
import Types
|
||||||
import UI.UITypes
|
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
|
data Pixel = Pixel Int Int
|
||||||
|
|
||||||
getGUI :: [GUIAny]
|
getGUI :: [GUIAny]
|
||||||
@ -47,12 +55,48 @@ alternateClickHandler :: Pixel -> Pioneers ()
|
|||||||
alternateClickHandler (Pixel x y) = liftIO $ putStrLn $ unwords ["alternate press on (",show x,",",show y,")"]
|
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.
|
--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 :: Pioneers ()
|
||||||
prepareGUI = do
|
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: Add scroll-Handler, return (Pioneers Bool) to indicate event-bubbling etc.
|
||||||
--TODO: Maybe queues are better?
|
--TODO: Maybe queues are better?
|
||||||
|
Loading…
Reference in New Issue
Block a user