Remove Maybe from custom unis

This commit is contained in:
2021-06-10 16:54:21 +02:00
parent 0b76062475
commit 79d2c73dcf
4 changed files with 18 additions and 26 deletions
+2 -3
View File
@@ -26,7 +26,6 @@ import Control.Lens
import Control.Monad import Control.Monad
import qualified Control.Foldl as F import qualified Control.Foldl as F
import Data.Tuple.Extra import Data.Tuple.Extra
import Data.Maybe
--import Data.List --import Data.List
--import Data.Bifunctor --import Data.Bifunctor
--import Data.Function --import Data.Function
@@ -139,7 +138,7 @@ renderBlankWalls pdata wps pmat = do
n <- F.foldM (pokeShader $ _wallBlankShader pdata) wps n <- F.foldM (pokeShader $ _wallBlankShader pdata) wps
bindShaderBuffers [_wallBlankShader pdata] [n] bindShaderBuffers [_wallBlankShader pdata] [n]
currentProgram $= Just (_shaderProgram $ _wallBlankShader pdata) currentProgram $= Just (_shaderProgram $ _wallBlankShader pdata)
uniform (head (fromJust $ _shaderCustomUnis $ _wallBlankShader pdata) ) uniform (head ( _shaderCustomUnis $ _wallBlankShader pdata) )
$= pmat $= pmat
cullFace $= Just Back cullFace $= Just Back
drawShader (_wallBlankShader pdata) n drawShader (_wallBlankShader pdata) n
@@ -154,7 +153,7 @@ renderTextureWalls pdata wps pmat = do
n <- F.foldM (pokeShader $ _wallTextureShader pdata) wps n <- F.foldM (pokeShader $ _wallTextureShader pdata) wps
bindShaderBuffers [_wallTextureShader pdata] [n] bindShaderBuffers [_wallTextureShader pdata] [n]
currentProgram $= Just (_shaderProgram $ _wallTextureShader pdata) currentProgram $= Just (_shaderProgram $ _wallTextureShader pdata)
uniform (head (fromJust $ _shaderCustomUnis $ _wallTextureShader pdata) ) uniform (head ( _shaderCustomUnis $ _wallTextureShader pdata) )
$= pmat $= pmat
cullFace $= Just Back cullFace $= Just Back
drawShader (_wallTextureShader pdata) n drawShader (_wallTextureShader pdata) n
+10 -11
View File
@@ -22,7 +22,6 @@ import Foreign hiding (rotate)
import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygon,Color,T) import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygon,Color,T)
--import Data.Foldable --import Data.Foldable
import Data.Tuple.Extra import Data.Tuple.Extra
import Data.Maybe (fromJust)
--import qualified Data.IntMap.Strict as IM --import qualified Data.IntMap.Strict as IM
import qualified SDL import qualified SDL
@@ -39,11 +38,11 @@ setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat = do
bindShaderBuffers [_lightingOccludeShader pdata] [nWalls] bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]
currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata) currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
uniform (head $ fromJust $ _shaderCustomUnis $ _lightingOccludeShader pdata) uniform (head $ _shaderCustomUnis $ _lightingOccludeShader pdata)
$= Vector2 viewFromx viewFromy $= Vector2 viewFromx viewFromy
uniform ( fromJust (_shaderCustomUnis $ _lightingOccludeShader pdata) !! 1) uniform ( (_shaderCustomUnis $ _lightingOccludeShader pdata) !! 1)
$= pmat $= pmat
uniform ( fromJust (_shaderCustomUnis $ _lightingOccludeShader pdata) !! 2) uniform ( (_shaderCustomUnis $ _lightingOccludeShader pdata) !! 2)
$= (0 :: Float) $= (0 :: Float)
-- cullFace $= Just Front -- cullFace $= Just Front
drawShader (_lightingOccludeShader pdata) nWalls drawShader (_lightingOccludeShader pdata) nWalls
@@ -82,7 +81,7 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat _
bindShaderBuffers [_lightingOccludeShader pdata] [nWalls] bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]
-- set uniforms for shader that draws lights -- set uniforms for shader that draws lights
currentProgram $= Just (_shaderProgram $ _lightingWallShader pdata) currentProgram $= Just (_shaderProgram $ _lightingWallShader pdata)
uniform ( fromJust (_shaderCustomUnis $ _lightingWallShader pdata) !! 1) uniform ( (_shaderCustomUnis $ _lightingWallShader pdata) !! 1)
$= pmat $= pmat
-- clear buffer to full alpha and furthest depth -- clear buffer to full alpha and furthest depth
clearColor $= Color4 0 0 0 1 clearColor $= Color4 0 0 0 1
@@ -92,11 +91,11 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat _
-- draw walls from your point of view in order to set z buffer -- draw walls from your point of view in order to set z buffer
colorMask $= Color4 Disabled Disabled Disabled Disabled colorMask $= Color4 Disabled Disabled Disabled Disabled
currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata) currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
uniform (head $ fromJust $ _shaderCustomUnis $ _lightingOccludeShader pdata) uniform (head $ _shaderCustomUnis $ _lightingOccludeShader pdata)
$= Vector2 viewFromx viewFromy $= Vector2 viewFromx viewFromy
uniform ( fromJust (_shaderCustomUnis $ _lightingOccludeShader pdata) !! 1) uniform ( (_shaderCustomUnis $ _lightingOccludeShader pdata) !! 1)
$= pmat $= pmat
uniform ( fromJust (_shaderCustomUnis $ _lightingOccludeShader pdata) !! 2) uniform ( (_shaderCustomUnis $ _lightingOccludeShader pdata) !! 2)
$= (0 :: Float) $= (0 :: Float)
cullFace $= Just Back cullFace $= Just Back
drawShader (_lightingOccludeShader pdata) nWalls drawShader (_lightingOccludeShader pdata) nWalls
@@ -127,7 +126,7 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat _
stencilOp $= (OpKeep,OpKeep,OpIncr) stencilOp $= (OpKeep,OpKeep,OpIncr)
stencilFunc $= (Always, 0, 255) stencilFunc $= (Always, 0, 255)
currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata) currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
uniform (head $ fromJust $ _shaderCustomUnis $ _lightingOccludeShader pdata) uniform (head $ _shaderCustomUnis $ _lightingOccludeShader pdata)
$= Vector2 x y $= Vector2 x y
drawShader (_lightingOccludeShader pdata) nWalls drawShader (_lightingOccludeShader pdata) nWalls
cullFace $= Just Front cullFace $= Just Front
@@ -141,9 +140,9 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat _
drawShader (_lightingFloorShader pdata) 1 drawShader (_lightingFloorShader pdata) 1
-- draw wall light "circles" -- draw wall light "circles"
currentProgram $= Just (_shaderProgram $ _lightingWallShader pdata) currentProgram $= Just (_shaderProgram $ _lightingWallShader pdata)
uniform (head $ fromJust $ _shaderCustomUnis $ _lightingWallShader pdata) uniform (head $ _shaderCustomUnis $ _lightingWallShader pdata)
$= Vector2 x y $= Vector2 x y
uniform (fromJust (_shaderCustomUnis $ _lightingWallShader pdata) !! 2) uniform ((_shaderCustomUnis $ _lightingWallShader pdata) !! 2)
$= Vector2 r lum $= Vector2 r lum
drawShader (_lightingWallShader pdata) nWallLights drawShader (_lightingWallShader pdata) nWallLights
cullFace $= Nothing cullFace $= Nothing
+2 -3
View File
@@ -26,7 +26,6 @@ import MatrixHelper
import Foreign import Foreign
import Codec.Picture import Codec.Picture
import Data.Maybe (fromMaybe)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.Vector.Storable as V import qualified Data.Vector.Storable as V
import Control.Monad (unless, forM, zipWithM_, forM_, foldM) import Control.Monad (unless, forM, zipWithM_, forM_, foldM)
@@ -130,7 +129,7 @@ makeShader s shaderlist alocs pm renStrat = do
, _shaderPokeStrategy = renStrat , _shaderPokeStrategy = renStrat
, _shaderDrawPrimitive = pm , _shaderDrawPrimitive = pm
, _shaderTexture = Nothing , _shaderTexture = Nothing
, _shaderCustomUnis = Nothing , _shaderCustomUnis = []
} }
floatSize :: Int floatSize :: Int
floatSize = sizeOf (0.5 :: GLfloat) floatSize = sizeOf (0.5 :: GLfloat)
@@ -184,7 +183,7 @@ makeSourcedShader s sts = do
addUniforms :: [String] -> FullShader a -> IO (FullShader a) addUniforms :: [String] -> FullShader a -> IO (FullShader a)
addUniforms uniStrings shad = do addUniforms uniStrings shad = do
uniLocs <- mapM (uniformLocation $ _shaderProgram shad) uniStrings uniLocs <- mapM (uniformLocation $ _shaderProgram shad) uniStrings
return $ shad & shaderCustomUnis %~ Just . (++ uniLocs) . fromMaybe [] return $ shad & shaderCustomUnis %~ (++ uniLocs)
shaderTypeExt :: ShaderType -> String shaderTypeExt :: ShaderType -> String
+4 -9
View File
@@ -24,15 +24,12 @@ import Graphics.Rendering.OpenGL
import Foreign import Foreign
import Control.Lens import Control.Lens
{- | Vertex array object: contains the reference to the object, {- | Vertex array object: contains the reference to the object,
and its buffer targets. and its buffer targets. -}
-}
data VAO = VAO data VAO = VAO
{ _vao :: VertexArrayObject { _vao :: VertexArrayObject
, _vaoBufferTargets :: [(BufferObject,Ptr Float,Int)] , _vaoBufferTargets :: [(BufferObject,Ptr Float,Int)]
} }
{- | {- | Datatype containing the necessary information for a single shader. -}
Datatype containing the necessary information for a single shader.
-}
data FullShader a = FullShader data FullShader a = FullShader
{ _shaderProgram :: Program { _shaderProgram :: Program
, _shaderUniforms :: [UniformLocation] , _shaderUniforms :: [UniformLocation]
@@ -40,11 +37,9 @@ data FullShader a = FullShader
, _shaderPokeStrategy :: a -> [[[Float]]]-- -> F.FoldM IO RenderType Int , _shaderPokeStrategy :: a -> [[[Float]]]-- -> F.FoldM IO RenderType Int
, _shaderDrawPrimitive :: PrimitiveMode , _shaderDrawPrimitive :: PrimitiveMode
, _shaderTexture :: Maybe ShaderTexture , _shaderTexture :: Maybe ShaderTexture
, _shaderCustomUnis :: Maybe [UniformLocation] , _shaderCustomUnis :: [UniformLocation]
} }
{- | {- | Datatype containing the reference to a texture object. -}
Datatype containing the reference to a texture object.
-}
newtype ShaderTexture = ShaderTexture newtype ShaderTexture = ShaderTexture
{ _textureObject :: TextureObject } { _textureObject :: TextureObject }