Add normal maps to the floor

src/Data/Preload/Render.hs

@@ -56,6 +56,7 @@ data RenderData = RenderData
     , _vboWalls :: VBO
     , _vboWindows :: VBO
     , _vboShapes :: VBO
+    , _toNormalMaps :: TO
     }
 
 makeLenses ''RenderData

src/Dodge/Render.hs

@@ -160,7 +160,16 @@ doDrawing' win pdata u = do
         nullPtr
 --    glDisable GL_CULL_FACE
     --draw floor onto base buffer
-    drawShader (fst $ _textureArrayShader pdata) nFls
+    glDisable GL_BLEND
+    glUseProgram (pdata ^. textureArrayShader . _1 . shadName)
+    glBindVertexArray $ pdata ^. textureArrayShader . _1 . shadVAO . vaoName
+    glBindTextureUnit 1 (pdata ^. toNormalMaps . unTO)
+    glBindTextureUnit 0 $ pdata ^?! textureArrayShader . _1 . shadTex' . _Just . textureObject
+    glDrawArrays 
+        (marshalEPrimitiveMode $ pdata ^. textureArrayShader . _1 . shadPrim' ) 
+        0 
+        (fromIntegral nFls)
+    glEnable GL_BLEND
     --draw lightmap into its own buffer
     createLightMap
         cfig

src/Preload/Render.hs

@@ -5,6 +5,7 @@ module Preload.Render (
     cleanUpRenderPreload,
 ) where
 
+import Shader.AuxAddition
 import Shape.Data
 import Geometry.Data
 import MatrixHelper
@@ -16,7 +17,6 @@ import qualified Data.Vector.Mutable as MV
 import Foreign
 import Framebuffer.Setup
 import Shader
-import Shader.AuxAddition
 import Shader.Bind
 import Shader.Compile
 import Shader.Data
@@ -145,9 +145,6 @@ preloadRender = do
             >>= _1 (vaddTextureNoFilter "data/texture/charMap.png")
     -- this should really be a 2d texture array
     basicTweakZShad <- makeShader "dualTwoD/basicTweakZ" [vert, frag] [4, 4] ETriangles
-    -- fullscreen shaders
-    --fullscreenAlphaHalveShad <- makeShaderSized "fullscreen/alphaHalve" [vert,frag] [2] 4 ETriangleStrip
-    --pokeArray (shadVBOptr fullscreenAlphaHalveShad) $ concat cornerListNoCoord
     -- texture shaders, no textures attached
     fsShad <- makeShaderSized "texture/simple" [vert, frag] [2, 2] 4 ETriangleStrip
     -- note we directly poke the shader vertex data here
@@ -212,6 +209,8 @@ preloadRender = do
         , eslist
         ]
     initializeGLState
+
+    tonormalmap <- initTexture 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/verticalRidge.png"
     return $
         RenderData
             { _pictureShaders = shadV
@@ -255,6 +254,7 @@ preloadRender = do
             , _vboWalls = wpVBO
             , _vboWindows = winVBO
             , _vboShapes = shVBO
+            , _toNormalMaps = tonormalmap
             }
 
 --------------------end preloadRender

src/Shader/AuxAddition.hs

@@ -3,8 +3,10 @@ module Shader.AuxAddition
     , vaddTextureNoFilter
     , addTextureArray
     , addUniforms
+    , initTexture
     , tilesToLine -- ^ kept in case it is needed in the future
     ) where
+import Data.Preload.Render
 import Unsafe.Coerce
 import Shader.Data
 import Control.Monad
@@ -57,7 +59,24 @@ addTexture2D nlev minfilt magfilt texpath shad = do
 --            glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
 --            return $ shad & shadTex' ?~ ShaderTexture 
 --                {_textureObject = texname }
-
+initTexture
+    :: GLint -- number of mipmap levels
+    -> GLenum -- minfilter
+    -> GLenum -- magfilter
+    -> String -> IO TO
+initTexture nlev minfilt magfilt fp = do
+    Right cmap <- readImage fp
+    let texdata = convertRGBA8 cmap
+    let wtex = fromIntegral $ imageWidth  texdata
+        htex = fromIntegral $ imageHeight texdata
+    texname <- mglCreate $ glCreateTextures GL_TEXTURE_2D
+    glTextureStorage2D texname nlev GL_RGBA8 wtex htex
+    VS.unsafeWith (imageData texdata) $ \ptr -> do
+        glTextureSubImage2D texname 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr
+        glGenerateTextureMipmap texname
+        glTextureParameteri texname GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt)
+        glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
+        return $ TO texname
 
 -- | for transforming a 256x256 image containing 64 tiles of 16x16 pixels into
 -- an image that was directly readable by glTexSubImage3D, used the

src/Shader/Data.hs

@@ -15,6 +15,8 @@ module Shader.Data
 --    , vaoAttribSizes
 --    , vaoStride
 
+    , textureObject
+
     , vboName
     , vboPtr
     , vboVertexSize
@@ -90,3 +92,4 @@ makeLenses ''VAO
 makeLenses ''VBO
 makeLenses ''FullShader
 makeLenses ''EBO
+makeLenses ''ShaderTexture

src/Shader/Poke.hs

@@ -15,7 +15,6 @@ import qualified Data.Vector.Unboxed as UV
 import qualified Data.Vector.Unboxed.Mutable as UMV
 import Foreign
 import Geometry.Data
-import Geometry.Polygon
 import Graphics.GL.Core45
 import Linear.V3 (cross)
 import Picture.Data
@@ -97,12 +96,9 @@ pokeShapeObj ::
     IO (Int, Int, Int)
 {-# INLINE pokeShapeObj #-}
 pokeShapeObj ptr iptr ieptr counts (Surface shtype shVerts col shadfid) = case shtype of
-    TopPrism size -> pokeTopPrism shadfid midp col size ptr iptr ieptr counts (VFSM.fromList shVerts)
     FlatFaces size -> pokeBox shadfid col size ptr iptr ieptr counts shVerts
     RoundedFaces size -> pokeRoundedFaces shadfid col size ptr iptr ieptr counts shVerts
     Cylinder size -> pokeCylinder shadfid col size ptr iptr ieptr counts shVerts
-  where
-    midp = centroidNum shVerts
 
 pokeRoundedFaces ::
     ShadowFidelity ->
@@ -224,31 +220,6 @@ boxSurfaces' n =
     reverse [n .. n * 2 -1] :
     [ map ((2 * n) +) [4 * i, 4 * i + 1, 4 * i + 2, 4 * i + 3] | i <- [0 .. n -1]]
 
-pokeTopPrism ::
-    ShadowFidelity ->
-    Point3 ->
-    Point4 ->
-    Int ->
-    Ptr Float ->
-    Ptr GLushort ->
-    Ptr GLushort ->
-    (Int, Int, Int) ->
-    VFSM.Stream IO Point3 ->
-    IO (Int, Int, Int)
-{-# INLINE pokeTopPrism #-}
-pokeTopPrism sfid cp col size ptr iptr ieptr (nv, nsi, nei) svs = do
-    nv' <- VFSM.foldlM' (pokeJustV cp col ptr) nv svs
-    nsi' <-
-        UV.foldM'
-            (pokeIndex nv iptr)
-            nsi
-            (memoTopPrismIndices V.! (size - 3))
-    nei' <- case sfid of
-        NoShadowFidelity -> return nei
-        FullShadowFidelity -> UV.foldM' (pokeIndex nv ieptr) nei $
-            memoTopPrismEdgeIndices V.! (size - 3)
-    return (nv', nsi', nei')
-
 pokeIndex ::
     -- | base index
     Int ->
@@ -263,17 +234,6 @@ pokeIndex nv eiptr ni ioff = do
     pokeElemOff eiptr ni (fromIntegral $ nv + ioff)
     return $ ni + 1
 
---pokeTopPrismIndex ::
---    Int ->
---    Ptr GLushort ->
---    Int ->
---    Int ->
---    IO Int
---{-# INLINE pokeTopPrismIndex #-}
---pokeTopPrismIndex nv iptr nshapeindices ioff = do
---    pokeElemOff iptr nshapeindices (fromIntegral $ nv + ioff)
---    return $ nshapeindices + 1
-
 triangulate :: [Int] -> [Int]
 triangulate is = V.toList . V.backpermute (V.fromList is) . V.fromList $ triangulateIndices (length is)
 
@@ -290,6 +250,7 @@ memoFlatIndices =
         UV.fromList . concatMap triangulate . boxSurfaces' . (+ 3)
 
 memoTopPrismIndices :: V.Vector (UV.Vector Int)
+{-# INLINE memoTopPrismIndices #-}
 memoTopPrismIndices =
     V.generate 10 $
         UV.fromList . topPrismIndices . (+ 3)

src/Shape/Data.hs

@@ -14,8 +14,7 @@ import Data.Aeson.TH
 import Geometry.Data
 
 data ShapeType 
-    = TopPrism { _prismSize :: Int }
-    | FlatFaces { _topBoxSize :: Int }
+    = FlatFaces { _topBoxSize :: Int }
     | RoundedFaces { _shapeHalfSize :: Int }
     | Cylinder { _cylinderSize :: Int }
     deriving (Eq, Ord, Show, Read)