diff --git a/data/normalMaps/diffuseArray.png b/data/normalMaps/diffuseArray.png index 282d4c0e3..367469a0b 100644 Binary files a/data/normalMaps/diffuseArray.png and b/data/normalMaps/diffuseArray.png differ diff --git a/data/normalMaps/normalArray.png b/data/normalMaps/normalArray.png index 8f06ad367..e4f7c40f9 100644 Binary files a/data/normalMaps/normalArray.png and b/data/normalMaps/normalArray.png differ diff --git a/src/Data/Preload/Render.hs b/src/Data/Preload/Render.hs index 090e21306..0062baba3 100644 --- a/src/Data/Preload/Render.hs +++ b/src/Data/Preload/Render.hs @@ -10,34 +10,30 @@ import qualified Data.Vector.Mutable as MV import Graphics.GL.Core45 import Shader.Data -newtype FBO = FBO {_unFBO :: GLuint} - -newtype TO = TO {_unTO :: GLuint} - data RenderData = RenderData - { _lightingWallShadShader :: FullShader - , _lightingLineShadowShader :: FullShader - , _lightingCapShader :: FullShader - , _lightingTextureShader :: FullShader + { _lightingWallShadShader :: Shader + , _lightingLineShadowShader :: Shader + , _lightingCapShader :: Shader + , _lightingTextureShader :: Shader , _alphaDivideShader :: Shader - , _shadowEdgeShader :: FullShader - , _shadowCapShader :: FullShader - , _shadowWallShader :: FullShader - , _shadowLightShader :: (FullShader,VBO) - , _shadowCombineShader :: (FullShader,VBO) - , _positionalBlankShader :: (FullShader,VBO) - , _wallBlankShader :: FullShader - , _windowShader :: FullShader - , _wallTextureShader :: FullShader + , _shadowEdgeShader :: Shader + , _shadowCapShader :: Shader + , _shadowWallShader :: Shader + , _shadowLightShader :: (Shader,VBO) + , _shadowCombineShader :: (Shader,VBO) + , _positionalBlankShader :: (Shader,VBO) + , _wallBlankShader :: Shader + , _windowShader :: Shader + , _wallTextureShader :: Shader , _fullscreenShader :: Shader - , _bloomBlurShader :: FullShader - , _colorBlurShader :: FullShader - , _barrelShader :: (FullShader,VBO) - , _grayscaleShader :: FullShader - , _shapeShader :: FullShader + , _bloomBlurShader :: Shader + , _colorBlurShader :: Shader + , _barrelShader :: (Shader,VBO) + , _grayscaleShader :: Shader + , _shapeShader :: Shader , _shapeEBO :: EBO , _silhouetteEBO :: EBO - , _pictureShaders :: MV.MVector (PrimState IO) (FullShader,VBO) + , _pictureShaders :: MV.MVector (PrimState IO) (Shader,VBO) , _fbo2 :: (FBO, TO) , _fbo3 :: (FBO, TO) , _fboHalf1 :: (FBO, TO) @@ -57,11 +53,11 @@ data RenderData = RenderData , _vboWindows :: VBO , _vboShapes :: VBO , _floorVBO :: VBO - , _floorShader :: FullShader + , _floorShader :: Shader , _toNormalMaps :: TO , _toDiffuse :: TO , _wallVBO :: VBO - , _wallShader :: FullShader + , _wallShader :: Shader , _cloudVBO :: VBO , _cloudShader :: Shader , _cloudEBO :: EBO @@ -69,5 +65,3 @@ data RenderData = RenderData } makeLenses ''RenderData -makeLenses ''FBO -makeLenses ''TO diff --git a/src/Dodge/Placement/Instance/Wall.hs b/src/Dodge/Placement/Instance/Wall.hs index a845093e9..2c48a6660 100644 --- a/src/Dodge/Placement/Instance/Wall.hs +++ b/src/Dodge/Placement/Instance/Wall.hs @@ -89,8 +89,9 @@ baseBlockPane = { _wlLine = (V2 0 0, V2 50 0) , _wlID = 0 --, _wlColor = greyN 0.5 - , _wlColor = orange - , _wlOpacity = Opaque 10 + , _wlColor = dark $ dark orange + --, _wlOpacity = Opaque 10 + , _wlOpacity = Opaque 14 , _wlUnshadowed = True , _wlFireThrough = True , _wlPenetrable = True diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 957b68970..9e0e3edfe 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -30,7 +30,6 @@ import qualified SDL import Shader import Shader.Bind import Shader.Data -import Shader.ExtraPrimitive import Shader.Parameters import Shader.Poke @@ -134,15 +133,15 @@ doDrawing' win pdata u = do ptr glDepthFunc GL_LESS -- draw wall occlusions from the camera's point of view - glUseProgram (pdata ^. lightingWallShadShader . shadName) - glProgramUniform3f (pdata ^. lightingWallShadShader . shadName) + glUseProgram (pdata ^. lightingWallShadShader . shaderUINT) + glProgramUniform3f (pdata ^. lightingWallShadShader . shaderUINT) 0 vfx vfy 20 - glProgramUniform1f (pdata ^. lightingWallShadShader . shadName) + glProgramUniform1f (pdata ^. lightingWallShadShader . shaderUINT) 1 1000 - glBindVertexArray $ pdata ^. lightingWallShadShader . shadVAO . vaoName + glBindVertexArray $ pdata ^. lightingWallShadShader . shaderVAO . vaoName unless (debugOn Remove_LOS cfig) $ glDrawArrays - (marshalEPrimitiveMode $ pdata ^. lightingWallShadShader . shadPrim') + (_unPrimitiveMode $ pdata ^. lightingWallShadShader . shaderPrimitive) 0 (fromIntegral nWalls) -- clear normals @@ -153,15 +152,13 @@ doDrawing' win pdata u = do ptr --draw walls onto base buffer glDisable GL_BLEND - glBindTextureUnit 1 (pdata ^. toNormalMaps . unTO) - glBindTextureUnit 2 (pdata ^. toDiffuse . unTO) -- maybe cull faces? maybe do this before? --glEnable GL_CULL_FACE --glCullFace GL_BACK - glUseProgram (pdata ^. wallShader . shadName) - glBindVertexArray $ pdata ^. wallShader . shadVAO . vaoName + glUseProgram (pdata ^. wallShader . shaderUINT) + glBindVertexArray $ pdata ^. wallShader . shaderVAO . vaoName glDrawArrays - (marshalEPrimitiveMode $ pdata ^. wallShader . shadPrim') + (_unPrimitiveMode $ pdata ^. wallShader . shaderPrimitive) 0 (fromIntegral trueNWalls) --glDisable GL_CULL_FACE @@ -172,23 +169,24 @@ doDrawing' win pdata u = do renderLayer BottomLayer shadV layerCounts --draw object shapes onto base buffer let fs = _shapeShader pdata - glUseProgram (_shadName fs) - glBindVertexArray $ fs ^. shadVAO . vaoName + glUseProgram (_shaderUINT fs) + glBindVertexArray $ fs ^. shaderVAO . vaoName -- glEnable GL_CULL_FACE -- glCullFace GL_BACK glDrawElements - (marshalEPrimitiveMode $ _shadPrim' fs) + (_unPrimitiveMode $ _shaderPrimitive fs) (fromIntegral nIndices) GL_UNSIGNED_SHORT nullPtr glDisable GL_CULL_FACE --draw floor onto base buffer - glUseProgram (pdata ^. floorShader . shadName) - glBindVertexArray $ pdata ^. floorShader . shadVAO . vaoName + glUseProgram (pdata ^. floorShader . shaderUINT) + glBindVertexArray $ pdata ^. floorShader . shaderVAO . vaoName glBindTextureUnit 1 (pdata ^. toNormalMaps . unTO) + --glTextureParameteri (pdata ^. toNormalMaps . unTO) GL_TEXTURE_BASE_LEVEL 3 glBindTextureUnit 2 (pdata ^. toDiffuse . unTO) glDrawArrays - (marshalEPrimitiveMode $ pdata ^. floorShader . shadPrim' ) + (_unPrimitiveMode $ pdata ^. floorShader . shaderPrimitive ) 0 (fromIntegral nFls) glEnable GL_BLEND @@ -234,7 +232,7 @@ doDrawing' win pdata u = do glDepthFunc GL_ALWAYS glBindTexture GL_TEXTURE_2D (pdata ^. fboBloom . _2 . unTO) glDisable GL_BLEND - drawFullShader (_bloomBlurShader pdata) 4 + drawShader (_bloomBlurShader pdata) 4 replicateM_ 9 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata) glEnable GL_BLEND setViewportSize (round winx `div` resFact) (round winy `div` resFact) @@ -260,11 +258,11 @@ doDrawing' win pdata u = do glUseProgram (pdata ^. cloudShader . shaderUINT) glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName glDrawElements - (pdata ^. cloudShader . shaderPrimitive) + (pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode) (fromIntegral nCloudIs) GL_UNSIGNED_SHORT nullPtr - drawFullShader (_windowShader pdata) nWins + drawShader (_windowShader pdata) nWins when (_graphics_cloud_shadows cfig) $ do ----render transparency depths glDepthMask GL_TRUE @@ -290,11 +288,11 @@ doDrawing' win pdata u = do glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName glDepthMask GL_TRUE glDrawElements - (pdata ^. cloudShader . shaderPrimitive) + (pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode) (fromIntegral nCloudIs) GL_UNSIGNED_SHORT nullPtr - drawFullShader (_windowShader pdata) nWins + drawShader (_windowShader pdata) nWins glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboPos . _1 . unFBO) withArray [0,0,0,0] $ \ptr -> glClearNamedFramebufferfv (pdata ^. fboPos . _1 . unFBO) @@ -355,7 +353,7 @@ doDrawing' win pdata u = do bindDrawDist (RadialDistortion (V2 a b) (V2 c d) (V2 e f) g) = do pokeArray (shadVBOptr $ _barrelShader pdata) [a, b, c, d, e, f, g] bufferPokedVBO (snd $ _barrelShader pdata) 1 - drawFullShader (fst $ _barrelShader pdata) 1 + drawShader (fst $ _barrelShader pdata) 1 fboList = take (length rds - 1) (concat (repeat [fst $ _fbo2 pdata, fst $ _fbo3 pdata])) ++ [FBO 0] diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index cba76a76b..4058e08c0 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -63,7 +63,8 @@ roomRect x y xn yn = { _tilePoly = rectNSWE y 0 0 x , _tileZero = V2 0 0 , _tileTangentPos = V2 baseFloorTileSize 0 - , _tileArrayZ = 5 + --, _tileArrayZ = 5 + , _tileArrayZ = 16 } ] , _rmRandPSs = [psRandRanges (10, x -10) (10, y -10) (0, 2 * pi)] diff --git a/src/Dodge/WorldEvent/Cloud.hs b/src/Dodge/WorldEvent/Cloud.hs index 5507d0545..0f5707386 100644 --- a/src/Dodge/WorldEvent/Cloud.hs +++ b/src/Dodge/WorldEvent/Cloud.hs @@ -60,10 +60,10 @@ makeThinSmokeAt = makeCloudAt (CloudColor 4 400 (withAlpha 0.05 black)) 5 400 50 makeStartCloudAt :: Point3 -> World -> World --makeStartCloudAt = makeCloudAt (CloudColor 2 800 white) 10 400 5 --makeStartCloudAt = makeCloudAt (CloudColor 2 200 white) 10 400 50 -makeStartCloudAt = makeCloudAt (CloudColor 2 200 white) 10 400 200 +makeStartCloudAt = makeCloudAt (CloudColor 2 200 white) 10 400 50 shellTrailCloud :: Int -> Float -> Point3 -> World -> World -shellTrailCloud age fadet = makeCloudAt (CloudColor (3/2) fadet (greyN 0.5)) 15 age 200 +shellTrailCloud age fadet = makeCloudAt (CloudColor (3/2) fadet (greyN 0.5)) 15 age 30 makeFlamerSmokeAt :: Point3 -> World -> World makeFlamerSmokeAt p w = makeCloudAt (CloudColor 4 300 (greyN x)) 6 200 40 p w diff --git a/src/Framebuffer/Check.hs b/src/Framebuffer/Check.hs index 65fac2c6e..4d3ec3655 100644 --- a/src/Framebuffer/Check.hs +++ b/src/Framebuffer/Check.hs @@ -1,6 +1,6 @@ module Framebuffer.Check where -import Data.Preload.Render +import Shader.Data import Graphics.GL.Core45 checkFBO :: FBO -> IO () diff --git a/src/Framebuffer/Setup.hs b/src/Framebuffer/Setup.hs index 7867de174..143882f21 100644 --- a/src/Framebuffer/Setup.hs +++ b/src/Framebuffer/Setup.hs @@ -7,9 +7,9 @@ module Framebuffer.Setup ( setupShadowFramebuffer, ) where +import Shader.Data import Framebuffer.Check import Unsafe.Coerce -import Data.Preload.Render import GLHelp import Graphics.GL.Core45 diff --git a/src/Framebuffer/Update.hs b/src/Framebuffer/Update.hs index 12cf9ffbe..3eee6d6dc 100644 --- a/src/Framebuffer/Update.hs +++ b/src/Framebuffer/Update.hs @@ -7,6 +7,7 @@ module Framebuffer.Update ( sizeFBOs, ) where +import Shader.Data import Framebuffer.Check import Control.Lens import Control.Monad diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index 4f2cb6c86..6ed869388 100644 --- a/src/Preload/Render.hs +++ b/src/Preload/Render.hs @@ -101,39 +101,39 @@ preloadRender = do -- shEdgeVAO is unecessary? -- lighting shaders lightingWallShadShad <- - makeShaderUsingVAO "lighting/wallShadow" [vert, geom, frag] EPoints wpVAO + makeShaderUsingVAO "lighting/wallShadow" [vert, geom, frag] pmPoints wpVAO lightingCapShad <- - makeShaderUsingVAO "lighting/cap" [vert, geom] ETriangles shPosVAO + makeShaderUsingVAO "lighting/cap" [vert, geom] pmTriangles shPosVAO lightingLineShadowShad <- - makeShaderUsingVAO "lighting/lineShadow" [vert, geom] ELinesAdjacency shEdgeVAO + makeShaderUsingVAO "lighting/lineShadow" [vert, geom] pmLinesAdjacency shEdgeVAO shadowedgeshader <- - makeShaderUsingVAO "shadow/edge" [vert, geom] ELinesAdjacency shEdgeVAO + makeShaderUsingVAO "shadow/edge" [vert, geom] pmLinesAdjacency shEdgeVAO shadowcapshader <- - makeShaderUsingVAO "shadow/cap" [vert, geom] ETriangles shPosVAO + makeShaderUsingVAO "shadow/cap" [vert, geom] pmTriangles shPosVAO shadowwallshader <- - makeShaderUsingVAO "shadow/wallShadow" [vert, geom] EPoints wpVAO + makeShaderUsingVAO "shadow/wallShadow" [vert, geom] pmPoints wpVAO shadowlightshader <- makeShaderSized "shadow/light" [vert, geom, frag] [1] 1 - EPoints - shadowcombineshader <- makeShaderSized "shadow/combine" [vert,geom,frag] [1] 1 EPoints + pmPoints + shadowcombineshader <- makeShaderSized "shadow/combine" [vert,geom,frag] [1] 1 pmPoints poke (shadVBOptr shadowlightshader) 1 -- positional shader - positionalBlankShad <- makeShader "positional/blank" [vert, frag] [3] ETriangles + positionalBlankShad <- makeShader "positional/blank" [vert, frag] [3] pmTriangles -- 2D draw shaders - bslist <- makeShader "dualTwoD/basic" [vert, frag] [3, 4] ETriangles - bslista <- makeShader4 "shape/basic" [vert, frag] shapeVerxSizes nShapeVerxComp ETriangles shVBO - glVertexArrayElementBuffer (bslista ^. shadVAO . vaoName) (shEBO' ^. eboName) - --glVertexArrayElementBuffer (bslista ^. shadVAO . vaoName) shEBOname - aslist <- makeShader "dualTwoD/arc" [vert, frag] [3, 4, 3] ETriangles - eslist <- makeShader "dualTwoD/ellipse" [vert, geom, frag] [3, 4] ETriangles - bezierQuadShader <- makeShader "dualTwoD/bezierQuad" [vert, frag] [3, 4, 4] ETriangleStrip + bslist <- makeShader "dualTwoD/basic" [vert, frag] [3, 4] pmTriangles + bslista <- makeShader4 "shape/basic" [vert, frag] shapeVerxSizes nShapeVerxComp pmTriangles shVBO + glVertexArrayElementBuffer (bslista ^. shaderVAO . vaoName) (shEBO' ^. eboName) + --glVertexArrayElementBuffer (bslista ^. shaderVAO . vaoName) shEBOname + aslist <- makeShader "dualTwoD/arc" [vert, frag] [3, 4, 3] pmTriangles + eslist <- makeShader "dualTwoD/ellipse" [vert, geom, frag] [3, 4] pmTriangles + bezierQuadShader <- makeShader "dualTwoD/bezierQuad" [vert, frag] [3, 4, 4] pmTriangleStrip cslist <- - makeShader "dualTwoD/character" [vert, frag] [3, 4, 2] ETriangles + makeShader "dualTwoD/character" [vert, frag] [3, 4, 2] pmTriangles >>= _1 (vaddTextureNoFilter "data/texture/charMap.png") -- this should really be a 2d texture array - basicTweakZShad <- makeShader "dualTwoD/basicTweakZ" [vert, frag] [4, 4] ETriangles + basicTweakZShad <- makeShader "dualTwoD/basicTweakZ" [vert, frag] [4, 4] pmTriangles -- texture shaders, no textures attached screentexturevbo <- mglCreate glCreateBuffers @@ -144,25 +144,25 @@ preloadRender = do ptr 0 screentexturevao <- setupVAOvbo' [2,2] 4 screentexturevbo - alphadivideshader <- makeShader4UsingVAO "texture2D/alphaDivide" [vert,frag] GL_TRIANGLE_STRIP screentexturevao - fsShad <- makeShader4UsingVAO "texture/simple" [vert, frag] GL_TRIANGLE_STRIP screentexturevao - bloomBlurShad <- makeShaderUsingVAO "texture/bloomBlur" [vert, frag] ETriangleStrip screentexturevao - colorBlurShad <- makeShaderUsingVAO "texture/colorBlur" [vert, frag] ETriangleStrip screentexturevao - grayscaleShad <- makeShaderUsingVAO "texture/grayscale" [vert, frag] ETriangleStrip screentexturevao + alphadivideshader <- makeShader4UsingVAO "texture2D/alphaDivide" [vert,frag] pmTriangleStrip screentexturevao + fsShad <- makeShader4UsingVAO "texture/simple" [vert, frag] pmTriangleStrip screentexturevao + bloomBlurShad <- makeShaderUsingVAO "texture/bloomBlur" [vert, frag] pmTriangleStrip screentexturevao + colorBlurShad <- makeShaderUsingVAO "texture/colorBlur" [vert, frag] pmTriangleStrip screentexturevao + grayscaleShad <- makeShaderUsingVAO "texture/grayscale" [vert, frag] pmTriangleStrip screentexturevao lightingTextureShad <- - makeShaderUsingVAO "lighting/texture" [vert, frag] ETriangleStrip screentexturevao - barrelShad <- makeShader "texture/barrel" [vert, geom, frag] [2, 2, 2, 1] EPoints + makeShaderUsingVAO "lighting/texture" [vert, frag] pmTriangleStrip screentexturevao + barrelShad <- makeShader "texture/barrel" [vert, geom, frag] [2, 2, 2, 1] pmPoints -- blank wallShader - wallBlankShad <- makeShaderUsingVAO "wall/blank" [vert, geom, frag] EPoints wpColVAO + wallBlankShad <- makeShaderUsingVAO "wall/blank" [vert, geom, frag] pmPoints wpColVAO -- textured wallShader wallTextureShad <- - makeShaderUsingVAO "wall/texture" [vert, geom, frag] EPoints wpColVAO + makeShaderUsingVAO "wall/texture" [vert, geom, frag] pmPoints wpColVAO let wallverxstrd = 8 wallvbo <- setupVBO wallverxstrd - wallshader <- makeShader4 "wall/basic" [vert,geom,frag] [4,4] wallverxstrd EPoints wallvbo + wallshader <- makeShader4 "wall/basic" [vert,geom,frag] [4,4] wallverxstrd pmPoints wallvbo let floorverxstrd = 8 floorvbo <- setupVBOStatic floorverxstrd - floorshader <- makeShader4 "floor/arrayPos" [vert, frag] [4,4] floorverxstrd ETriangles floorvbo + floorshader <- makeShader4 "floor/arrayPos" [vert, frag] [4,4] floorverxstrd pmTriangles floorvbo tonormalmap <- initTexture2DArray 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/normalArray.png" todiffusemap <- initTexture2DArray 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/diffuseArray.png" @@ -170,7 +170,7 @@ preloadRender = do cloudvbo <- setupVBO (sum cloudverxsizes) (cloudshader, cloudebo) <- makeShaderEBO "cloud/basic" [vert, frag] cloudverxsizes (sum cloudverxsizes) - GL_TRIANGLES cloudvbo + pmTriangles cloudvbo framebuf2 <- setupTextureFramebuffer 800 600 framebuf3 <- setupTextureFramebuffer 800 600 @@ -211,7 +211,7 @@ preloadRender = do return $ RenderData { _pictureShaders = shadV - , _shapeShader = bslista -- & shadVAO' .~ shPosColVAO + , _shapeShader = bslista -- & shaderVAO' .~ shPosColVAO , _shapeEBO = shEBO' , _silhouetteEBO = silEBO , _lightingCapShader = lightingCapShad @@ -225,7 +225,7 @@ preloadRender = do , _positionalBlankShader = positionalBlankShad , _wallBlankShader = wallBlankShad , _wallTextureShader = wallTextureShad - , _windowShader = wallBlankShad{_shadVAO = winColVAO} + , _windowShader = wallBlankShad{_shaderVAO = winColVAO} -- , _textureArrayShader = textArrayShad , _fullscreenShader = fsShad , _alphaDivideShader = alphadivideshader diff --git a/src/Preload/Update.hs b/src/Preload/Update.hs index 2d1be34b6..597ecca6d 100644 --- a/src/Preload/Update.hs +++ b/src/Preload/Update.hs @@ -51,6 +51,6 @@ renderDataResizeUpdate xsize ysize xfull yfull rdata = do makeByteStringShaderUsingVAO "bloomBlur" [(vert, bbVert), (frag, bbFrag')] - ETriangleStrip + pmTriangleStrip (rdata ^. screenTextureVAO) return (rdata'{_bloomBlurShader = bbShad}) diff --git a/src/Render.hs b/src/Render.hs index ca3363c8f..e93a864e5 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -22,7 +22,6 @@ import Graphics.GL.Core45 import Picture.Data import Shader import Shader.Data -import Shader.ExtraPrimitive {- | Determine where light is shining in the world. think of the produced texture as showing what RGB values should be "taken @@ -89,12 +88,12 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype glBindTextureUnit 0 (positiontexture ^. unTO) glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE glStencilFunc GL_EQUAL 0 255 - glUseProgram (ltextShad ^. shadName) + glUseProgram (ltextShad ^. shaderUINT) glUniform3f 0 x y z glUniform4f 1 r g b rad - glBindVertexArray $ ltextShad ^. shadVAO . vaoName + glBindVertexArray $ ltextShad ^. shaderVAO . vaoName glDrawArrays - (marshalEPrimitiveMode (_shadPrim' ltextShad)) + (_unPrimitiveMode (_shaderPrimitive ltextShad)) 0 (fromIntegral (4 :: Int)) --cleanup: may not be necessary, depending on what comes after... @@ -153,24 +152,24 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype glDisable GL_CULL_FACE glStencilFunc GL_ALWAYS 0 255 --draw wall shadows - glUseProgram (_shadName lwallShad) + glUseProgram (_shaderUINT lwallShad) glUniform3f 0 x y z glUniform1f 1 rad - glBindVertexArray $ lwallShad ^. shadVAO . vaoName -- Just (_vao $ _shadVAO lwallShad) + glBindVertexArray $ lwallShad ^. shaderVAO . vaoName -- Just (_vao $ _shadVAO lwallShad) glDrawArrays - (marshalEPrimitiveMode $ _shadPrim' lwallShad) + (_unPrimitiveMode $ _shaderPrimitive lwallShad) 0 (fromIntegral nWalls) case shadsdrawtype of GeoObjShads -> do --draw silhouette shadows glEnable GL_DEPTH_CLAMP - glUseProgram (_shadName llinesShad) + glUseProgram (_shaderUINT llinesShad) glUniform3f 0 x y z glUniform1f 1 rad - glBindVertexArray (_vaoName $ _shadVAO llinesShad) + glBindVertexArray (_vaoName $ _shaderVAO llinesShad) glDrawElements - (marshalEPrimitiveMode $ _shadPrim' llinesShad) + (_unPrimitiveMode $ _shaderPrimitive llinesShad) (fromIntegral nSils) GL_UNSIGNED_SHORT nullPtr @@ -178,11 +177,11 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype glEnable GL_CULL_FACE glCullFace GL_BACK glCullFace GL_FRONT - glUseProgram (_shadName lcapShad) + glUseProgram (_shaderUINT lcapShad) glUniform3f 0 x y z - glBindVertexArray $ lcapShad ^. shadVAO . vaoName --Just (_vao $ _shadVAO lcapShad) + glBindVertexArray $ lcapShad ^. shaderVAO . vaoName --Just (_vao $ _shadVAO lcapShad) glDrawElements - (marshalEPrimitiveMode $ _shadPrim' lcapShad) + (_unPrimitiveMode $ _shaderPrimitive lcapShad) (fromIntegral nCaps) GL_UNSIGNED_SHORT nullPtr @@ -196,12 +195,12 @@ createLightMap cfig pdata lightPoints nWalls nSils nCaps shadsdrawtype glBindTextureUnit 1 (normaltexture ^. unTO) glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE glStencilFunc GL_EQUAL 0 255 - glUseProgram (ltextShad ^. shadName) --Just (_shadProg ltextShad) + glUseProgram (ltextShad ^. shaderUINT) --Just (_shadProg ltextShad) glUniform3f 0 x y z glUniform4f 1 r g b rad - glBindVertexArray $ ltextShad ^. shadVAO . vaoName -- Just (_vao $ _shadVAO ltextShad) + glBindVertexArray $ ltextShad ^. shaderVAO . vaoName -- Just (_vao $ _shadVAO ltextShad) glDrawArrays - (marshalEPrimitiveMode (_shadPrim' ltextShad)) + (_unPrimitiveMode (_shaderPrimitive ltextShad)) 0 (fromIntegral (4 :: Int)) --cleanup: may not be necessary, depending on what comes after... @@ -274,17 +273,17 @@ instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos = do glDisable GL_CULL_FACE glStencilFunc GL_ALWAYS 0 255 --draw wall shadows - glUseProgram $ pdata ^. shadowWallShader . shadName - glBindVertexArray $ pdata ^. shadowWallShader . shadVAO . vaoName + glUseProgram $ pdata ^. shadowWallShader . shaderUINT + glBindVertexArray $ pdata ^. shadowWallShader . shaderVAO . vaoName glDrawArrays - (marshalEPrimitiveMode $ pdata ^. shadowWallShader . shadPrim') + (_unPrimitiveMode $ pdata ^. shadowWallShader . shaderPrimitive) 0 (fromIntegral nWalls) --draw silhouette shadows - glUseProgram $ pdata ^. shadowEdgeShader . shadName - glBindVertexArray $ pdata ^. shadowEdgeShader . shadVAO . vaoName + glUseProgram $ pdata ^. shadowEdgeShader . shaderUINT + glBindVertexArray $ pdata ^. shadowEdgeShader . shaderVAO . vaoName glDrawElements - (marshalEPrimitiveMode $ pdata ^. shadowEdgeShader . shadPrim') + (_unPrimitiveMode $ pdata ^. shadowEdgeShader . shaderPrimitive) (fromIntegral nSils) GL_UNSIGNED_SHORT nullPtr @@ -292,10 +291,10 @@ instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos = do glEnable GL_CULL_FACE glCullFace GL_BACK --glCullFace GL_FRONT - glUseProgram (_shadName lcapShad) - glBindVertexArray $ lcapShad ^. shadVAO . vaoName + glUseProgram (_shaderUINT lcapShad) + glBindVertexArray $ lcapShad ^. shaderVAO . vaoName glDrawElements - (marshalEPrimitiveMode $ _shadPrim' lcapShad) + (_unPrimitiveMode $ _shaderPrimitive lcapShad) (fromIntegral nCaps) GL_UNSIGNED_SHORT nullPtr @@ -303,12 +302,12 @@ instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos = do glDepthFunc GL_ALWAYS glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE glStencilFunc GL_EQUAL 0 255 - glUseProgram (pdata ^. shadowLightShader . _1 . shadName) + glUseProgram (pdata ^. shadowLightShader . _1 . shaderUINT) -- bind world position texture bindTO toPos --- glBindVertexArray $ pdata ^. shadowLightShader . shadVAO' . vaoName +-- glBindVertexArray $ pdata ^. shadowLightShader . shaderVAO' . vaoName glDrawArrays - (marshalEPrimitiveMode $ pdata ^. shadowLightShader . _1 . shadPrim') + (_unPrimitiveMode $ pdata ^. shadowLightShader . _1 . shaderPrimitive) 0 1 glDisable GL_CULL_FACE @@ -323,9 +322,9 @@ instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos = do glBindTexture GL_TEXTURE_2D_ARRAY (pdata ^. fboShadow . _2 . _1 . unTO) glEnable GL_BLEND glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR - glUseProgram (pdata ^. shadowCombineShader . _1 . shadName) + glUseProgram (pdata ^. shadowCombineShader . _1 . shaderUINT) glDrawArrays - (marshalEPrimitiveMode EPoints) + GL_POINTS 0 1 withArray [GL_COLOR_ATTACHMENT0, GL_DEPTH_STENCIL_ATTACHMENT] $ \ptr -> @@ -338,22 +337,22 @@ instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos = do pingPongBetween :: (FBO, TO) -> (FBO, TO) -> - FullShader -> + Shader -> IO () pingPongBetween (fb1, to1) (fb2, to2) fs = do --bindFramebuffer Framebuffer $= fb2 glBindFramebuffer GL_FRAMEBUFFER (_unFBO fb2) --textureBinding Texture2D $= Just to1 glBindTexture GL_TEXTURE_2D (_unTO to1) - drawFullShader fs 4 + drawShader fs 4 --bindFramebuffer Framebuffer $= fb1 glBindFramebuffer GL_FRAMEBUFFER (_unFBO fb1) --textureBinding Texture2D $= Just to2 glBindTexture GL_TEXTURE_2D (_unTO to2) - drawFullShader fs 4 + drawShader fs 4 renderFoldable :: - MV.MVector (PrimState IO) (FullShader,VBO) -> + MV.MVector (PrimState IO) (Shader,VBO) -> Picture -> IO () renderFoldable shadV struct = do @@ -364,7 +363,7 @@ renderFoldable shadV struct = do ------------------------------end renderFoldable renderLayer :: Layer -> - MV.MVector (PrimState IO) (FullShader,VBO) -> + MV.MVector (PrimState IO) (Shader,VBO) -> UMV.MVector (PrimState IO) Int -> IO () renderLayer layer shads counts = do diff --git a/src/Shader.hs b/src/Shader.hs index 6914634fa..5b8a6e1e1 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -1,87 +1,71 @@ -module Shader - ( freeShaderPointers' - , drawShaderLay - , shadVBOptr - , drawFullShader - , drawShader - , pokeBindFoldable - , pokeBindFoldableLayer - ) where -import Control.Lens -import Shader.Data -import Shader.Parameters -import Shader.ExtraPrimitive -import Shader.Poke -import Shader.Bind -import Picture.Data +module Shader ( + freeShaderPointers', + drawShaderLay, + shadVBOptr, + drawShader, + pokeBindFoldable, + pokeBindFoldableLayer, +) where -import qualified Data.Vector.Unboxed.Mutable as UMV -import qualified Data.Vector.Mutable as MV +import Control.Lens +import Control.Monad import Control.Monad.Primitive +--import qualified Data.Vector as V +import qualified Data.Vector.Mutable as MV +--import qualified Data.Vector.Unboxed as UV +import qualified Data.Vector.Unboxed.Mutable as UMV import Foreign import Graphics.GL.Core45 +import Picture.Data +import Shader.Bind +import Shader.Data +import Shader.Parameters +import Shader.Poke -drawShaderLay :: Int -> UMV.MVector (PrimState IO) Int -> Int -> (FullShader,VBO) -> IO () +drawShaderLay :: Int -> UMV.MVector (PrimState IO) Int -> Int -> (Shader, VBO) -> IO () {-# INLINE drawShaderLay #-} -drawShaderLay l countsVector shadIn fs = do +drawShaderLay l countsVector shadIn fs = do i <- UMV.read countsVector shadIn - glUseProgram (_shadName $ fst fs) - glBindVertexArray $ fs ^. _1 . shadVAO . vaoName - case _shadTex' $ fst fs of - Just ShaderTexture{_textureObject = txo} --, _textureTarget = tt} - -> glBindTextureUnit 0 txo - _ -> return () - glDrawArrays - (marshalEPrimitiveMode $ _shadPrim' $ fst fs) - (fromIntegral $ l*numSubElements) - (fromIntegral i) - -drawFullShader :: FullShader -> Int -> IO () -{-# INLINE drawFullShader #-} -drawFullShader fs i = do - glUseProgram (_shadName fs) - glBindVertexArray $ fs ^. shadVAO . vaoName - case _shadTex' fs of - Just ShaderTexture{_textureObject = txo - } - -> glBindTextureUnit 0 txo - _ -> return () - glDrawArrays - (marshalEPrimitiveMode $ _shadPrim' fs) - 0 + glUseProgram (_shaderUINT $ fst fs) + glBindVertexArray $ fs ^. _1 . shaderVAO . vaoName + zipWithM_ (\ti -> glBindTextureUnit ti . _unTO) [0 ..] (fs ^. _1 . shaderTextures) + glDrawArrays + (_unPrimitiveMode $ _shaderPrimitive $ fst fs) + (fromIntegral $ l * numSubElements) (fromIntegral i) drawShader :: Shader -> Int -> IO () {-# INLINE drawShader #-} -drawShader fs i = do +drawShader fs i = do glUseProgram (_shaderUINT fs) glBindVertexArray $ fs ^. shaderVAO . vaoName - glDrawArrays - (_shaderPrimitive fs) - 0 + zipWithM_ (\ti -> glBindTextureUnit ti . _unTO) [0..] (fs ^. shaderTextures) + glDrawArrays + (_unPrimitiveMode $ _shaderPrimitive fs) + 0 (fromIntegral i) -freeShaderPointers' :: (FullShader,VBO) -> IO () +freeShaderPointers' :: (Shader, VBO) -> IO () freeShaderPointers' = free . _vboPtr . snd -pokeBindFoldable - :: MV.MVector (PrimState IO) (FullShader,VBO) - -> UMV.MVector (PrimState IO) Int - -> Picture - -> IO () +pokeBindFoldable :: + MV.MVector (PrimState IO) (Shader, VBO) -> + UMV.MVector (PrimState IO) Int -> + Picture -> + IO () pokeBindFoldable shadV counts m = do pokeVerxs shadV counts m bufferShaderVector shadV counts -pokeBindFoldableLayer - :: MV.MVector (PrimState IO) (FullShader,VBO) - -> UMV.MVector (PrimState IO) Int - -> Picture - -> IO () +pokeBindFoldableLayer :: + MV.MVector (PrimState IO) (Shader, VBO) -> + UMV.MVector (PrimState IO) Int -> + Picture -> + IO () pokeBindFoldableLayer shadV counts m = do pokeLayVerxs shadV counts m bindShaderLayers shadV counts -shadVBOptr :: (FullShader,VBO) -> Ptr Float +shadVBOptr :: (Shader, VBO) -> Ptr Float {-# INLINE shadVBOptr #-} shadVBOptr = _vboPtr . snd diff --git a/src/Shader/AuxAddition.hs b/src/Shader/AuxAddition.hs index ca81f0109..9f7f2ba37 100644 --- a/src/Shader/AuxAddition.hs +++ b/src/Shader/AuxAddition.hs @@ -4,24 +4,23 @@ module Shader.AuxAddition , addTextureArray , initTexture2D , initTexture2DArray - , tilesToLine -- ^ kept in case it is needed in the future + , tilesToLine ) where -import Data.Preload.Render +import LensHelp import Unsafe.Coerce import Shader.Data import Data.List.Extra import Codec.Picture import qualified Data.Vector.Storable as VS -import Control.Lens import Graphics.GL.Core45 import GLHelp -- I am not sure if this assumes that the shader is constructed directly before -- the texture is added... -addSamplerTexture2D :: String -> FullShader -> IO FullShader +addSamplerTexture2D :: String -> Shader -> IO Shader addSamplerTexture2D = addTexture2D 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR -vaddTextureNoFilter :: String -> FullShader -> IO FullShader +vaddTextureNoFilter :: String -> Shader -> IO Shader vaddTextureNoFilter = addTexture2D 1 GL_NEAREST GL_NEAREST addTexture2D @@ -29,7 +28,7 @@ addTexture2D -> GLenum -- minfilter -> GLenum -- magfilter -> String -- path to image - -> FullShader -> IO FullShader + -> Shader -> IO Shader addTexture2D nlev minfilt magfilt texpath shad = do Right cmap <- readImage texpath let texdata = convertRGBA8 cmap @@ -42,8 +41,7 @@ addTexture2D nlev minfilt magfilt texpath shad = do glGenerateTextureMipmap texname glTextureParameteri texname GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt) glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt) - return $ shad & shadTex' ?~ ShaderTexture - {_textureObject = texname } + return $ shad & shaderTextures .:~ TO texname -- alloca $ \nameptr -> do -- glCreateTextures GL_TEXTURE_2D 1 nameptr -- texname <- peek nameptr @@ -113,7 +111,7 @@ initTexture2DArray nlev minfilt magfilt fp = do -- | for transforming a 256x256 image containing 64 tiles of 16x16 pixels into -- an image that was directly readable by glTexSubImage3D, used the -- transformation tilesToLine 8 128 on the underlying pixels. -addTextureArray :: String -> (FullShader,VBO) -> IO (FullShader,VBO) +addTextureArray :: String -> (Shader,VBO) -> IO (Shader,VBO) addTextureArray texturePath (shad,vbo) = do err <- glGetError print err @@ -126,11 +124,9 @@ addTextureArray texturePath (shad,vbo) = do glGenerateTextureMipmap texname glTextureParameteri texname GL_TEXTURE_MIN_FILTER (unsafeCoerce GL_LINEAR_MIPMAP_LINEAR) glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce GL_LINEAR) - return (shad & shadTex' ?~ ShaderTexture - { _textureObject = texname} + return (shad & shaderTextures .:~ TO texname , vbo) --- I am completely unclear on why this works with its current parameters tilesToLine :: Int -- ^ Parameter a -> Int -- ^ Parameter b diff --git a/src/Shader/Bind.hs b/src/Shader/Bind.hs index 82742dfd9..404125df8 100644 --- a/src/Shader/Bind.hs +++ b/src/Shader/Bind.hs @@ -24,7 +24,7 @@ bufferPokedVBO theVBO numVs = (fromIntegral $ floatSize * numVs * _vboVertexSize theVBO) (_vboPtr theVBO) -bindShaderLayers :: MV.MVector (PrimState IO) (FullShader, VBO) -> UMV.MVector (PrimState IO) Int -> IO () +bindShaderLayers :: MV.MVector (PrimState IO) (Shader, VBO) -> UMV.MVector (PrimState IO) Int -> IO () bindShaderLayers shads counts = MV.imapM_ f shads where f i shad = do @@ -43,7 +43,7 @@ bindShaderLayers shads counts = MV.imapM_ f shads glNamedBufferSubDataH :: GLuint -> GLintptr -> GLsizeiptr -> Ptr a -> IO () glNamedBufferSubDataH = glNamedBufferSubData -bufferShaderVector :: MV.MVector (PrimState IO) (FullShader, VBO) -> UMV.MVector (PrimState IO) Int -> IO () +bufferShaderVector :: MV.MVector (PrimState IO) (Shader, VBO) -> UMV.MVector (PrimState IO) Int -> IO () bufferShaderVector shads counts = MV.imapM_ f shads where f i shad = UMV.read counts i >>= bufferPokedVBO (snd shad) diff --git a/src/Shader/Compile.hs b/src/Shader/Compile.hs index 95753e845..852f57b07 100644 --- a/src/Shader/Compile.hs +++ b/src/Shader/Compile.hs @@ -38,16 +38,16 @@ makeShader :: [GLenum] -> -- | The input vertex sizes [Int] -> - EPrimitiveMode -> - IO (FullShader,VBO) + PrimitiveMode -> + IO (Shader,VBO) makeShader s shaderlist sizes pm = do prog <- makeSourcedShader s shaderlist (vao,vbo) <- setupVAO sizes - return ( FullShader - { _shadName = prog - , _shadVAO = vao - , _shadPrim' = pm - , _shadTex' = Nothing + return ( Shader + { _shaderUINT = prog + , _shaderVAO = vao + , _shaderPrimitive = pm + , _shaderTextures = mempty } , vbo) @@ -60,7 +60,7 @@ makeShaderEBO :: [Int] -> -- | The stride Int -> - GLenum -> + PrimitiveMode -> VBO -> IO (Shader, EBO) makeShaderEBO s shaderlist sizes strd pm vbo = do @@ -68,7 +68,7 @@ makeShaderEBO s shaderlist sizes strd pm vbo = do vao <- setupVAOvbo sizes strd vbo ebo <- setupEBO vao return - ( Shader prog pm vao + ( Shader prog pm vao [] , ebo ) @@ -81,17 +81,17 @@ makeShader4 :: [Int] -> -- | The stride Int -> - EPrimitiveMode -> + PrimitiveMode -> VBO -> - IO FullShader + IO Shader makeShader4 s shaderlist sizes strd pm vbo = do prog <- makeSourcedShader s shaderlist vao <- setupVAOvbo sizes strd vbo - return $ FullShader - { _shadName = prog - , _shadVAO = vao - , _shadPrim' = pm - , _shadTex' = Nothing + return $ Shader + { _shaderUINT = prog + , _shaderVAO = vao + , _shaderPrimitive = pm + , _shaderTextures = mempty } makeShader4UsingVAO :: @@ -99,7 +99,7 @@ makeShader4UsingVAO :: String -> -- | shader types [GLenum] -> - GLenum -> + PrimitiveMode -> VAO -> IO Shader makeShader4UsingVAO s shaderlist pm vao = do @@ -108,6 +108,7 @@ makeShader4UsingVAO s shaderlist pm vao = do { _shaderUINT = prog , _shaderVAO = vao , _shaderPrimitive = pm + , _shaderTextures = [] } setupVBO :: Int -> IO VBO @@ -137,17 +138,17 @@ makeByteStringShaderUsingVAO :: String -> -- | Filetype extensions and shader data [(GLenum, BS.ByteString)] -> - EPrimitiveMode -> + PrimitiveMode -> VAO -> - IO FullShader + IO Shader makeByteStringShaderUsingVAO s shaderlist pm vao = do prog <- makeShaderProgram s shaderlist return $ - FullShader - { _shadName = prog - , _shadVAO = vao - , _shadPrim' = pm - , _shadTex' = Nothing + Shader + { _shaderUINT = prog + , _shaderVAO = vao + , _shaderPrimitive = pm + , _shaderTextures = mempty } -- | Takes the VAO from elsewhere @@ -156,17 +157,17 @@ makeShaderUsingVAO :: String -> -- | shader types [GLenum] -> - EPrimitiveMode -> + PrimitiveMode -> VAO -> - IO FullShader + IO Shader makeShaderUsingVAO s shaderlist pm theVAO = do prog <- makeSourcedShader s shaderlist return $ - FullShader - { _shadName = prog - , _shadVAO = theVAO - , _shadPrim' = pm - , _shadTex' = Nothing + Shader + { _shaderUINT = prog + , _shaderVAO = theVAO + , _shaderPrimitive = pm + , _shaderTextures = mempty } {- | @@ -182,16 +183,16 @@ makeShaderSized :: [Int] -> -- | Number of vertexes that can be poked Int -> - EPrimitiveMode -> - IO (FullShader,VBO) + PrimitiveMode -> + IO (Shader,VBO) makeShaderSized s shaderlist sizes ndraw pm = do prog <- makeSourcedShader s shaderlist (vao,vbo) <- setupVAOSized ndraw sizes - return ( FullShader - { _shadName = prog - , _shadVAO = vao - , _shadPrim' = pm - , _shadTex' = Nothing + return ( Shader + { _shaderUINT = prog + , _shaderVAO = vao + , _shaderPrimitive = pm + , _shaderTextures = mempty } , vbo) diff --git a/src/Shader/Data.hs b/src/Shader/Data.hs index 99b02b446..029468a07 100644 --- a/src/Shader/Data.hs +++ b/src/Shader/Data.hs @@ -1,98 +1,118 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StrictData #-} -{- | Datatypes used to setup and pass data to shaders. -} -module Shader.Data - ( VAO (..) - , VBO (..) - , EBO (..) - , Shader (..) - , FullShader (..) - , ShaderTexture (..) - , EPrimitiveMode (..) --- | Lens functions - , vaoName - , shaderUINT - , shaderPrimitive - , shaderVAO +{-# LANGUAGE TemplateHaskell #-} - , textureObject +-- | Datatypes used to setup and pass data to shaders. +module Shader.Data ( + VAO (..), + VBO (..), + EBO (..), + TO (..), + FBO (..), + Shader (..), + PrimitiveMode (..), + -- | Lens functions + vaoName, + shaderUINT, + shaderPrimitive, + shaderVAO, + shaderTextures, + textureObject, + vboName, + vboPtr, + vboVertexSize, + unFBO, + unTO, + unPrimitiveMode, + eboName, + eboPtr, + -- | Synonyms + vert, + geom, + frag, + pmPoints, + pmLines, + pmLinesAdjacency, + pmLineLoop, + pmLineStrip, + pmTriangles, + pmTriangleStrip, + pmTriangleFan, + pmQuads, + pmPatches, +) where - , vboName - , vboPtr - , vboVertexSize - - , eboName - , eboPtr - - , shadName - , shadVAO - , shadPrim' - , shadTex' --- | Synonyms - , vert - , geom - , frag - ) where -import Graphics.GL.Core45 -import Foreign import Control.Lens -{- | Datatype containing the necessary information for a single shader. -} -data FullShader = FullShader - { _shadName :: GLuint -- should be shaderID - , _shadVAO :: VAO - , _shadPrim' :: EPrimitiveMode - , _shadTex' :: Maybe ShaderTexture - } +import Foreign +import Graphics.GL.Core45 + +-- | Datatype containing the necessary information for a single shader. data Shader = Shader { _shaderUINT :: GLuint -- should be shaderID - , _shaderPrimitive :: GLenum + , _shaderPrimitive :: PrimitiveMode , _shaderVAO :: VAO + , _shaderTextures :: [TO] } + +newtype FBO = FBO {_unFBO :: GLuint} + +newtype TO = TO {_unTO :: GLuint} + {- | Vertex array object: contains the reference to the object, -and its buffer targets. -} +and its buffer targets. +-} newtype VAO = VAO - { _vaoName :: GLuint + { _vaoName :: GLuint } + {- | Vertex buffer object: contains the reference to the object, a pointer to a location with space that can be written to the buffer, and a list of attribute pointer sizes. -Vertex attributes are interleaved within the vbo. -} +Vertex attributes are interleaved within the vbo. +-} data VBO = VBO - { _vboName :: GLuint - , _vboPtr :: Ptr Float - , _vboVertexSize :: Int + { _vboName :: GLuint + , _vboPtr :: Ptr Float + , _vboVertexSize :: Int -- add int for AMOUNT of data poked! } + data EBO = EBO - { _eboName :: GLuint - , _eboPtr :: Ptr GLushort + { _eboName :: GLuint + , _eboPtr :: Ptr GLushort } -{- | Datatype containing the reference to a texture object. -} + +-- | Datatype containing the reference to a texture object. newtype ShaderTexture = ShaderTexture - { _textureObject :: GLuint -- DSA style texture, 450 --- , _textureTarget :: GLenum + { _textureObject :: GLuint -- DSA style texture, 450 + -- , _textureTarget :: GLenum } -data EPrimitiveMode - = EPoints - | ELines - | ELinesAdjacency - | ELineLoop - | ELineStrip - | ETriangles - | ETriangleStrip - | ETriangleFan - | EQuads - | EQuadStrip - | EPolygon - | EPatches + +newtype PrimitiveMode = PrimitiveMode {_unPrimitiveMode :: GLenum} + -- | Short synonyms for shader types vert, geom, frag :: GLenum vert = GL_VERTEX_SHADER geom = GL_GEOMETRY_SHADER frag = GL_FRAGMENT_SHADER + +pmPoints, pmLines, pmLinesAdjacency, pmLineLoop, pmLineStrip, pmTriangles, pmTriangleStrip, pmTriangleFan, pmQuads, pmPatches :: PrimitiveMode +pmPoints = PrimitiveMode GL_POINTS +pmLines = PrimitiveMode GL_LINES +pmLinesAdjacency = PrimitiveMode GL_LINES_ADJACENCY +pmLineLoop = PrimitiveMode GL_LINE_LOOP +pmLineStrip = PrimitiveMode GL_LINE_STRIP +pmTriangles = PrimitiveMode GL_TRIANGLES +pmTriangleStrip = PrimitiveMode GL_TRIANGLE_STRIP +pmTriangleFan = PrimitiveMode GL_TRIANGLE_FAN +pmQuads = PrimitiveMode GL_QUADS +pmPatches = PrimitiveMode GL_PATCHES + makeLenses ''VAO makeLenses ''VBO -makeLenses ''FullShader makeLenses ''EBO makeLenses ''ShaderTexture makeLenses ''Shader +makeLenses ''FBO +makeLenses ''TO +makeLenses ''PrimitiveMode diff --git a/src/Shader/ExtraPrimitive.hs b/src/Shader/ExtraPrimitive.hs deleted file mode 100644 index 261a3df2c..000000000 --- a/src/Shader/ExtraPrimitive.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Shader.ExtraPrimitive - where -import Shader.Data - -import Graphics.GL.Types -import Graphics.GL.Tokens - -marshalEPrimitiveMode :: EPrimitiveMode -> GLenum -{-# INLINABLE marshalEPrimitiveMode #-} -marshalEPrimitiveMode x = case x of - EPoints -> GL_POINTS - ELines -> GL_LINES - ELinesAdjacency -> GL_LINES_ADJACENCY - ELineLoop -> GL_LINE_LOOP - ELineStrip -> GL_LINE_STRIP - ETriangles -> GL_TRIANGLES - ETriangleStrip -> GL_TRIANGLE_STRIP - ETriangleFan -> GL_TRIANGLE_FAN - EQuads -> GL_QUADS - EQuadStrip -> GL_QUAD_STRIP - EPolygon -> GL_POLYGON - EPatches -> GL_PATCHES diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index de227a845..3838106ea 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -27,13 +27,13 @@ import Shader.Parameters import Shape.Data pokeVerxs :: - MV.MVector (PrimState IO) (FullShader, VBO) -> + MV.MVector (PrimState IO) (Shader, VBO) -> UMV.MVector (PrimState IO) Int -> Picture -> IO () pokeVerxs vbos count = VFSM.mapM_ (pokeVerx vbos count) . VFSM.fromList -pokeVerx :: MV.MVector (PrimState IO) (FullShader, VBO) -> UMV.MVector (PrimState IO) Int -> Verx -> IO () +pokeVerx :: MV.MVector (PrimState IO) (Shader, VBO) -> UMV.MVector (PrimState IO) Int -> Verx -> IO () pokeVerx vbos offsets Verx{_vxPos = thePos, _vxCol = theCol, _vxExt = ext, _vxShadNum = theShadNum} = do typeOff <- UMV.unsafeRead offsets sn basePtr <- _vboPtr . snd <$> MV.unsafeRead vbos sn @@ -400,13 +400,13 @@ pokeFlatV norm col ptr nv sh = do V3 nx ny nz = sh - norm pokeLayVerxs :: - MV.MVector (PrimState IO) (FullShader, VBO) -> + MV.MVector (PrimState IO) (Shader, VBO) -> UMV.MVector (PrimState IO) Int -> Picture -> IO () pokeLayVerxs vbos counts = VFSM.mapM_ (pokeLayVerx vbos counts) . VFSM.fromList -pokeLayVerx :: MV.MVector (PrimState IO) (FullShader, VBO) -> UMV.MVector (PrimState IO) Int -> Verx -> IO () +pokeLayVerx :: MV.MVector (PrimState IO) (Shader, VBO) -> UMV.MVector (PrimState IO) Int -> Verx -> IO () {-# INLINE pokeLayVerx #-} pokeLayVerx vbos counts vx = do theOff <- UMV.unsafeRead counts vecPos