Improve normal maps on ground and walls

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)
-pokeWallsWindows wlptr wiptr wls wis = do
+    [Wall] ->
+    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