WIP-Commit. DOES NOT WORK.

shaders/ui/fragment.shader

@@ -0,0 +1,8 @@
+#version 330
+
+uniform sampler2D blitTexture;
+
+void main(void)
+{
+    
+}

shaders/ui/vertex.shader

@@ -0,0 +1,6 @@
+#version 330
+
+void main()
+{
+  //null-program
+}

src/Main.hs

@@ -38,13 +38,15 @@ import Graphics.Rendering.OpenGL.Raw.ARB.TessellationShader
 import           Map.Map
 import           Render.Misc                          (checkError,
                                                        createFrustum, getCam,
-                                                       curb)
+                                                       curb, tryWithTexture)
 import           Render.Render                        (initRendering,
-                                                       initShader)
+                                                       initMapShader)
 import           UI.Callbacks
 import           UI.GUIOverlay
 import           Types
 
+import           ThirdParty.Flippers
+
 import qualified Debug.Trace                          as D (trace)
 
 --------------------------------------------------------------------------------
@@ -64,7 +66,7 @@ main = do
         initRendering
         --generate map vertices
         (mapBuffer, vert) <- getMapBufferObject
-        (ci, ni, vi, pri, vii, mi, nmi, tli, tlo) <- initShader
+        (mapprog, ci, ni, vi, pri, vii, mi, nmi, tli, tlo) <- initMapShader
         putStrLn "foo"
         eventQueue <- newTQueueIO :: IO (TQueue Event)
         putStrLn "foo"
@@ -101,6 +103,7 @@ main = do
                 , _stateTessellationFactor = 4
                 , _stateMap             = mapBuffer
                 , _mapVert              = vert
+                , _mapProgram           = mapprog
                 }
             env = Env
               { _eventsChan      = eventQueue
@@ -150,6 +153,9 @@ main = do
               , _game                = GameState
                         {
                         }
+              , _ui                  = UIState
+                        {
+                        }
               }
 
         putStrLn "init done."
@@ -162,6 +168,7 @@ main = do
 draw :: Pioneers ()
 draw = do
     state <- get
+    env <- ask
     let xa       = state ^. camera.xAngle
         ya       = state ^. camera.yAngle
         (GL.UniformLocation proj)  = state ^. gl.glMap.shdrProjMatIndex   
@@ -179,6 +186,8 @@ draw = do
         camY     = state ^. camera.camPosition.y
         zDist'   = state ^. camera.zDist
         tessFac  = state ^. gl.glMap.stateTessellationFactor
+        window   = env ^. windowObject
+    prepareGUI
     liftIO $ do
         --(vi,GL.UniformLocation proj) <- initShader
         GL.clear [GL.ColorBuffer, GL.DepthBuffer]
@@ -223,6 +232,12 @@ draw = do
         glDrawArrays gl_PATCHES 0 (fromIntegral numVert)
         checkError "draw"
 
+        {-renderer <- getRenderer (env ^. windowObject)
+        tryWithTexture
+                (state ^. gl.hudTexture)                          --maybe tex
+                (\tex -> renderCopy renderer tex Nothing Nothing) --function with "hole"
+                                                       --Nothing == whole source-tex, whole dest-tex
+                (return ())                                       --fail-case-}
 
 -- Main game loop
 
@@ -320,7 +335,7 @@ adjustWindow = do
         frust         = createFrustum fov near far ratio
     liftIO $ glViewport 0 0 (fromIntegral fbWidth) (fromIntegral fbHeight)
     modify $ camera.frustum .~ frust
-    hudTex      <- liftIO $ do
+    {-hudTex      <- liftIO $ do
                    case state ^. gl.hudTexture of
                         Just tex -> destroyTexture tex
                         _ -> return ()
@@ -331,7 +346,7 @@ adjustWindow = do
                          TextureAccessStreaming -- change occasionally
                          fbWidth                -- width
                          fbHeight               -- height
-    modify $ gl.hudTexture .~ (Just hudTex)
+    modify $ gl.hudTexture .~ (Just hudTex)-}
 
 processEvents :: Pioneers ()
 processEvents = do
@@ -344,7 +359,7 @@ processEvents = do
 
 processEvent :: Event -> Pioneers ()
 processEvent e = do
-        return ()
+        env <- ask
         case eventData e of
             Window _ winEvent ->
                 case winEvent of
@@ -363,6 +378,10 @@ processEvent e = do
                      -- need modifiers? use "keyModifiers key" to get them
                 let aks = keyboard.arrowsPressed in
                 case keyScancode key of
+                    SDL.R    ->
+                        liftIO $ do
+                                r <- getRenderer $ env ^. windowObject
+                                putStrLn $ unwords ["Renderer: ",show r]
                     Escape   ->
                         modify $ window.shouldClose .~ True
                     SDL.Left  ->

src/Render/Misc.hs

@@ -8,6 +8,7 @@ import           Graphics.Rendering.OpenGL.GL.StateVar
 import           Graphics.Rendering.OpenGL.GL.StringQueries
 import           Graphics.Rendering.OpenGL.GLU.Errors
 import           Graphics.Rendering.OpenGL.Raw.Core31
+import           Graphics.UI.SDL.Types                      (Texture)
 import           System.IO                                  (hPutStrLn, stderr)
 import Linear
 import Foreign.C (CFloat)
@@ -116,3 +117,10 @@ curb l h x
   | x < l     = l
   | x > h     = h
   | otherwise = x
+
+
+tryWithTexture :: Maybe Texture -> (Texture -> a) -> a -> a
+tryWithTexture t f fail' =
+        case t of
+                Just tex -> f tex
+                _ -> fail'

src/Render/Render.hs

@@ -16,14 +16,20 @@ import           Graphics.Rendering.OpenGL.GL.VertexSpec
 import           Graphics.Rendering.OpenGL.Raw.Core31
 import           Render.Misc
 
-vertexShaderFile :: String
+mapVertexShaderFile :: String
-vertexShaderFile = "shaders/vertex.shader"
+mapVertexShaderFile = "shaders/map/vertex.shader"
-tessControlShaderFile :: String
+mapTessControlShaderFile :: String
-tessControlShaderFile = "shaders/tessControl.shader"
+mapTessControlShaderFile = "shaders/map/tessControl.shader"
-tessEvalShaderFile :: String
+mapTessEvalShaderFile :: String
-tessEvalShaderFile = "shaders/tessEval.shader"
+mapTessEvalShaderFile = "shaders/map/tessEval.shader"
-fragmentShaderFile :: String
+mapFragmentShaderFile :: String
-fragmentShaderFile = "shaders/fragment.shader"
+mapFragmentShaderFile = "shaders/map/fragment.shader"
+
+uiVertexShaderFile :: String
+uiVertexShaderFile = "shaders/ui/vertex.shader"
+uiFragmentShaderFile :: String
+uiFragmentShaderFile = "shaders/ui/fragment.shader"
+
 
 initBuffer :: [GLfloat] -> IO BufferObject
 initBuffer varray =
@@ -38,8 +44,9 @@ initBuffer varray =
            checkError "initBuffer"
            return bufferObject
 
-initShader :: IO (
+initMapShader :: IO (
-                        AttribLocation  -- ^ color
+                      Program           -- ^ the GLSL-Program
+                      , AttribLocation  -- ^ color
                       , AttribLocation  -- ^ normal
                       , AttribLocation  -- ^ vertex
                       , UniformLocation -- ^ ProjectionMat
@@ -49,17 +56,17 @@ initShader :: IO (
                       , UniformLocation -- ^ TessLevelInner
                       , UniformLocation -- ^ TessLevelOuter
                       )
-initShader = do
+initMapShader = do
-   ! vertexSource <- B.readFile vertexShaderFile
+   ! vertexSource <- B.readFile mapVertexShaderFile
-   ! tessControlSource <- B.readFile tessControlShaderFile
+   ! tessControlSource <- B.readFile mapTessControlShaderFile
-   ! tessEvalSource <- B.readFile tessEvalShaderFile
+   ! tessEvalSource <- B.readFile mapTessEvalShaderFile
-   ! fragmentSource <- B.readFile fragmentShaderFile
+   ! fragmentSource <- B.readFile mapFragmentShaderFile
    vertexShader <- compileShaderSource VertexShader vertexSource
    checkError "compile Vertex"
    tessControlShader <- compileShaderSource TessControlShader tessControlSource
-   checkError "compile Vertex"
+   checkError "compile TessControl"
    tessEvalShader <- compileShaderSource TessEvaluationShader tessEvalSource
-   checkError "compile Vertex"
+   checkError "compile TessEval"
    fragmentShader <- compileShaderSource FragmentShader fragmentSource
    checkError "compile Frag"
    program <- createProgramUsing [vertexShader, tessControlShader, tessEvalShader, fragmentShader]
@@ -104,7 +111,30 @@ initShader = do
    putStrLn $ unlines $ ["Indices: ", show (colorIndex, normalIndex, vertexIndex)]
 
    checkError "initShader"
-   return (colorIndex, normalIndex, vertexIndex, projectionMatrixIndex, viewMatrixIndex, modelMatrixIndex, normalMatrixIndex, tessLevelInner, tessLevelOuter)
+   return (program, colorIndex, normalIndex, vertexIndex, projectionMatrixIndex, viewMatrixIndex, modelMatrixIndex, normalMatrixIndex, tessLevelInner, tessLevelOuter)
+
+{-initUIShader :: IO (
+                        Program         -- ^ the GLSL-program
+                      , AttribLocation  -- ^ the UI-Texture
+                   )
+initUIShader = do
+   ! vertexSource <- B.readFile uiVertexShaderFile
+   ! fragmentSource <- B.readFile uiFragmentShaderFile
+   vertexShader <- compileShaderSource VertexShader vertexSource
+   checkError "compile Vertex"
+   fragmentShader <- compileShaderSource FragmentShader fragmentSource
+   checkError "compile Frag"
+   program <- createProgramUsing [vertexShader, fragmentShader]
+   checkError "compile Program"
+   
+   att <- get (activeAttribs program)
+
+   putStrLn $ unlines $ "Attributes: ":map show att
+   putStrLn $ unlines $ ["Indices: ", show (colorIndex, normalIndex, vertexIndex)]
+
+   checkError "initShader"
+   return (program, )-}
+
 
 initRendering :: IO ()
 initRendering = do

src/Types.hs

@@ -84,6 +84,7 @@ data GLMapState = GLMapState
     , _stateTessellationFactor :: !Int
     , _stateMap             :: !GL.BufferObject
     , _mapVert              :: !GL.NumArrayIndices
+    , _mapProgram           :: !GL.Program
     }
 
 data GLState = GLState
@@ -91,6 +92,10 @@ data GLState = GLState
     , _hudTexture      :: Maybe Texture
     }
 
+data UIState = UIState
+    {
+    }
+
 data State = State
     { _window              :: !WindowState
     , _camera              :: !CameraState
@@ -99,6 +104,7 @@ data State = State
     , _keyboard            :: !KeyboardState
     , _gl                  :: !GLState
     , _game                :: !GameState
+    , _ui                  :: !UIState
     }
 
 $(makeLenses ''State)
@@ -113,6 +119,7 @@ $(makeLenses ''CameraState)
 $(makeLenses ''WindowState)
 $(makeLenses ''Position)
 $(makeLenses ''Env)
+$(makeLenses ''UIState)
 
 
 type Pioneers = RWST Env () State IO

src/UI/Callbacks.hs

@@ -24,5 +24,12 @@ 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
+--
+--TODO: should be done asynchronously at one point.
+prepareGUI :: Pioneers ()
+prepareGUI = do
+                return ()
+
 --TODO: Add scroll-Handler, return (Pioneers Bool) to indicate event-bubbling etc.
 --TODO: Maybe queues are better?