Implement (not fully working) alternate shadow volumes

src/Shader/AuxAddition.hs

@@ -8,9 +8,10 @@ module Shader.AuxAddition
     ) where
 import Shader.Data
 
+import qualified Data.Vector as V
 import Data.List.Extra
 import Codec.Picture
-import qualified Data.Vector.Storable as V
+import qualified Data.Vector.Storable as VS
 import Control.Lens
 import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
 import Graphics.GL.Core43
@@ -26,7 +27,7 @@ addTexture texturePath shad = do
     let wtex = fromIntegral $ imageWidth  tex
         htex = fromIntegral $ imageHeight tex
     glTexStorage2D GL_TEXTURE_2D 3 GL_RGBA8 wtex htex
-    V.unsafeWith (imageData tex) $ \ptr -> do
+    VS.unsafeWith (imageData tex) $ \ptr -> do
         glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr
     textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear')
     generateMipmap' Texture2D
@@ -42,7 +43,7 @@ vaddTextureNoFilter texturePath shad = do
     let wtex = fromIntegral $ imageWidth  tex
         htex = fromIntegral $ imageHeight tex
     glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex
-    V.unsafeWith (imageData tex) $ \ptr -> do
+    VS.unsafeWith (imageData tex) $ \ptr -> do
         glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr
     return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb}
 
@@ -56,7 +57,7 @@ addTextureNoFilter texturePath shad = do
     let wtex = fromIntegral $ imageWidth  tex
         htex = fromIntegral $ imageHeight tex
     glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex
-    V.unsafeWith (imageData tex) $ \ptr -> do
+    VS.unsafeWith (imageData tex) $ \ptr -> do
         glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr
     return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb}
 
@@ -75,7 +76,7 @@ addTextureArray texturePath shad = do
     glTexStorage3D GL_TEXTURE_2D_ARRAY 3 GL_RGBA8 32 32 64
     --writePng "atest.png" ((Image 256 256 (V.fromList texData)) :: Image PixelRGBA8)
     --withArray texData $ \ptr -> do
-    V.unsafeWith (imageData tex) $ \ptr -> do
+    VS.unsafeWith (imageData tex) $ \ptr -> do
         --glTexSubImage3D GL_TEXTURE_2D_ARRAY 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr
         glTexSubImage3D GL_TEXTURE_2D_ARRAY 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr
     textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear')
@@ -93,4 +94,4 @@ tilesToLine n w = concat . concat . transpose . chunksOf n . chunksOf w
 addUniforms :: [String] -> FullShader -> IO FullShader
 addUniforms uniStrings shad = do
     uniLocs <- mapM (uniformLocation $ _shadProg shad) uniStrings
-    return $ shad & shadUnis %~ (++ uniLocs)
+    return $ shad & shadUnis %~ (V.++ V.fromList uniLocs)

src/Shader/Compile.hs

@@ -35,7 +35,7 @@ makeShader s shaderlist sizes pm = do
         , _shadVAO  = vaob
         , _shadPrim = pm
         , _shadTex  = Nothing
-        , _shadUnis = []
+        , _shadUnis = mempty
         }
 makeByteStringShader
     :: String       -- ^ (Arbitrary) name of the shader
@@ -51,7 +51,7 @@ makeByteStringShader s shaderlist sizes pm = do
         , _shadVAO  = vaob
         , _shadPrim = pm
         , _shadTex  = Nothing
-        , _shadUnis = []
+        , _shadUnis = mempty
         }
 makeByteStringShaderUsingVAO
     :: String       -- ^ (Arbitrary) name of the shader
@@ -65,7 +65,7 @@ makeByteStringShaderUsingVAO s shaderlist pm fs = do
         { _shadProg = prog
         , _shadPrim = pm
         , _shadTex  = Nothing
-        , _shadUnis = []
+        , _shadUnis = mempty
         }
 
 -- | Takes the VAO from elsewhere
@@ -82,7 +82,7 @@ makeShaderUsingVAO s shaderlist pm theVAO = do
         , _shadVAO = theVAO
         , _shadPrim = pm
         , _shadTex  = Nothing
-        , _shadUnis = []
+        , _shadUnis = mempty
         }
 
 -- | Takes the VAO from another shader
@@ -98,7 +98,7 @@ makeShaderUsingShaderVAO s shaderlist pm fs = do
         { _shadProg = prog
         , _shadPrim = pm
         , _shadTex  = Nothing
-        , _shadUnis = []
+        , _shadUnis = mempty
         }
 {- | 
 Compiles a full shader found within the shader directory.
@@ -119,7 +119,7 @@ makeShaderSized s shaderlist sizes ndraw pm = do
         , _shadVAO  = vaob
         , _shadPrim = pm
         , _shadTex  = Nothing
-        , _shadUnis = []
+        , _shadUnis = mempty
         }
 
 -- | Compile shader and get its uniform locations.

src/Shader/Data.hs

@@ -27,6 +27,7 @@ module Shader.Data
     , geom
     , frag
     ) where
+import Data.Vector (Vector)
 import Graphics.Rendering.OpenGL
 import Foreign
 import Control.Lens
@@ -36,7 +37,7 @@ data FullShader = FullShader
     , _shadVAO  :: VAO
     , _shadPrim :: EPrimitiveMode
     , _shadTex  :: Maybe ShaderTexture
-    , _shadUnis :: [UniformLocation]
+    , _shadUnis :: Vector UniformLocation
     }
 {- | Vertex array object: contains the reference to the object,
 and its buffer targets.  -}

src/Shader/Poke.hs

@@ -4,6 +4,7 @@ module Shader.Poke
     , pokeArrayOff
     , pokeShape
     , pokeWallsWindowsFloor
+    , memoTopPrismEdgeIndices
     ) where
 import Shader.Data
 import Shader.Parameters