diff --git a/Pioneers.cabal b/Pioneers.cabal index 03f8b90..70212e5 100644 --- a/Pioneers.cabal +++ b/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 diff --git a/shaders/ui/fragment.shader b/shaders/ui/fragment.shader index bcb4243..bcc5b9f 100644 --- a/shaders/ui/fragment.shader +++ b/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); } \ No newline at end of file diff --git a/shaders/ui/vertex.shader b/shaders/ui/vertex.shader index 06cd201..4ac8ec0 100644 --- a/shaders/ui/vertex.shader +++ b/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); } \ No newline at end of file diff --git a/src/Main.hs b/src/Main.hs index ec7e0c8..946efb5 100644 --- a/src/Main.hs +++ b/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 - putStrLn $ show (env ^. windowObject) - case state ^. gl.hudTexture of - Just tex -> destroyTexture tex - _ -> return () - winRenderer <- getRenderer (env ^. windowObject) - createTexture - winRenderer -- where - PixelFormatRGBA8888 -- RGBA32-bit - TextureAccessStreaming -- change occasionally - fbWidth -- width - fbHeight -- height - modify $ gl.hudTexture .~ (Just hudTex) -- -} + liftIO $ do + let texid = state ^. gl.glHud.hudTexture + int = fromInteger . toInteger + textureBinding Texture2D GL.$= Just texid + checkError "bind HUD-Tex" + textureFilter Texture2D GL.$= ((Linear', Nothing), Linear') + checkError "filter HUD-Tex" + allocaBytes (fbWidth*fbHeight*4) $ \ptr -> do + let imData = take (fbWidth*fbHeight*4) (cycle [255,0,0,128] :: [Int8]) + --putStrLn $ show imData + pokeArray ptr imData + texImage2D Texture2D GL.NoProxy 0 RGBA8 (GL.TextureSize2D (int fbWidth) (int fbHeight)) 0 + (GL.PixelData GL.RGBA GL.UnsignedByte ptr) + checkError "setting up HUD-Tex" processEvents :: Pioneers () processEvents = do diff --git a/src/Render/Render.hs b/src/Render/Render.hs index e06d4a1..3b1aaf8 100644 --- a/src/Render/Render.hs +++ b/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 ( - Program -- ^ the GLSL-program - , AttribLocation -- ^ the UI-Texture - ) -initUIShader = do - ! vertexSource <- B.readFile uiVertexShaderFile - ! fragmentSource <- B.readFile uiFragmentShaderFile +initHud :: IO GLHud +initHud = do + ! vertexSource <- B.readFile "shaders/ui/vertex.shader" + ! fragmentSource <- B.readFile "shaders/ui/fragment.shader" 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 () diff --git a/src/Types.hs b/src/Types.hs index 20ec2a1..10afc00 100644 --- a/src/Types.hs +++ b/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)