Improve normal maps on ground and walls

shader/lighting/texture.frag

@@ -9,19 +9,19 @@ float rad = lumRad.a;
 void main() {
   vec3 pos = texture(screenTexture, vTexPos).xyz;
   vec3 distVec = pos - lightPos;
+  float dist = dot(distVec, distVec);
+  if (dist > rad) {
+    discard;
+  }
   vec4 normbit = texture(normals, vTexPos);
-  vec3 norm = normbit.xyz - pos;
+  vec3 norm = normbit.xyz;
   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(2*y1 + 1,0,1) ;
   //float y3 = clamp(0.5 * (y1 + 2),0,1) ;
-  float y = float(normbit.w == 0 ? y3 : y2);
+  float y = float(normbit.w == 0 ? y2 : y2);
   //float y = y2;
-  float dist = dot(distVec, distVec);
-  if (dist > rad) {
-    discard;
-  }
   float x = 1 - dist / rad;
   vec3 c = y* (x * x * x) * lumRad.rgb;
   fColor = vec4(c, 0);

shader/shape/basic.frag

@@ -9,6 +9,5 @@ void main()
 {
   fCol = vCol;
   fPos = vPos;
-  fNorm = vNorm;
+  fNorm = vec4(vNorm.xyz - vPos.xyz,1);
-  //fNorm = vec4(vPos.x,vPos.y+2,vPos.z,1);
 }

shader/wall/texture.frag

@@ -3,13 +3,24 @@ layout (location=0) out vec4 fCol;
 layout (location=1) out vec4 fPos;
 layout (location=2) out vec4 fNorm;
 in vec2 tPos;
+in vec3 gTexCoords;
 in vec4 gPos;
 in vec4 gNorm;
 in vec4 gColor;
-uniform sampler2D tex;
+in float gRot;
+layout (binding=1) uniform sampler2DArray normalSampler;
+layout (binding=2) uniform sampler2DArray diffuseSampler;
+vec2 rotateV2 (float a, vec2 v)
+{
+    return vec2(v.x*cos(a) - v.y*sin(a), v.x*sin(a) + v.y*cos(a));
+}
 void main()
 {
-  fCol = gColor * texture(tex,tPos);
+  //fCol = gColor * texture(tex,tPos);
+  fCol = texture(diffuseSampler,gTexCoords);
   fPos = gPos;
-  fNorm = gNorm;
+  vec4 basenorm = texture(normalSampler,gTexCoords) - 0.5;
+  //fNorm = fPos - vec4(rotateV2(gRot,basenorm.xz), basenorm.y,0);
+  vec2 n = rotateV2(gRot,vec2(-basenorm.x,-basenorm.z));
+  fNorm = vec4(fPos.xyz - vec3(n,basenorm.y),0);
 }

shader/wall/texture.geom

@@ -7,28 +7,44 @@ out vec4 gColor;
 out vec2 tPos;
 out vec4 gPos;
 out vec4 gNorm;
+out vec3 gTexCoords;
+out float gRot;
 // consider using isLHS to check if the wall is facing the center
 float isLHS (vec2 startV, vec2 testV)
 { return sign( -startV.x * testV.y + startV.y * testV.x); }
 void main()
 { gColor = vColor[0];
+  vec2 p1xy = gl_in[0].gl_Position.xy;
+  vec2 p2xy = gl_in[0].gl_Position.zw;
   vec4 p1 = vec4 (gl_in[0].gl_Position.xy,0,1);
   vec4 p2 = vec4 (gl_in[0].gl_Position.zw,0,1);
   vec4 p3 = vec4 (p1.xy,100,1);
   vec4 p4 = vec4 (p2.xy,100,1);
   vec2 d = vec2(p1.xy - p2.xy);
+  float rot = atan(d.y,d.x);
+  float dist = distance(p1xy,p2xy);
+  float tcoordx = dist / 50;
+  float tcoordz = 11;
   vec4 norm = vec4( d.y, -d.x, 0, 0);
   gPos = p1; tPos = vec2 ( 1,-1) ; gl_Position = vec4(theMat * p1); 
   gNorm = gPos - norm;
+  gTexCoords = vec3 (0,0,tcoordz);
+  gRot = rot;
   EmitVertex();
   gPos = p3; tPos = vec2 ( 1, 1) ; gl_Position = vec4(theMat * p3); 
   gNorm = gPos - norm;
+  gTexCoords = vec3 (0,2,tcoordz);
+  gRot = rot;
   EmitVertex();
   gPos = p2; tPos = vec2 (-1,-1) ; gl_Position = vec4(theMat * p2); 
   gNorm = gPos - norm;
+  gTexCoords = vec3 (tcoordx,0,tcoordz);
+  gRot = rot;
   EmitVertex();
   gPos = p4; tPos = vec2 (-1, 1) ; gl_Position = vec4(theMat * p4); 
   gNorm = gPos - norm;
+  gTexCoords = vec3 (tcoordx,2,tcoordz);
+  gRot = rot;
   EmitVertex();
   EndPrimitive();
 }

src/Data/Preload/Render.hs

@@ -60,6 +60,8 @@ data RenderData = RenderData
     , _floorShader :: FullShader
     , _toNormalMaps :: TO
     , _toDiffuse :: TO
+    , _wallVBO :: VBO
+    , _wallShader :: FullShader
     }
 
 makeLenses ''RenderData

src/Dodge/Base/Wall.hs

@@ -5,7 +5,7 @@ import Geometry
 
 wlIsOpaque :: Wall -> Bool
 wlIsOpaque wl = case _wlOpacity wl of
-    Opaque -> True
+    Opaque {} -> True
     _ -> False
 
 wlIsSeeThrough :: Wall -> Bool

src/Dodge/Data/Config.hs

@@ -38,7 +38,6 @@ data Configuration = Configuration
     { _volume_master :: Float
     , _volume_sound :: Float
     , _volume_music :: Float
-    , _graphics_wall_textured :: Bool
     , _graphics_cloud_shadows :: Bool
     , _graphics_object_shadows :: ObjectShadows
     , _graphics_resolution_factor :: ResFactor
@@ -108,7 +107,6 @@ defaultConfig =
         { _volume_master = 1
         , _volume_sound = 1
         , _volume_music = 0
-        , _graphics_wall_textured = True
         , _graphics_cloud_shadows = True
         , _graphics_object_shadows = GeoObjShads
         , _graphics_resolution_factor = QuarterRes

src/Dodge/Data/Wall.hs

@@ -19,7 +19,6 @@ data Wall = Wall
     { _wlLine :: (Point2, Point2)
     , _wlID :: Int
     , _wlColor :: Color
---    , _wlSeen :: Bool
     , _wlOpacity :: Opacity
     , _wlPathable :: Bool
     , _wlPenetrable :: Bool
@@ -40,7 +39,7 @@ data Opacity
     = SeeThrough
     | SeeAbove
     | DrawnWall {_opDraw :: WallDraw} -- Wall -> SPic
-    | Opaque
+    | Opaque {_opTexture :: Int}
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data WallDraw = DrawForceField

src/Dodge/Default/Door.hs

@@ -14,15 +14,17 @@ switchWallCol col = defaultSwitchWall & wlColor .~ col
 
 defaultAutoWall :: Wall
 defaultAutoWall =
-    defaultDoorWall'
+    defaultDoorWall
         & wlColor .~ dim yellow
         & wlPathable .~ True
+        & wlOpacity .~ Opaque 9
 
 defaultSwitchWall :: Wall
 defaultSwitchWall =
-    defaultDoorWall'
+    defaultDoorWall
         & wlColor .~ red
         & wlPathable .~ False
+        & wlOpacity .~ Opaque 0
 
 defaultDoor :: Door
 defaultDoor =

src/Dodge/Default/Wall.hs

@@ -13,7 +13,8 @@ defaultWall =
         { _wlLine = (V2 0 0, V2 50 0)
         , _wlID = 0
         , _wlColor = greyN 0.6
-        , _wlOpacity = Opaque
+        --, _wlOpacity = Opaque 11
+        , _wlOpacity = Opaque 11
         , _wlPathable = False
         , _wlPenetrable = False
         , _wlFireThrough = False
@@ -28,8 +29,8 @@ defaultWall =
         , _wlBouncy = True
         }
 
-defaultDoorWall' :: Wall
+defaultDoorWall :: Wall
-defaultDoorWall' =
+defaultDoorWall =
     defaultWall
         { _wlPathable = True
         , _wlMaterial = Metal
@@ -63,7 +64,7 @@ defaultDirtWall =
         { _wlLine = (V2 0 0, V2 50 0)
         , _wlID = 0
         , _wlColor = dirtColor
-        , _wlOpacity = Opaque
+        , _wlOpacity = Opaque 6
         , _wlRotateTo = False
         , _wlFireThrough = True
         , _wlPenetrable = True

src/Dodge/Event/Test.hs

@@ -7,87 +7,3 @@ import Dodge.Data.World
 testEvent :: World -> World
 testEvent w = w
 
---testEvent :: World -> World
---testEvent w = over walls (IM.union testWalls) w
---  where
---    k = newKey $ _walls w
---    setKeys = zipWith (\i wl -> wl & wlID .~ i) [k..]
---
---    testWalls = IM.fromList $ zip [k..] $ setKeys (startWalls ++ errorWalls ++ (errorWall : polyWalls) ++ endWalls)
---
---    polyPairs = makeLoopPairs
---        $ reverse [(-340.0,59.999996),(-374.64102,79.99999),(-340.0,100.0)]
-----        [(4172.5835,2597.1892),(3855.1414,2597.1895),(3855.141,2324.7563),(4172.5835,2324.756)]
---    polyWalls = map (wallWithCol red . flat2) polyPairs
---
---    errorWallPair =
---        (9,[(-340.0,60.0),(-320.0,60.0)])
-----        (48,[(3855.1414,2587.1892),(3855.141,2324.7563)])
---    errorWall = wallWithCol green $ snd errorWallPair
---
---    errorWallPairs =
---        [(1,[(-400.0,59.999996),(-340.0,60.0)])
---        ,(12,[(-340.0,60.0),(-340.0,59.999996)])
---        ]
-----        [(43,[(3855.1414,2598.1895),(3855.1414,2587.1892)])
-----        ,(49,[(3855.1414,2597.1895),(3855.1414,2587.1892)])
-----        ]
---    errorWalls = map (wallWithCol blue . snd) errorWallPairs
---
---    startWallPairs =
---        [(0,[(-320.0,60.0),(-320.0,100.0)])
---        ,(1,[(-400.0,59.999996),(-320.0,60.0)])
---        ,(2,[(-400.0,100.0),(-400.0,59.999996)])
---        ,(3,[(-320.0,100.0),(-400.0,100.0)])
---        ,(4,[(-260.0,60.0),(-225.35898,80.0)])
---        ,(5,[(-260.0,100.0),(-260.0,60.0)])
---        ,(6,[(-225.35898,80.0),(-260.0,100.0)])
---        ]
-----        [(5,[(3875.1414,2761.8303),(3855.1414,2727.1892)])
-----        ,(16,[(3895.1414,2727.1892),(3875.1414,2761.8303)])
-----        ,(18,[(3855.1414,2727.1892),(3855.1414,2667.1892)])
-----        ,(19,[(3875.1414,2552.548),(3895.1414,2587.1892)])
-----        ,(32,[(3855.1414,2587.1892),(3875.1414,2552.548)])
-----        ,(36,[(3895.1414,2667.1892),(3895.1414,2727.1892)])
-----        ,(37,[(3895.1414,2587.1892),(3895.1414,2647.1892)])
-----        ,(38,[(3855.1414,2647.1892),(3855.1414,2587.1892)])
-----        ,(39,[(3855.1414,2667.1892),(3855.1414,2647.1892)])
-----        ,(40,[(3895.1414,2647.1892),(3895.1414,2667.1892)])
-----        ]
---    startWalls = map (wallWithCol yellow . snd) startWallPairs
---
---    endWalls = map (wallWithCol (withAlpha 0.2 orange) . snd) endWallPairs
---    endWallPairs =
---        [(0,[(-320.0,60.0),(-320.0,100.0)])
---        ,(1,[(-400.0,59.999996),(-340.0,60.0)])
---        ,(2,[(-400.0,100.0),(-400.0,59.999996)])
---        ,(3,[(-320.0,100.0),(-340.0,100.0)])
---        ,(4,[(-260.0,60.0),(-225.35898,80.0)])
---        ,(5,[(-260.0,100.0),(-260.0,60.0)])
---        ,(6,[(-225.35898,80.0),(-260.0,100.0)])
---        ,(9,[(-340.0,60.0),(-320.0,60.0)])
---        ,(11,[(-340.0,100.0),(-400.0,100.0)])
---        ,(12,[(-340.0,60.0),(-340.0,59.999996)])
---        ]
-----        [(5,[(3875.1414,2761.8303),(3855.1414,2727.1892)])
-----        ,(16,[(3895.1414,2727.1892),(3875.1414,2761.8303)])
-----        ,(18,[(3855.1414,2727.1892),(3855.1414,2667.1892)])
-----        ,(36,[(3895.1414,2667.1892),(3895.1414,2727.1892)])
-----        ,(38,[(3855.1414,2647.1892),(3855.1414,2598.1895)])
-----        ,(39,[(3855.1414,2667.1892),(3855.1414,2647.1892)])
-----        ,(40,[(3895.1414,2647.1892),(3895.1414,2667.1892)])
-----        ,(43,[(3855.1414,2598.1895),(3855.1414,2587.1892)])
-----        ,(45,[(3895.1414,2597.1895),(3895.1414,2647.1892)])
-----        ,(46,[(4172.5835,2324.756),(4172.5835,2597.1892)])
-----        ,(47,[(3855.141,2324.7563),(4172.5835,2324.756)])
-----        ,(48,[(3855.1414,2587.1892),(3855.141,2324.7563)])
-----        ,(49,[(3855.1414,2597.1895),(3855.1414,2587.1892)])
-----        ,(50,[(3855.1414,2598.1895),(3855.1414,2597.1895)])
-----        ,(51,[(4172.5835,2597.1892),(3895.1414,2597.1895)])
-----        ]
---
-----flat2 :: (a,a) -> [a]
-----flat2 (x,y) = [x,y]
---
---wallWithCol :: Color -> (Point2,Point2) -> Wall
---wallWithCol col ps = defaultWall & wlLine .~ ps & wlColor .~ col & wlSeen .~ True

src/Dodge/Item/Weapon/Shatter.hs

@@ -16,7 +16,7 @@ shootShatter it cr w =
             collidePointWallsFilter canshatter sp ep w
   where
     canshatter wl = case _wlOpacity wl of
-        Opaque -> True
+        Opaque {} -> True
         SeeThrough -> True
         _ -> False
     sp = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir

src/Dodge/Menu.hs

@@ -183,7 +183,6 @@ graphicsMenu = titleOptionsMenu "OPTIONS:GRAPHICS" graphicsMenuOptions
 graphicsMenuOptions :: [MenuOption]
 graphicsMenuOptions =
     [ makeEnumOption graphics_resolution_factor "RESOLUTION" (uvIOEffects .~ updateFramebufferSize)
-    , makeBoolOption graphics_wall_textured "WALL TEXTURES"
     , makeEnumOption graphics_object_shadows "OBJECT SHADOWS" id
     , makeBoolOption graphics_cloud_shadows "CLOUD SHADOWS"
     , makeEnumOption graphics_num_shadow_casters "SHADOW CASTERS" id

src/Dodge/Placement/Instance/Wall.hs

@@ -89,7 +89,7 @@ baseBlockPane =
         { _wlLine = (V2 0 0, V2 50 0)
         , _wlID = 0
         , _wlColor = greyN 0.5
-        , _wlOpacity = Opaque
+        , _wlOpacity = Opaque 10
         , _wlUnshadowed = True
         , _wlFireThrough = True
         , _wlPenetrable = True

src/Dodge/Render.hs

@@ -53,7 +53,7 @@ doDrawing' win pdata u = do
         trans = w ^. cWorld . camPos . camCenter
         wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig)
         resFact = resFactorNum $ cfig ^. graphics_resolution_factor
-        (wallPointsCol, windowPoints, wallSPics) = wallsToDraw w
+        (wallPointsCol, windowPoints, wallSPics, wallsToPoke) = wallsToDraw w
         lightPoints = lightsToRender cfig (w ^. cWorld . camPos) (w ^. cWorld . lWorld)
         viewFroms@(V2 vfx vfy) = w ^. cWorld . camPos . camViewFrom
         shadV = _pictureShaders pdata
@@ -63,7 +63,7 @@ doDrawing' win pdata u = do
     layerCounts <- UMV.replicate (numLayers * 6) 0
     -- attempt to poke in parallel
     let (ws, wp) = wallSPics <> worldSPic cfig w
-    ((nWalls, nWins), (nShapeVs, nIndices, nSilIndices)) <-
+    ((nWalls, nWins,trueNWalls), (nShapeVs, nIndices, nSilIndices)) <-
         MP.bindM3
             (\_ a b -> return (a, b))
             ( pokeLayVerxs
@@ -74,8 +74,10 @@ doDrawing' win pdata u = do
             ( pokeWallsWindows
                 ( pdata ^. vboWalls . vboPtr)
                 ( pdata ^. vboWindows . vboPtr)
+                ( pdata ^. wallVBO . vboPtr)
                 wallPointsCol
                 windowPoints
+                wallsToPoke
             )
             ( pokeShape
                 (_vboPtr $ _vboShapes pdata)
@@ -90,6 +92,7 @@ doDrawing' win pdata u = do
         unzip
             [ (pdata ^. vboWalls, nWalls)
             , (pdata ^. vboWindows, nWins)
+            , (pdata ^. wallVBO, trueNWalls)
             ]
     bufferPokedVBO (_vboShapes pdata) nShapeVs
     glNamedBufferSubData
@@ -139,9 +142,22 @@ doDrawing' win pdata u = do
         2
         ptr
     --draw walls onto base buffer
-    if cfig ^. graphics_wall_textured
+    glDisable GL_BLEND
-        then renderTextureWalls pdata nWalls
+    glBindTextureUnit 1 (pdata ^. toNormalMaps . unTO)
-        else renderBlankWalls pdata nWalls
+    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
+    glDrawArrays
+        (marshalEPrimitiveMode $ pdata ^. wallShader . shadPrim')
+        0
+        (fromIntegral trueNWalls)
+    --glDisable GL_CULL_FACE
+--    if cfig ^. graphics_wall_textured
+--        then renderTextureWalls pdata nWalls
+--        else renderBlankWalls pdata nWalls
     --draw object pictures onto base buffer
     renderLayer BottomLayer shadV layerCounts
     --draw object shapes onto base buffer
@@ -157,7 +173,6 @@ doDrawing' win pdata u = do
         nullPtr
     glDisable GL_CULL_FACE
     --draw floor onto base buffer
-    glDisable GL_BLEND
     glUseProgram (pdata ^. floorShader . shadName)
     glBindVertexArray $ pdata ^. floorShader . shadVAO . vaoName
     glBindTextureUnit 1 (pdata ^. toNormalMaps . unTO)
@@ -336,31 +351,6 @@ setViewportSize :: Int -> Int -> IO ()
 setViewportSize x y =
     glViewport 0 0 (fromIntegral x) (fromIntegral y)
 
-renderBlankWalls ::
-    RenderData ->
-    -- | number of walls
-    Int ->
-    IO ()
-renderBlankWalls pdata nWalls = do
-    glEnable GL_CULL_FACE
-    glCullFace GL_BACK
-    --cullFace $= Just Back
-    drawShader (_wallBlankShader pdata) nWalls
-    glDisable GL_CULL_FACE
-
---cullFace $= Nothing
-
-renderTextureWalls ::
-    RenderData ->
-    -- | number of walls
-    Int ->
-    IO ()
-renderTextureWalls pdata nWalls = do
-    --cullFace $= Just Back
-    glEnable GL_CULL_FACE
-    glCullFace GL_BACK
-    drawShader (_wallTextureShader pdata) nWalls
-    glDisable GL_CULL_FACE
 
 --cullFace $= Nothing
 

src/Dodge/Render/Walls.hs

@@ -13,19 +13,17 @@ import Dodge.Wall.Draw
 import Geometry
 import ShapePicture
 
-wallsToDraw :: World -> ([((Point2, Point2), Point4)], [((Point2, Point2), Point4)], SPic)
+wallsToDraw :: World -> ([((Point2, Point2), Point4)], [((Point2, Point2), Point4)], SPic, [Wall])
-wallsToDraw w =
+wallsToDraw w = L.fold
-    (wls, wins, spic)
+            ( (,,,)
-  where
-    f wl = (_wlLine wl, _wlColor wl)
-    (wls, wins, spic) =
-        L.fold
-            ( (,,)
                 <$> L.prefilter wlOpaqueDraw (L.premap f L.list)
                 <*> L.prefilter wlSeeThroughDraw (L.premap f L.list)
                 <*> L.premap getWallSPic L.mconcat
+                <*> L.prefilter wlOpaqueDraw L.list
             )
             (w ^. cWorld . lWorld . walls)
+  where
+    f wl = (_wlLine wl, _wlColor wl)
 --            (wlsFromIXs w $ zonesExtract (w ^. wlZoning) $ zoneOfSight wlZoneSize cam)
 --    cam = w ^. cWorld . camPos
 

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 6]
+        , _rmFloor = Tiled [makeTileFromPoly poly 5]
         , _rmRandPSs = [psRandRanges (10, 30) (30, 60) (0, 2 * pi)]
         , _rmName = "Corridor"
         }

src/Dodge/Room/Procedural.hs

@@ -10,6 +10,7 @@ module Dodge.Room.Procedural (
     makeGrid,
 ) where
 
+import Tile
 import qualified Data.Set as S
 import Data.Tile
 import Dodge.Creature
@@ -61,8 +62,8 @@ roomRect x y xn yn =
                 [ Tile
                     { _tilePoly = rectNSWE y 0 0 x
                     , _tileZero = V2 0 0
-                    , _tileTangentPos = V2 64 0
+                    , _tileTangentPos = V2 baseFloorTileSize 0
-                    , _tileArrayZ = 4
+                    , _tileArrayZ = 5
                     }
                 ]
         , _rmRandPSs = [psRandRanges (10, x -10) (10, y -10) (0, 2 * pi)]

src/Preload/Render.hs

@@ -165,15 +165,14 @@ preloadRender = do
     -- textured wallShader
     wallTextureShad <-
         makeShaderUsingVAO "wall/texture" [vert, geom, frag] EPoints wpColVAO
-            >>= addSamplerTexture2D "data/texture/grayscaleDirt.png"
+    let wallverxstrd = 8
+    wallvbo <- setupVBO' wallverxstrd
+    wallshader <- makeShader4 "wall/basic" [vert,geom,frag] [4,4] wallverxstrd EPoints wallvbo
     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
@@ -260,6 +259,8 @@ preloadRender = do
             , _floorShader = floorshader
             , _toNormalMaps = tonormalmap
             , _toDiffuse = todiffusemap
+            , _wallVBO = wallvbo
+            , _wallShader = wallshader
             }
 
 --------------------end preloadRender

src/Shader.hs

@@ -42,14 +42,11 @@ drawShaderLay l countsVector shadIn fs = do
 drawShader :: FullShader -> Int -> IO ()
 {-# INLINE drawShader #-}
 drawShader fs i = do 
-    --currentProgram $= Just (_shadProg fs)
     glUseProgram (_shadName fs)
     glBindVertexArray $ fs ^. shadVAO . vaoName
-    --bindVertexArrayObject $= Just (_vaoName $ _shadVAO' fs)
     case _shadTex' fs of 
         Just ShaderTexture{_textureObject = txo
-                } --, _textureTarget = tt }
+                }
-            -- -> glBindTexture tt txo
             -> glBindTextureUnit 0 txo
         _   -> return ()
     glDrawArrays 

src/Shader/Poke.hs

@@ -3,12 +3,13 @@ module Shader.Poke (
     pokeLayVerxs,
     pokeArrayOff,
     pokeShape,
-    pokeWallsWindowsFloor,
     pokeWallsWindows,
     memoTopPrismEdgeIndices,
     pokeFloors
 ) where
 
+import Geometry.Vector
+import Dodge.Data.Wall
 import Shader.Poke.Triangulate
 import Control.Monad.Primitive
 import qualified Data.Vector as V
@@ -43,30 +44,19 @@ pokeVerx vbos offsets Verx{_vxPos = thePos, _vxCol = theCol, _vxExt = ext, _vxSh
   where
     sn = _unShadNum theShadNum
 
-pokeWallsWindowsFloor ::
-    Ptr Float ->
-    Ptr Float ->
-    Ptr Float ->
-    [((Point2, Point2), Point4)] ->
-    [((Point2, Point2), Point4)] ->
-    [(Point3, Point3)] ->
-    IO (Int, Int, Int)
-pokeWallsWindowsFloor wlptr wiptr flptr wls wis fls = do
-    wlcounts1 <- VFSM.foldlM' (pokeW wlptr) 0 (VFSM.fromList wls)
-    wlcounts2 <- VFSM.foldlM' (pokeW wiptr) 0 (VFSM.fromList wis)
-    flcounts <- VFSM.foldlM' (pokeF flptr) 0 (VFSM.fromList fls)
-    return (wlcounts1, wlcounts2, flcounts)
-
 pokeWallsWindows ::
+    Ptr Float ->
     Ptr Float ->
     Ptr Float ->
     [((Point2, Point2), Point4)] ->
     [((Point2, Point2), Point4)] ->
-    IO (Int, Int)
+    [Wall] ->
-pokeWallsWindows wlptr wiptr wls wis = do
+    IO (Int, Int, Int)
+pokeWallsWindows wlptr wiptr truewlptr wls wis truewls = do
     wlcounts1 <- VFSM.foldlM' (pokeW wlptr) 0 (VFSM.fromList wls)
     wlcounts2 <- VFSM.foldlM' (pokeW wiptr) 0 (VFSM.fromList wis)
-    return (wlcounts1, wlcounts2)
+    wlcounts3 <- VFSM.foldlM' (pokeWall truewlptr) 0 (VFSM.fromList truewls)
+    return (wlcounts1, wlcounts2, wlcounts3)
 
 pokeFloors :: Ptr Float ->
     [(Point3, Point3)] ->
@@ -84,6 +74,16 @@ pokeF ptr i' (V3 a b c, V3 d e f) = do
     pokeElemOff ptr (i + 5) f
     return $ i' + 1
 
+pokeWall :: Ptr Float -> Int -> Wall -> IO Int
+pokeWall ptr nw wl = do
+    UV.imapM_ f $ UV.fromList [x,y,x1,y1,t,a,1,1]
+    return $ nw + 1
+  where
+    f i = pokeElemOff ptr (nw * 8 + i)
+    (V2 x y, V2 x1 y1) = _wlLine wl
+    t = fromIntegral $ _opTexture $ _wlOpacity wl
+    a = argV (V2 x1 y1 -.- V2 x y)
+
 pokeW :: Ptr Float -> Int -> ((Point2, Point2), Point4) -> IO Int
 pokeW ptr i' ((V2 a b, V2 c d), V4 e f g h) = do
     let i = i' * 8

src/Tile.hs

@@ -1,6 +1,7 @@
 module Tile
     ( tileTexCoords
     , makeTileFromPoly
+    , baseFloorTileSize
     )
      where
 import Data.Tile
@@ -28,8 +29,11 @@ makeTileFromPoly :: [Point2] -> Float -> Tile
 makeTileFromPoly poly z = Tile
     { _tilePoly = poly
     , _tileZero = c
-    , _tileTangentPos = c + (64 * normalizeV (d -.- c))
+    , _tileTangentPos = c + (baseFloorTileSize *.* normalizeV (d -.- c))
     , _tileArrayZ = z
     }
   where
     (c:d:_) = poly
+
+baseFloorTileSize :: Float
+baseFloorTileSize = 50