diff --git a/src/Data/Preload/Render.hs b/src/Data/Preload/Render.hs index 39da1d0e7..86beb997b 100644 --- a/src/Data/Preload/Render.hs +++ b/src/Data/Preload/Render.hs @@ -31,8 +31,9 @@ data RenderData = RenderData , _pictureShaders :: MV.MVector (PrimState IO) FullShader , _fbo2 :: (FramebufferObject, TextureObject) , _fbo3 :: (FramebufferObject, TextureObject) - , _fboFourth1 :: (FramebufferObject, TextureObject) - , _fboFourth2 :: (FramebufferObject, TextureObject) + , _fboHalf1 :: (FramebufferObject, TextureObject) + , _fboHalf2 :: (FramebufferObject, TextureObject) + , _fboHalf3 :: (FramebufferObject, TextureObject) , _fboBase :: (FramebufferObject, (TextureObject, TextureObject)) , _fboCloud :: (FramebufferObject, (TextureObject, TextureObject)) , _fboBloom :: (FramebufferObject, TextureObject) diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index c97c8341e..e8397a64f 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -26,6 +26,7 @@ import Dodge.Creature.SpreadGunCrit import Dodge.Creature.AutoCrit import Dodge.Creature.ChaseCrit import Dodge.Creature.ArmourChase +import Dodge.Creature.Silhouette import Dodge.Data import Dodge.Default import Dodge.Item.Weapon @@ -146,6 +147,7 @@ startCr = defaultCreature , _crMvDir = pi/2 , _crID = 0 , _crPict = basicCrPict black + , _crSilhouette = basicCrSilhouette , _crUpdate = stateUpdate yourControl , _crRad = 10 , _crMass = 10 diff --git a/src/Dodge/Creature/ShadowBox.hs b/src/Dodge/Creature/ShadowBox.hs index b88f5799c..d0e6d2558 100644 --- a/src/Dodge/Creature/ShadowBox.hs +++ b/src/Dodge/Creature/ShadowBox.hs @@ -6,9 +6,9 @@ import Geometry import qualified Data.IntMap as IM crToBox :: Creature -> [[Point3]] -crToBox cr = map (map f . polyToTris) $ boxXYZ 10 10 15 +crToBox cr = map (map f . polyToTris) $ boxXYZ 8 8 15 where - f = (+ V3 (x-5) (y-5) 1) + f = (+ V3 (x-4) (y-4) 1) V2 x y = _crPos cr youBox' :: World -> [[Point3]] youBox' w = crToBox' $ _creatures w IM.! 0 @@ -17,9 +17,9 @@ youBox :: World -> [Point3] youBox = concat . youBox' crToBox' :: Creature -> [[Point3]] -crToBox' cr = map (map f . polyToTris) $ boxXYZ 20 20 15 +crToBox' cr = map (map f . polyToTris) $ boxXYZ 12 12 15 where - f = (+ V3 (x-10) (y-10) 1) + f = (+ V3 (x-6) (y-6) 0) V2 x y = _crPos cr youSil :: World -> [Point3] diff --git a/src/Dodge/Creature/Silhouette.hs b/src/Dodge/Creature/Silhouette.hs new file mode 100644 index 000000000..c2101fe2c --- /dev/null +++ b/src/Dodge/Creature/Silhouette.hs @@ -0,0 +1,26 @@ +module Dodge.Creature.Silhouette + ( creatureSilhouettes + , basicCrSilhouette + ) + where +import Dodge.Data +import Polyhedra +import Geometry + +import qualified Data.IntMap as IM + +creatureSilhouettes :: World -> [Point3] +creatureSilhouettes w = concatMap f . IM.elems $ _creatures w + where + f cr = _crSilhouette cr cr + +crBox :: [Point3] +crBox = constructEdgesList . map (map f . polyToTris) $ boxXYZ 12 12 15 + where + f = (+ V3 (-6) (-6) 0) + +basicCrSilhouette :: Creature -> [Point3] +basicCrSilhouette cr = map theTrans crBox + where + theTrans = (+ V3 x y 0) + V2 x y = _crPos cr diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 09e909189..21f617acb 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -161,6 +161,7 @@ data Creature = Creature , _crMvDir :: Float , _crID :: Int , _crPict :: Creature -> World -> Picture + , _crSilhouette :: Creature -> [Point3] , _crUpdate :: Creature -> World diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 2c92573ba..b7e9deeb4 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -31,6 +31,7 @@ defaultCreature = Creature , _crMvDir = 0 , _crID = 1 , _crPict = \_ _ -> setLayer 0 $ onLayer CrLayer $ circleSolid 10 + , _crSilhouette = const [] , _crUpdate = \cr _ -> (Endo id , Just cr) , _crRad = 10 , _crMass = 10 diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index fd761596d..a7d7e5b15 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -8,7 +8,8 @@ import Dodge.Data import Dodge.Config.Data import Dodge.Base.Window import Dodge.Render.Picture ---import Dodge.Creature.ShadowBox +import Dodge.Creature.ShadowBox +import Dodge.Creature.Silhouette import Geometry import Render import Data.Preload.Render @@ -55,7 +56,8 @@ doDrawing pdata w = do nWalls <- poke224s (shadVBOptr $ _wallTextureShader pdata) wallPointsCol nSils <- pokePoint3s (shadVBOptr $ _lightingLineShadowShader pdata) $ - --youSil w ++ + --youSil w ++ + creatureSilhouettes w ++ _foregroundEdgeVerx w -- poke foreground geometry for caps nCaps <- pokePoint3s (shadVBOptr $ _lightingCapShader pdata) @@ -75,9 +77,8 @@ doDrawing pdata w = do clear [ColorBuffer,DepthBuffer] depthFunc $= Just Less -- draw wall occlusions from the camera's point of view - currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata) - uniform (head $ _shaderCustomUnis $ _lightingOccludeShader pdata) - $= viewFrom3d + currentProgram $= Just (_shadProg $ _lightingOccludeShader pdata) + uniform (head $ _shadUnis $ _lightingOccludeShader pdata) $= viewFrom3d drawShader (_lightingOccludeShader pdata) nWalls --draw walls onto base buffer if w ^. config . wall_textured @@ -118,12 +119,12 @@ doDrawing pdata w = do --setup downscale viewport for blurring bloom viewport $= (Position 0 0 , divideSize (2 * (w ^. config . shadow_resolution)) $ Size (round $ fstV2 wins) (round $ sndV2 wins)) - bindFramebuffer Framebuffer $= fst (_fboFourth1 pdata) + bindFramebuffer Framebuffer $= fst (_fboHalf1 pdata) depthFunc $= Just Always textureBinding Texture2D $= Just (snd $ _fboBloom pdata) blend $= Disabled drawShader (_bloomBlurShader pdata) 4 - replicateM_ 5 $ pingPongBetween (_fboFourth1 pdata) (_fboFourth2 pdata) (_bloomBlurShader pdata) + replicateM_ 5 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata) blend $= Enabled viewport $= (Position 0 0 , divideSize (w ^. config . shadow_resolution) $ Size (round $ fstV2 wins) (round $ sndV2 wins)) @@ -144,11 +145,21 @@ doDrawing pdata w = do drawBuffers $= [NoBuffers,FBOColorAttachment 1] renderLayer 2 shadV layerCounts renderWindows pdata windowPoints + -- --downscale transparency depths + -- viewport $= (Position 0 0 + -- , divideSize (2 * (w ^. config . shadow_resolution)) $ Size (round $ fstV2 wins) (round $ sndV2 wins)) + -- bindFramebuffer Framebuffer $= fst (_fboHalf3 pdata) + -- bindTO (snd $ snd $ _fboCloud pdata) + -- depthFunc $= Just Always + -- drawShader (_fullscreenShader pdata) 4 + -- viewport $= (Position 0 0 + -- , divideSize (w ^. config . shadow_resolution) $ Size (round $ fstV2 wins) (round $ sndV2 wins)) + ----draw lightmap for cloud buffer depthMask $= Disabled blend $= Enabled - ----draw lightmap for cloud buffer bindFramebuffer Framebuffer $= fst (_fboLighting pdata) createLightMap pdata lightPoints nWalls nSils nCaps (snd $ snd $ _fboCloud pdata) + -- createLightMap pdata lightPoints nWalls nSils nCaps (snd $ _fboHalf3 pdata) colorMask $= Color4 Enabled Enabled Enabled Enabled clearColor $= Color4 0 0 0 0 --apply lightmap to cloud buffer @@ -167,7 +178,7 @@ doDrawing pdata w = do bindFramebuffer Framebuffer $= fst (_fboBase pdata) blend $= Enabled blendFunc $= (SrcAlpha, One) - textureBinding Texture2D $= Just (snd $ _fboFourth1 pdata) + textureBinding Texture2D $= Just (snd $ _fboHalf1 pdata) drawShader (_fullscreenShader pdata) 4 blendFunc $= (SrcAlpha, OneMinusSrcAlpha) --draw shadowed clouds onto base buffer @@ -233,7 +244,7 @@ renderWindows renderWindows pdata wps = do n <- poke224s (shadVBOptr $ _windowShader pdata) wps bindShaderBuffers [_windowShader pdata] [n] - currentProgram $= Just (_shaderProgram $ _windowShader pdata) + currentProgram $= Just (_shadProg $ _windowShader pdata) --cullFace $= Just Back drawShader (_windowShader pdata) n --cullFace $= Nothing @@ -246,3 +257,4 @@ renderTextureWalls pdata nWalls = do cullFace $= Just Back drawShader (_wallTextureShader pdata) nWalls cullFace $= Nothing + diff --git a/src/Framebuffer/Update.hs b/src/Framebuffer/Update.hs index 5ce759faf..0b25afbd8 100644 --- a/src/Framebuffer/Update.hs +++ b/src/Framebuffer/Update.hs @@ -31,7 +31,7 @@ sizeFBOs xsize ysize xfull yfull rdata = do rdata''' <- foldM (updateFBOTO xfull yfull minMagFilter GL_RGBA8) rdata'' [fbo2, fbo3] foldM (updateFBOTO (xsize `div` 2) (ysize `div` 2) linMinMagFilter GL_RGBA16F) rdata''' - [fboFourth1,fboFourth2] + [fboHalf1,fboHalf2,fboHalf3] resizeRBO :: RenderbufferObject diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index f914ad10b..e7e20aed8 100644 --- a/src/Preload/Render.hs +++ b/src/Preload/Render.hs @@ -129,8 +129,9 @@ preloadRender = do fboLightingName <- setupFramebufferGivenStencil rboBaseBloomName fboLightingHighName <- setupFramebufferGivenStencil rboBaseBloomName - fboFourth1Name <- setupTextureFramebuffer 300 300 - fboFourth2Name <- setupTextureFramebuffer 300 300 + fboHalf1Name <- setupTextureFramebuffer 300 300 + fboHalf2Name <- setupTextureFramebuffer 300 300 + fboHalf3Name <- setupTextureFramebuffer 300 300 -- reset to default framebuffer, ready for drawing direct to screen bindFramebuffer Framebuffer $= defaultFramebufferObject @@ -150,26 +151,24 @@ preloadRender = do return $ RenderData { _pictureShaders = shadV - --, _lightingSurfaceShader = lightingSurfaceShad , _lightingCapShader = lightingCapShad , _lightingLineShadowShader = lightingLineShadowShad - , _lightingOccludeShader = wsShad {_shaderVAO = wpVAO} - --, _lightingWallShader = wlLightShad {_shaderVAO = wpVAO} - , _wallBlankShader = wlBlank { _shaderVAO = wpColVAO } - , _wallTextureShader = wlTexture { _shaderVAO = wpColVAO } - , _windowShader = wlBlank { _shaderVAO = winColVAO } + , _lightingOccludeShader = wsShad {_shadVAO = wpVAO} + , _wallBlankShader = wlBlank { _shadVAO = wpColVAO } + , _wallTextureShader = wlTexture { _shadVAO = wpColVAO } + , _windowShader = wlBlank { _shadVAO = winColVAO } , _textureArrayShader = textArrayShad , _fullscreenShader = fsShad - , _fullLightingShader = fullLightingShad - --, _fullscreenAlphaHalveShader = fullscreenAlphaHalveShad - , _bloomBlurShader = bloomBlurShad - , _colorBlurShader = colorBlurShad + , _fullLightingShader = fullLightingShad + , _bloomBlurShader = bloomBlurShad + , _colorBlurShader = colorBlurShad , _barrelShader = barrelShad , _grayscaleShader = grayscaleShad , _fbo2 = framebuf2 , _fbo3 = framebuf3 - , _fboFourth1 = fboFourth1Name - , _fboFourth2 = fboFourth2Name + , _fboHalf1 = fboHalf1Name + , _fboHalf2 = fboHalf2Name + , _fboHalf3 = fboHalf3Name , _fboLighting = fboLightingName , _fboLightingHigh = fboLightingHighName --, _rboLighting = rboLightingName diff --git a/src/Render.hs b/src/Render.hs index fc3c61c49..58c068e70 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -61,19 +61,19 @@ createLightMap pdata lightPoints nWalls nSils nCaps toPos = do stencilOpSeparate Back $= (OpKeep,OpKeep,OpDecrWrap) stencilFunc $= (Always, 0, 255) --draw wall shadows - currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata) - uniform (head $ _shaderCustomUnis $ _lightingOccludeShader pdata) + currentProgram $= Just (_shadProg $ _lightingOccludeShader pdata) + uniform (head $ _shadUnis $ _lightingOccludeShader pdata) $= Vector3 x y z drawShader (_lightingOccludeShader pdata) nWalls --draw silhouette shadows - currentProgram $= Just (_shaderProgram $ _lightingLineShadowShader pdata) - uniform (head $ _shaderCustomUnis $ _lightingLineShadowShader pdata) + currentProgram $= Just (_shadProg $ _lightingLineShadowShader pdata) + uniform (head $ _shadUnis $ _lightingLineShadowShader pdata) $= Vector3 x y z drawShader (_lightingLineShadowShader pdata) nSils cullFace $= Just Back --draw caps on the near plane as required - currentProgram $= Just (_shaderProgram $ _lightingCapShader pdata) - uniform (head $ _shaderCustomUnis $ _lightingCapShader pdata) + currentProgram $= Just (_shadProg $ _lightingCapShader pdata) + uniform (head $ _shadUnis $ _lightingCapShader pdata) $= Vector3 x y z drawShader (_lightingCapShader pdata) nCaps --draw lightmap itself @@ -83,10 +83,10 @@ createLightMap pdata lightPoints nWalls nSils nCaps toPos = do colorMask $= Color4 Enabled Enabled Enabled Enabled stencilOp $= (OpKeep,OpKeep,OpKeep) stencilFunc $= (Equal, 0, 255) - currentProgram $= Just (_shaderProgram $ _fullLightingShader pdata) - uniform (head $ _shaderCustomUnis $ _fullLightingShader pdata) + currentProgram $= Just (_shadProg $ _fullLightingShader pdata) + uniform (head $ _shadUnis $ _fullLightingShader pdata) $= Vector3 x y z - uniform (_shaderCustomUnis (_fullLightingShader pdata) !! 1) + uniform (_shadUnis (_fullLightingShader pdata) !! 1) $= Vector4 r g b rad drawShader (_fullLightingShader pdata) 4 --cleanup: may not be necessary, depending on what comes after... diff --git a/src/Shader.hs b/src/Shader.hs index 32f443d65..0b8adc591 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -24,27 +24,33 @@ drawShaderLay :: Int -> UMV.MVector (PrimState IO) Int -> Int -> FullShader -> I {-# INLINE drawShaderLay #-} drawShaderLay l countsVector shadIn fs = do i <- UMV.read countsVector shadIn - currentProgram $= Just (_shaderProgram fs) - bindVertexArrayObject $= Just (_vao $ _shaderVAO fs) - case _shaderTexture fs of + currentProgram $= Just (_shadProg fs) + bindVertexArrayObject $= Just (_vao $ _shadVAO fs) + case _shadTex fs of Just ShaderTexture{_textureObject = txo} -> textureBinding Texture2D $= Just txo _ -> return () - glDrawArrays (marshalEPrimitiveMode $ _shaderDrawPrimitive fs) (fromIntegral $ l*numSubElements) (fromIntegral i) + glDrawArrays + (marshalEPrimitiveMode $ _shadPrim fs) + (fromIntegral $ l*numSubElements) + (fromIntegral i) drawShader :: FullShader -> Int -> IO () {-# INLINE drawShader #-} drawShader fs i = do - currentProgram $= Just (_shaderProgram fs) - bindVertexArrayObject $= Just (_vao $ _shaderVAO fs) - case _shaderTexture fs of + currentProgram $= Just (_shadProg fs) + bindVertexArrayObject $= Just (_vao $ _shadVAO fs) + case _shadTex fs of Just ShaderTexture{_textureObject = txo} -> textureBinding Texture2D $= Just txo _ -> return () - glDrawArrays (marshalEPrimitiveMode $ _shaderDrawPrimitive fs) 0 (fromIntegral i) + glDrawArrays + (marshalEPrimitiveMode $ _shadPrim fs) + 0 + (fromIntegral i) freeShaderPointers :: FullShader -> IO () -freeShaderPointers fs = free $ _vboPtr $ _vaoVBO $ _shaderVAO fs +freeShaderPointers fs = free $ _vboPtr $ _vaoVBO $ _shadVAO fs pokeBindFoldable :: MV.MVector (PrimState IO) FullShader @@ -66,4 +72,4 @@ pokeBindFoldableLayer shadV counts m = do shadVBOptr :: FullShader -> Ptr Float {-# INLINE shadVBOptr #-} -shadVBOptr = _vboPtr . _vaoVBO . _shaderVAO +shadVBOptr = _vboPtr . _vaoVBO . _shadVAO diff --git a/src/Shader/AuxAddition.hs b/src/Shader/AuxAddition.hs index 451a19d11..467f4fc11 100644 --- a/src/Shader/AuxAddition.hs +++ b/src/Shader/AuxAddition.hs @@ -33,7 +33,7 @@ addTexture texturePath shad = do glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear') generateMipmap' Texture2D - return $ shad & shaderTexture ?~ ShaderTexture {_textureObject = textureOb} + return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb} vaddTextureNoFilter :: String -> FullShader -> IO FullShader vaddTextureNoFilter texturePath shad = do @@ -48,7 +48,7 @@ vaddTextureNoFilter texturePath shad = do --withArray texData $ \ptr -> do V.unsafeWith (imageData tex) $ \ptr -> do glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr - return $ shad & shaderTexture ?~ ShaderTexture {_textureObject = textureOb} + return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb} addTextureNoFilter :: String -> FullShader -> IO FullShader addTextureNoFilter texturePath shad = do @@ -62,7 +62,7 @@ addTextureNoFilter texturePath shad = do glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex V.unsafeWith (imageData tex) $ \ptr -> do glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr - return $ shad & shaderTexture ?~ ShaderTexture {_textureObject = textureOb} + return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb} -- | for transforming a 256x256 image containing 64 tiles of 16x16 pixels into -- an image that was directly readable by glTexSubImage3D, used the @@ -84,7 +84,7 @@ addTextureArray texturePath shad = do glTexSubImage3D GL_TEXTURE_2D_ARRAY 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear') generateMipmap' Texture2DArray - return $ shad & shaderTexture ?~ ShaderTexture {_textureObject = textureOb} + return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb} -- I am completely unclear on why this works with its current parameters tilesToLine @@ -96,5 +96,5 @@ tilesToLine n w = concat . concat . transpose . chunksOf n . chunksOf w addUniforms :: [String] -> FullShader -> IO FullShader addUniforms uniStrings shad = do - uniLocs <- mapM (uniformLocation $ _shaderProgram shad) uniStrings - return $ shad & shaderCustomUnis %~ (++ uniLocs) + uniLocs <- mapM (uniformLocation $ _shadProg shad) uniStrings + return $ shad & shadUnis %~ (++ uniLocs) diff --git a/src/Shader/Bind.hs b/src/Shader/Bind.hs index acf430d49..403cf9dd4 100644 --- a/src/Shader/Bind.hs +++ b/src/Shader/Bind.hs @@ -29,7 +29,7 @@ bindShaderLayers :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimSta bindShaderLayers shads counts = MV.imapM_ f shads where f i shad = do - let theVBO = _vaoVBO $ _shaderVAO shad + let theVBO = _vaoVBO $ _shadVAO shad stride = sum $ _vboAttribSizes theVBO bindBuffer ArrayBuffer $= (Just . _vbo $ theVBO) VS.mapM_ (g stride theVBO) $ VS.enumFromStepN 0 1 6 -- [0..5] @@ -46,9 +46,9 @@ bindShaderLayers shads counts = MV.imapM_ f shads bindShader :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> IO () bindShader shads counts = MV.imapM_ f shads where - f i shad = UMV.read counts i >>= flip bindArrayBuffers (_vaoVBO . _shaderVAO $ shad) + f i shad = UMV.read counts i >>= flip bindArrayBuffers (_vaoVBO . _shadVAO $ shad) bindShaderBuffers :: [FullShader] -> [Int] -> IO () bindShaderBuffers = zipWithM_ f where - f fs i = bindArrayBuffers i $ _vaoVBO $ _shaderVAO fs + f fs i = bindArrayBuffers i $ _vaoVBO $ _shadVAO fs diff --git a/src/Shader/Compile.hs b/src/Shader/Compile.hs index 78740e422..12ae6a30d 100644 --- a/src/Shader/Compile.hs +++ b/src/Shader/Compile.hs @@ -30,11 +30,11 @@ makeShader s shaderlist sizes pm = do prog <- makeSourcedShader s shaderlist vaob <- setupVAO sizes return $ FullShader - { _shaderProgram = prog - , _shaderVAO = vaob - , _shaderDrawPrimitive = pm - , _shaderTexture = Nothing - , _shaderCustomUnis = [] + { _shadProg = prog + , _shadVAO = vaob + , _shadPrim = pm + , _shadTex = Nothing + , _shadUnis = [] } makeByteStringShader :: String -- ^ (Arbitrary) name of the shader @@ -46,11 +46,11 @@ makeByteStringShader s shaderlist sizes pm = do prog <- makeShaderProgram s shaderlist vaob <- setupVAO sizes return $ FullShader - { _shaderProgram = prog - , _shaderVAO = vaob - , _shaderDrawPrimitive = pm - , _shaderTexture = Nothing - , _shaderCustomUnis = [] + { _shadProg = prog + , _shadVAO = vaob + , _shadPrim = pm + , _shadTex = Nothing + , _shadUnis = [] } makeByteStringShaderUsingVAO :: String -- ^ (Arbitrary) name of the shader @@ -61,10 +61,10 @@ makeByteStringShaderUsingVAO makeByteStringShaderUsingVAO s shaderlist pm fs = do prog <- makeShaderProgram s shaderlist return $ fs - { _shaderProgram = prog - , _shaderDrawPrimitive = pm - , _shaderTexture = Nothing - , _shaderCustomUnis = [] + { _shadProg = prog + , _shadPrim = pm + , _shadTex = Nothing + , _shadUnis = [] } -- | Takes the VAO from another shader @@ -77,10 +77,10 @@ makeShaderUsingShaderVAO makeShaderUsingShaderVAO s shaderlist pm fs = do prog <- makeSourcedShader s shaderlist return $ fs - { _shaderProgram = prog - , _shaderDrawPrimitive = pm - , _shaderTexture = Nothing - , _shaderCustomUnis = [] + { _shadProg = prog + , _shadPrim = pm + , _shadTex = Nothing + , _shadUnis = [] } {- | Compiles a full shader found within the shader directory. @@ -97,11 +97,11 @@ makeShaderSized s shaderlist sizes ndraw pm = do prog <- makeSourcedShader s shaderlist vaob <- setupVAOSized sizes ndraw return $ FullShader - { _shaderProgram = prog - , _shaderVAO = vaob - , _shaderDrawPrimitive = pm - , _shaderTexture = Nothing - , _shaderCustomUnis = [] + { _shadProg = prog + , _shadVAO = vaob + , _shadPrim = pm + , _shadTex = Nothing + , _shadUnis = [] } -- | Compile shader and get its uniform locations. diff --git a/src/Shader/Data.hs b/src/Shader/Data.hs index 709c89288..e8ae70219 100644 --- a/src/Shader/Data.hs +++ b/src/Shader/Data.hs @@ -10,11 +10,11 @@ module Shader.Data -- | Lens functions , vao , vaoVBO - , shaderProgram - , shaderVAO - , shaderDrawPrimitive - , shaderTexture - , shaderCustomUnis + , shadProg + , shadVAO + , shadPrim + , shadTex + , shadUnis , vbo , vboPtr , vboAttribSizes @@ -29,11 +29,11 @@ import Foreign import Control.Lens {- | Datatype containing the necessary information for a single shader. -} data FullShader = FullShader - { _shaderProgram :: Program - , _shaderVAO :: VAO - , _shaderDrawPrimitive :: EPrimitiveMode - , _shaderTexture :: Maybe ShaderTexture - , _shaderCustomUnis :: [UniformLocation] + { _shadProg :: Program + , _shadVAO :: VAO + , _shadPrim :: EPrimitiveMode + , _shadTex :: Maybe ShaderTexture + , _shadUnis :: [UniformLocation] } {- | Vertex array object: contains the reference to the object, and its buffer targets. -} diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index 8e46315ec..dda68c132 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -29,7 +29,7 @@ pokeVerxs vbos count vxs = VS.mapM_ (pokeVerx vbos count) $ VS.fromList vxs pokeVerx :: MV.MVector (PrimState IO) FullShader -> 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 . _vaoVBO . _shaderVAO <$> MV.read vbos sn + basePtr <- _vboPtr . _vaoVBO . _shadVAO <$> MV.read vbos sn let thePtr = plusPtr basePtr (typeOff * pokeStride sn * floatSize) poke34 thePtr thePos theCol pokeArrayOff thePtr 7 ext @@ -48,7 +48,7 @@ pokeLayVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO --{-# INLINE pokeLayVerx #-} pokeLayVerx vbos counts vx = do theOff <- UMV.unsafeRead counts vecPos - basePtr <- _vboPtr . _vaoVBO . _shaderVAO <$> MV.unsafeRead vbos sn + basePtr <- _vboPtr . _vaoVBO . _shadVAO <$> MV.unsafeRead vbos sn let thePtr = plusPtr basePtr ((theOff + layOff) * theStride * floatSize) poke34 thePtr thePos theCol pokeArrayOff thePtr 7 (_vxExt vx)