Refactor shader types

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

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]

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)]

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