Play with floor textures

shader/lighting/texture.frag

@@ -14,7 +14,8 @@ void main() {
   float y1 = dot(normalize(norm), normalize(distVec));
   float y2 = float(y1 > 0 ? 1 : 0);
   //float y3 = clamp(0.5 * (y1 + 1),0,1) ;
-  float y3 = clamp(y1 + 1,0,1) ;
+  float y3 = clamp(2*y1 + 1,0,1) ;
+  //float y3 = clamp(0.5 * (y1 + 2),0,1) ;
   float y = float(normbit.w == 0 ? y3 : y2);
   //float y = y2;
   float dist = dot(distVec, distVec);

src/Data/Preload/Render.hs

@@ -28,7 +28,7 @@ data RenderData = RenderData
     , _wallBlankShader :: FullShader
     , _windowShader :: FullShader
     , _wallTextureShader :: FullShader
-    , _textureArrayShader :: (FullShader,VBO)
+--    , _textureArrayShader :: (FullShader,VBO)
     , _fullscreenShader :: (FullShader,VBO)
     , _bloomBlurShader :: FullShader
     , _colorBlurShader :: FullShader
@@ -59,6 +59,7 @@ data RenderData = RenderData
     , _floorVBO :: VBO
     , _floorShader :: FullShader
     , _toNormalMaps :: TO
+    , _toDiffuse :: TO
     }
 
 makeLenses ''RenderData

src/Data/Tile.hs

@@ -18,7 +18,7 @@ data Tile = Tile
         -- ^ world position one along in the X direction, note this also set the scale of the
         -- texture
         -- this has to be a position because it is shifted
-    , _tileZ    :: Float
+    , _tileArrayZ    :: Float
     }
   deriving (Eq, Ord, Show)
 makeLenses ''Floor

src/Dodge/Render.hs

@@ -5,6 +5,7 @@ module Dodge.Render (
 
 --import qualified Data.Vector as V
 
+import GLHelp
 import Control.Lens
 import Control.Monad
 import qualified Control.Monad.Parallel as MP
@@ -157,17 +158,10 @@ doDrawing' win pdata u = do
     glDisable GL_CULL_FACE
     --draw floor onto base buffer
     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)
     glUseProgram (pdata ^. floorShader . shadName)
     glBindVertexArray $ pdata ^. floorShader . shadVAO . vaoName
     glBindTextureUnit 1 (pdata ^. toNormalMaps . unTO)
+    glBindTextureUnit 2 (pdata ^. toDiffuse . unTO)
     glDrawArrays 
         (marshalEPrimitiveMode $ pdata ^. floorShader . shadPrim' ) 
         0 
@@ -370,9 +364,3 @@ renderTextureWalls pdata nWalls = do
 
 --cullFace $= Nothing
 
-checkGLError :: IO ()
-checkGLError = do
-    err <- glGetError
-    case err of
-        0 -> return ()
-        i -> error $ "OpenGL error: " ++ show i

src/Dodge/Room/Corridor.hs

@@ -23,7 +23,7 @@ corridor =
           _rmPath = foldMap (doublePairSet . (,) (V2 20 60)) [V2 20 70, V2 20 10]
         , _rmPmnts = [spanLightI (V2 0 39.5) (V2 40 39.5)]
         , _rmBound = [rectNSWE 50 30 (-5) 45]
-        , _rmFloor = Tiled [makeTileFromPoly poly 2]
+        , _rmFloor = Tiled [makeTileFromPoly poly 6]
         , _rmRandPSs = [psRandRanges (10, 30) (30, 60) (0, 2 * pi)]
         , _rmName = "Corridor"
         }

src/Dodge/Room/Ngon.hs

@@ -19,7 +19,7 @@ roomNgon n x =
         , _rmPath = mempty -- TODO
         , _rmPmnts = [mntLightLnkCond $ resetPLUse $ rprBool $ const . isInLnk]
         , _rmBound = [poly]
-        , _rmFloor = Tiled [makeTileFromPoly poly 9]
+        , _rmFloor = Tiled [makeTileFromPoly poly 2]
         , _rmName = show n ++ "gon"
         }
   where

src/Dodge/Room/Procedural.hs

@@ -61,8 +61,8 @@ roomRect x y xn yn =
                 [ Tile
                     { _tilePoly = rectNSWE y 0 0 x
                     , _tileZero = V2 0 0
-                    , _tileTangentPos = V2 32 0
+                    , _tileTangentPos = V2 64 0
-                    , _tileZ = 16
+                    , _tileArrayZ = 3
                     }
                 ]
         , _rmRandPSs = [psRandRanges (10, x -10) (10, y -10) (0, 2 * pi)]

src/GLHelp.hs

@@ -13,3 +13,10 @@ mglCreate f = do
 
 mglDelete :: (GLsizei -> Ptr GLuint -> IO ()) -> GLuint -> IO ()
 mglDelete f i = with i $ \ptr -> f 1 ptr
+
+checkGLError :: IO ()
+checkGLError = do
+    err <- glGetError
+    case err of
+        0 -> return ()
+        i -> error $ "OpenGL error: " ++ show i

src/Preload/Render.hs

@@ -166,13 +166,14 @@ preloadRender = do
     wallTextureShad <-
         makeShaderUsingVAO "wall/texture" [vert, geom, frag] EPoints wpColVAO
             >>= addSamplerTexture2D "data/texture/grayscaleDirt.png"
-    ---- texture array shader
-    textArrayShad <-
-        makeShader "texture/arrayPos" [vert, frag] [3, 3] ETriangles
-            >>= addTextureArray "data/texture/ayene_wooden_floor_transformed.png"
     let floorverxstrd = 8
     floorvbo <- setupVBO' floorverxstrd
     floorshader <- makeShader4 "floor/arrayPos" [vert, frag] [4,4] floorverxstrd ETriangles floorvbo
+    putStrLn "a"
+    tonormalmap <- initTexture2DArray 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/normalArray.png"
+    todiffusemap <- initTexture2DArray 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/diffuseArray.png"
+    checkGLError
+    putStrLn "b"
     -- bind fixed vertex data
     bufferPokedVBO (snd fsShad) 4
     framebuf2 <- setupTextureFramebuffer 800 600
@@ -212,7 +213,6 @@ preloadRender = do
         , eslist
         ]
     initializeGLState
-    tonormalmap <- initTexture 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/attachedPanel.png"
     return $
         RenderData
             { _pictureShaders = shadV
@@ -231,7 +231,7 @@ preloadRender = do
             , _wallBlankShader = wallBlankShad
             , _wallTextureShader = wallTextureShad
             , _windowShader = wallBlankShad{_shadVAO = winColVAO}
-            , _textureArrayShader = textArrayShad
+--            , _textureArrayShader = textArrayShad
             , _fullscreenShader = fsShad
             , _lightingTextureShader = lightingTextureShad
             , _bloomBlurShader = bloomBlurShad
@@ -259,6 +259,7 @@ preloadRender = do
             , _floorVBO = floorvbo
             , _floorShader = floorshader
             , _toNormalMaps = tonormalmap
+            , _toDiffuse = todiffusemap
             }
 
 --------------------end preloadRender

src/Shader/AuxAddition.hs

@@ -3,7 +3,8 @@ module Shader.AuxAddition
     , vaddTextureNoFilter
     , addTextureArray
     , addUniforms
-    , initTexture
+    , initTexture2D
+    , initTexture2DArray
     , tilesToLine -- ^ kept in case it is needed in the future
     ) where
 import Data.Preload.Render
@@ -59,12 +60,12 @@ addTexture2D nlev minfilt magfilt texpath shad = do
 --            glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
 --            return $ shad & shadTex' ?~ ShaderTexture 
 --                {_textureObject = texname }
-initTexture
+initTexture2D
     :: GLint -- number of mipmap levels
     -> GLenum -- minfilter
     -> GLenum -- magfilter
     -> String -> IO TO
-initTexture nlev minfilt magfilt fp = do
+initTexture2D nlev minfilt magfilt fp = do
     Right cmap <- readImage fp
     let texdata = convertRGBA8 cmap
     let wtex = fromIntegral $ imageWidth  texdata
@@ -78,6 +79,42 @@ initTexture nlev minfilt magfilt fp = do
         glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
         return $ TO texname
 
+-- assumes the texture slices are squares with sides as long as the input is
+-- wide
+initTexture2DArray
+    :: GLint -- number of mipmap levels
+    -> GLenum -- minfilter
+    -> GLenum -- magfilter
+    -> String -> IO TO
+initTexture2DArray nlev minfilt magfilt fp = do
+    Right cmap <- readImage fp
+    let texdata = convertRGBA8 cmap
+    let wtex = fromIntegral $ imageWidth  texdata
+        htex = fromIntegral $ imageHeight texdata
+        z = htex `div` wtex
+    checkGLError
+    putStrLn "x"
+    texname <- mglCreate $ glCreateTextures GL_TEXTURE_2D_ARRAY
+    checkGLError
+    putStrLn "y"
+    glTextureStorage3D texname nlev GL_RGBA8 wtex wtex z
+    checkGLError
+    putStrLn "z"
+    VS.unsafeWith (imageData texdata) $ \ptr -> do
+        glTextureSubImage3D texname 0 0 0 0 wtex wtex z GL_RGBA GL_UNSIGNED_BYTE ptr
+        checkGLError
+        putStrLn "i"
+        glGenerateTextureMipmap texname
+        checkGLError
+        putStrLn "q"
+        glTextureParameteri texname GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt)
+        checkGLError
+        putStrLn "w"
+        glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
+        checkGLError
+        putStrLn "e"
+        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
 -- transformation tilesToLine 8 128 on the underlying pixels.

src/Shader/Poke/Floor.hs

@@ -11,7 +11,7 @@ import Foreign
 
 pokeTile :: Ptr Float -> Int -> Tile -> IO Int
 pokeTile ptr i t@Tile { _tilePoly = ps } = do
-    foldM (pokeTileVerx ttan (_tileZ t) ptr) i $ triangulate $ zip ps (tileTexCoords t)
+    foldM (pokeTileVerx ttan (_tileArrayZ t) ptr) i $ triangulate $ zip ps (tileTexCoords t)
   where
     ttan = _tileTangentPos t - _tileZero t
 

src/Tile.hs

@@ -28,8 +28,8 @@ makeTileFromPoly :: [Point2] -> Float -> Tile
 makeTileFromPoly poly z = Tile
     { _tilePoly = poly
     , _tileZero = c
-    , _tileTangentPos = c + (32 * normalizeV (d -.- c))
+    , _tileTangentPos = c + (64 * normalizeV (d -.- c))
-    , _tileZ = z
+    , _tileArrayZ = z
     }
   where
     (c:d:_) = poly