HUD-Texture renders.

HUD-Texture renders and the whole screen is black.

Still TODO:

- Will have to sort out alpha
- Clean up

refs #472 @5h

Pioneers.cabal

@@ -37,5 +37,6 @@ executable Pioneers
                    linear >=1.3.1 && <1.4,
                    lens >=3.10.1 && <3.11,
                    SDL2 >= 0.1.0,
-                   time >=1.4.0 && <1.5
+                   time >=1.4.0 && <1.5,
+                   GLUtil >= 0.7
 

shaders/ui/fragment.shader

@@ -1,8 +1,10 @@
-#version 330
+#version 110
 
-uniform sampler2D blitTexture;
+uniform sampler2D tex;
+varying vec2 texcoord;
 
-void main(void)
+void main()
 {
-    
+
+    gl_FragColor = texture2D(tex, texcoord);
 }

shaders/ui/vertex.shader

@@ -1,6 +1,10 @@
-#version 330
+#version 110
+
+attribute vec2 position;
+varying vec2 texcoord;
 
 void main()
 {
-  //null-program
+    gl_Position = vec4(position, 0.0, 1.0);
+    texcoord = position * vec2(0.5) + vec2(0.5);
 }

src/Main.hs

@@ -1,6 +1,18 @@
 {-# LANGUAGE BangPatterns, DoAndIfThenElse #-}
 module Main where
 
+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.Alloc (allocaBytes)
+import Graphics.Rendering.OpenGL.GL.Texturing.Parameters (textureFilter)
+import Graphics.Rendering.OpenGL.GL.Texturing.Specification (TextureTarget2D(Texture2D))
+import Graphics.Rendering.OpenGL.GL.Texturing.Objects (textureBinding)
+import Graphics.Rendering.OpenGL.GL.Texturing.Parameters (TextureFilter(..))
+
 -- Monad-foo and higher functional stuff
 import           Control.Monad                        (unless, void, when, join)
 import Control.Arrow ((***))
@@ -16,8 +28,10 @@ import           Control.Monad.RWS.Strict             (RWST, ask, asks,
 import           Data.Distributive                    (distribute, collect)
 
 -- FFI
-import           Foreign                              (Ptr, castPtr, with)
+import           Foreign                              (Ptr, castPtr, with, sizeOf)
 import           Foreign.C                            (CFloat)
+import           Foreign.C.Types                      (CInt)
+import           Data.Word                            (Word8)
 
 -- Math
 import           Control.Lens                         ((^.), (.~), (%~))
@@ -32,6 +46,7 @@ import           Graphics.UI.SDL                      as SDL
 import qualified Graphics.Rendering.OpenGL.GL         as GL
 import           Graphics.Rendering.OpenGL.Raw.Core31
 import           Data.Time                            (getCurrentTime, diffUTCTime)
+import           Graphics.GLUtil.BufferObjects        (offset0)
 
 import Graphics.Rendering.OpenGL.Raw.ARB.TessellationShader
 -- Our modules
@@ -40,7 +55,8 @@ import           Render.Misc                          (checkError,
                                                        createFrustum, getCam,
                                                        curb, tryWithTexture)
 import           Render.Render                        (initRendering,
-                                                       initMapShader)
+                                                       initMapShader,
+                                                       initHud)
 import           UI.Callbacks
 import           UI.GUIOverlay
 import           Types
@@ -84,6 +100,7 @@ main = do
         --TTF.setFontStyle font TTFNormal
         --TTF.setFontHinting font TTFHNormal
 
+        glHud <- initHud
         let zDistClosest  = 1
             zDistFarthest = zDistClosest + 30
             --TODO: Move near/far/fov to state for runtime-changability & central storage
@@ -157,7 +174,7 @@ main = do
                         }
               , _gl                  = GLState
                         { _glMap               = glMap
-                        , _hudTexture          = Nothing
+                        , _glHud               = glHud
                         }
               , _game                = GameState
                         {
@@ -202,6 +219,9 @@ draw = do
     liftIO $ do
         --(vi,GL.UniformLocation proj) <- initShader
         GL.clear [GL.ColorBuffer, GL.DepthBuffer]
+
+        GL.currentProgram GL.$= Just (state ^. gl.glMap.mapProgram)
+
         checkError "clearing buffer"
         --set up projection (= copy from state)
         with (distribute frust) $ \ptr ->
@@ -213,18 +233,18 @@ draw = do
         with (distribute cam) $ \ptr ->
               glUniformMatrix4fv vmat 1 0 (castPtr (ptr :: Ptr (M44 CFloat)))
         checkError "copy cam"
-              
+
         --set up normal--Mat transpose((model*camera)^-1)
         let normal = (case inv33 (fmap (^. _xyz) cam ^. _xyz) of
                                              (Just a) -> a
                                              Nothing  -> eye3) :: M33 CFloat
             nmap = collect id normal :: M33 CFloat --transpose...
-        
+
         with (distribute nmap) $ \ptr ->
               glUniformMatrix3fv nmat 1 0 (castPtr (ptr :: Ptr (M33 CFloat)))
 
         checkError "nmat"
-        
+
         glUniform1f tli (fromIntegral tessFac)
         glUniform1f tlo (fromIntegral tessFac)
 
@@ -236,17 +256,33 @@ draw = do
         GL.vertexAttribPointer vi GL.$= fgVertexIndex
         GL.vertexAttribArray vi   GL.$= GL.Enabled
         checkError "beforeDraw"
-        
+
         glPatchParameteri gl_PATCH_VERTICES 3
         glPolygonMode gl_FRONT gl_LINE
 
         glDrawArrays gl_PATCHES 0 (fromIntegral numVert)
-        checkError "draw"
+        checkError "draw map"
 
-        {-renderer <- getRenderer (env ^. windowObject)
+        -- Drawing HUD
+        let hud    = state ^. gl.glHud
+            stride = fromIntegral $ sizeOf (undefined::GLfloat) * 2
+            vad    = GL.VertexArrayDescriptor 2 GL.Float stride offset0
+        GL.currentProgram GL.$= Just (hud ^. hudProgram)
+        GL.activeTexture  GL.$= GL.TextureUnit 0
+        textureBinding GL.Texture2D GL.$= Just (hud ^. hudTexture)
+        
+        GL.bindBuffer GL.ArrayBuffer GL.$= Just (hud ^. hudVBO)
+        GL.vertexAttribPointer (hud ^. hudVertexIndex) GL.$= (GL.ToFloat, vad)
+        GL.vertexAttribArray   (hud ^. hudVertexIndex) GL.$= GL.Enabled
+        
+        GL.bindBuffer GL.ElementArrayBuffer GL.$= Just (hud ^. hudEBO)
+        GL.drawElements GL.TriangleStrip 4 GL.UnsignedInt offset0
+
+
+        {-let winRenderer = env ^. renderer
         tryWithTexture
                 (state ^. gl.hudTexture)                          --maybe tex
-                (\tex -> renderCopy renderer tex Nothing Nothing) --function with "hole"
+                (\tex -> renderCopy winRenderer tex Nothing Nothing) --function with "hole"
                                                        --Nothing == whole source-tex, whole dest-tex
                 (return ())                                       --fail-case-}
 
@@ -346,19 +382,20 @@ adjustWindow = do
         frust         = createFrustum fov near far ratio
     liftIO $ glViewport 0 0 (fromIntegral fbWidth) (fromIntegral fbHeight)
     modify $ camera.frustum .~ frust
-    hudTex      <- liftIO $ do
+    liftIO $ do
-                   putStrLn $ show (env ^. windowObject)
+                   let texid = state ^. gl.glHud.hudTexture
-                   case state ^. gl.hudTexture of
+                       int = fromInteger . toInteger
-                        Just tex -> destroyTexture tex
+                   textureBinding Texture2D GL.$= Just texid
-                        _ -> return ()
+                   checkError "bind HUD-Tex"
-                   winRenderer <- getRenderer (env ^. windowObject)
+                   textureFilter  Texture2D GL.$= ((Linear', Nothing), Linear')
-                   createTexture 
+                   checkError "filter HUD-Tex"
-                         winRenderer            -- where
+                   allocaBytes (fbWidth*fbHeight*4) $ \ptr -> do
-                         PixelFormatRGBA8888    -- RGBA32-bit
+                        let imData = take (fbWidth*fbHeight*4) (cycle [255,0,0,128] :: [Int8])
-                         TextureAccessStreaming -- change occasionally
+                        --putStrLn $ show imData
-                         fbWidth                -- width
+                        pokeArray ptr imData
-                         fbHeight               -- height
+                        texImage2D Texture2D GL.NoProxy 0 RGBA8 (GL.TextureSize2D (int fbWidth) (int fbHeight)) 0
-    modify $ gl.hudTexture .~ (Just hudTex) -- -}
+                                                (GL.PixelData GL.RGBA GL.UnsignedByte ptr)
+                   checkError "setting up HUD-Tex"
 
 processEvents :: Pioneers ()
 processEvents = do

src/Render/Render.hs

@@ -1,9 +1,11 @@
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, InstanceSigs, ExistentialQuantification #-}
 module Render.Render where
 
 import qualified Data.ByteString                            as B
+import           Data.Array.Storable
+import qualified Data.Vector.Storable                       as V
 import           Foreign.Marshal.Array                      (withArray)
-import           Foreign.Storable                           (sizeOf)
+import           Foreign.Storable
 import           Graphics.Rendering.OpenGL.GL.BufferObjects
 import           Graphics.Rendering.OpenGL.GL.Framebuffer   (clearColor)
 import           Graphics.Rendering.OpenGL.GL.ObjectName
@@ -11,10 +13,16 @@ import           Graphics.Rendering.OpenGL.GL.PerFragment
 import           Graphics.Rendering.OpenGL.GL.Shaders
 import           Graphics.Rendering.OpenGL.GL.StateVar
 import           Graphics.Rendering.OpenGL.GL.VertexArrays  (Capability (..),
-                                                             vertexAttribArray)
+                                                             vertexAttribArray,
+                                                             VertexArrayDescriptor,
+                                                             DataType(Float))
 import           Graphics.Rendering.OpenGL.GL.VertexSpec
 import           Graphics.Rendering.OpenGL.Raw.Core31
 import           Render.Misc
+import           Foreign.Ptr                                (Ptr, wordPtrToPtr)
+
+import           Types
+import           Graphics.GLUtil.BufferObjects              (makeBuffer)
 
 mapVertexShaderFile :: String
 mapVertexShaderFile = "shaders/map/vertex.shader"
@@ -30,7 +38,6 @@ uiVertexShaderFile = "shaders/ui/vertex.shader"
 uiFragmentShaderFile :: String
 uiFragmentShaderFile = "shaders/ui/fragment.shader"
 
-
 initBuffer :: [GLfloat] -> IO BufferObject
 initBuffer varray =
         let
@@ -113,27 +120,51 @@ initMapShader = do
    checkError "initShader"
    return (program, colorIndex, normalIndex, vertexIndex, projectionMatrixIndex, viewMatrixIndex, modelMatrixIndex, normalMatrixIndex, tessLevelInner, tessLevelOuter)
 
-{-initUIShader :: IO (
+initHud :: IO GLHud
-                        Program         -- ^ the GLSL-program
+initHud = do
-                      , AttribLocation  -- ^ the UI-Texture
+   ! vertexSource <- B.readFile "shaders/ui/vertex.shader"
-                   )
+   ! fragmentSource <- B.readFile "shaders/ui/fragment.shader"
-initUIShader = do
-   ! vertexSource <- B.readFile uiVertexShaderFile
-   ! fragmentSource <- B.readFile uiFragmentShaderFile
    vertexShader <- compileShaderSource VertexShader vertexSource
-   checkError "compile Vertex"
+   checkError "compile UI-Vertex"
    fragmentShader <- compileShaderSource FragmentShader fragmentSource
-   checkError "compile Frag"
+   checkError "compile UI-Fragment"
    program <- createProgramUsing [vertexShader, fragmentShader]
    checkError "compile Program"
-   
+
+   tex <- genObjectName
+
+   currentProgram $= Just program
+
+   texIndex <- get (uniformLocation program "tex")
+   checkError "ui-tex"
+
+   -- | simple triangle over the whole screen.
+   let vertexBufferData = reverse [-1, -1, 1, -1, -1, 1, 1, 1] :: [GLfloat]
+
+   vertexIndex <- get (attribLocation program "position")
+   vertexAttribArray vertexIndex $= Enabled
+   checkError "vertexInd"
+
+   ebo <- makeBuffer ElementArrayBuffer ([0..3] :: [GLuint])
+   vbo <- makeBuffer ArrayBuffer        vertexBufferData
+
    att <- get (activeAttribs program)
 
    putStrLn $ unlines $ "Attributes: ":map show att
-   putStrLn $ unlines $ ["Indices: ", show (colorIndex, normalIndex, vertexIndex)]
+   putStrLn $ unlines $ ["Indices: ", show (texIndex)]
+
+   checkError "initHud"
+   return GLHud
+        { _hudTexture           = tex
+        , _hudTexIndex          = texIndex
+        , _hudVertexIndex       = vertexIndex
+        , _hudVert              = 4
+        , _hudVBO               = vbo
+        , _hudEBO               = ebo
+        , _hudProgram           = program
+        }
+        
 
-   checkError "initShader"
-   return (program, )-}
 
 
 initRendering :: IO ()

src/Types.hs

@@ -9,6 +9,7 @@ import           Data.Time                            (UTCTime)
 import Linear.Matrix (M44)
 import Control.Monad.RWS.Strict (RWST)
 import Control.Lens
+import Graphics.Rendering.OpenGL.GL.Texturing.Objects (TextureObject)
 
 
 --Static Read-Only-State
@@ -88,9 +89,19 @@ data GLMapState = GLMapState
     , _mapProgram           :: !GL.Program
     }
 
+data GLHud = GLHud
+    { _hudTexture               :: !TextureObject       -- ^ Texture itself
+    , _hudTexIndex              :: !GL.UniformLocation  -- ^ Position of Texture in Shader
+    , _hudVertexIndex           :: !GL.AttribLocation   -- ^ Position of Vertices in Shader
+    , _hudVert                  :: !GL.NumArrayIndices  -- ^ Number of Vertices to draw
+    , _hudVBO                   :: !GL.BufferObject     -- ^ Vertex-Buffer-Object
+    , _hudEBO                   :: !GL.BufferObject     -- ^ Element-Buffer-Object
+    , _hudProgram               :: !GL.Program          -- ^ Program for rendering HUD
+    }
+
 data GLState = GLState
     { _glMap               :: !GLMapState
-    , _hudTexture      :: Maybe Texture
+    , _glHud               :: !GLHud
     }
 
 data UIState = UIState
@@ -111,6 +122,7 @@ data State = State
 $(makeLenses ''State)
 $(makeLenses ''GLState)
 $(makeLenses ''GLMapState)
+$(makeLenses ''GLHud)
 $(makeLenses ''KeyboardState)
 $(makeLenses ''ArrowKeyState)
 $(makeLenses ''MouseState)