Add normal maps to the floor

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)