Fix normal map transformations for floor

src/Data/Tile.hs

@@ -14,7 +14,10 @@ data Floor
 data Tile = Tile
     { _tilePoly :: [Point2]
     , _tileZero :: Point2   -- ^ point in the world where tile texture is 0,0
-    , _tileX    :: Point2   -- ^ vector in the X direction (1,0)
+    , _tileTangentPos :: Point2   
+        -- ^ 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
     }
   deriving (Eq, Ord, Show)

src/Dodge/Data/CWorld.hs

@@ -30,7 +30,6 @@ data CWorld = CWorld
     , _pastWorlds :: [LWorld]
     , _timeFlow :: TimeFlowStatus
     , _seenWalls :: IS.IntSet
-    , _floorTiles :: [(Point3, Point3)]
     , _cwTiles :: [Tile]
     , _pathGraph :: Gr Point2 PathEdge
     , _numberFloorVerxs :: Int

src/Dodge/Default/World.hs

@@ -84,8 +84,6 @@ defaultCWorld =
         , _pastWorlds = []
         , _timeFlow = NormalTimeFlow
         , _seenWalls = mempty
-        , _floorTiles = mempty
-        --, _pathGraph = mempty 
         , _pathGraph = Data.Graph.Inductive.Graph.empty
         , _cwTiles = mempty
         , _numberFloorVerxs = 0

src/Dodge/Layout.hs

@@ -30,7 +30,6 @@ import Dodge.Zoning.Pathing
 import Geometry
 import qualified IntMapHelp as IM
 import RandomHelp
-import Tile
 
 generateLevelFromRoomList :: IM.IntMap Room -> World -> GenWorld
 generateLevelFromRoomList gr' w =
@@ -42,7 +41,7 @@ generateLevelFromRoomList gr' w =
         . doInPlacements
         . doOutPlacements
         . doIndividualPlacements
-        . setFloors
+        . setTiles
         . worldToGenWorld rs'
         $ w & cWorld . lWorld . walls .~ wallsFromRooms rs
             & cWorld . cwGen . cwgGameRooms .~ gameRoomsFromRooms (IM.elems rs')
@@ -60,12 +59,6 @@ generateLevelFromRoomList gr' w =
 randomCompass :: World -> World
 randomCompass w = w & cWorld . camPos . camRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w)
 
-putFloorTiles :: GenWorld -> GenWorld
-putFloorTiles gw = gw & gwWorld . cWorld . floorTiles .~ floorsFromGenWorld gw
-
-setFloors :: GenWorld -> GenWorld
-setFloors = putFloorTiles . setTiles
-
 -- note the order of traversal of the rooms is important
 -- hence the reverse
 -- this is not ideal: should do this in some more sensible way
@@ -209,15 +202,9 @@ gameRoomFromRoom rm =
         _ -> getDir xs
     getDir _ = 0 -- fallback
 
-floorsFromRooms :: [Room] -> [(Point3, Point3)]
-floorsFromRooms = concatMap (concatMap tileToRenderList . getTiles . _rmFloor . doRoomShift)
-
 tilesFromRooms :: [Room] -> [Tile]
 tilesFromRooms = concatMap (getTiles . _rmFloor . doRoomShift)
 
-floorsFromGenWorld :: GenWorld -> [(Point3, Point3)]
-floorsFromGenWorld = floorsFromRooms . IM.elems . _genRooms
-
 getTiles :: Floor -> [Tile]
 getTiles fl = case fl of
     Tiled xs -> xs

src/Dodge/LevelGen.hs

@@ -33,12 +33,7 @@ generateWorldFromSeed rdata i = do
 postGenerationProcessing :: RenderData -> GenWorld -> IO World
 postGenerationProcessing _ gw = do
     let w' = _gwWorld gw
---    nfloorvxs <- foldM (pokeTile (rdata ^. floorVBO . vboPtr))
---        0
---        (tilesFromRooms . IM.elems $ _genRooms gw)
---    bufferPokedVBO (rdata ^. floorVBO) nfloorvxs
-    let w = w' -- & cWorld . numberFloorVerxs .~ nfloorvxs
-            & cWorld . cwTiles .~ (tilesFromRooms . IM.elems $ _genRooms gw)
+    let w = w' & cWorld . cwTiles .~ (tilesFromRooms . IM.elems $ _genRooms gw)
     return $ foldl' assignPushDoors w (w ^. cWorld . lWorld . doors)
 
 generateGraphs :: IO ()

src/Dodge/Render.hs

@@ -89,7 +89,6 @@ doDrawing' win pdata u = do
         unzip
             [ (pdata ^. vboWalls, nWalls)
             , (pdata ^. vboWindows, nWins)
-            , (pdata ^. floorVBO, nFls)
             ]
     bufferPokedVBO (_vboShapes pdata) nShapeVs
     glNamedBufferSubData

src/Dodge/Room/Link.hs

@@ -46,7 +46,7 @@ shiftRoomBy shift r =
             %~ map
                 ( (tilePoly %~ map (shiftPointBy shift))
                     . (tileZero %~ shiftPointBy shift)
-                    . (tileX %~ shiftPointBy shift)
+                    . (tileTangentPos %~ shiftPointBy shift)
                 )
         & rmViewpoints %~ map (shiftPointBy shift)
 
@@ -62,7 +62,7 @@ moveRoomBy shift r =
             %~ map
                 ( (tilePoly %~ map (shiftPointBy shift))
                     . (tileZero %~ shiftPointBy shift)
-                    . (tileX %~ shiftPointBy shift)
+                    . (tileTangentPos %~ shiftPointBy shift)
                 )
         & rmViewpoints %~ map (shiftPointBy shift)
         & rmPos %~ map ((rpPos %~ shiftPointBy shift) . (rpDir +~ snd shift))

src/Dodge/Room/Procedural.hs

@@ -61,7 +61,7 @@ roomRect x y xn yn =
                 [ Tile
                     { _tilePoly = rectNSWE y 0 0 x
                     , _tileZero = V2 0 0
-                    , _tileX = V2 1 0
+                    , _tileTangentPos = V2 32 0
                     , _tileZ = 16
                     }
                 ]

src/Preload/Render.hs

@@ -213,7 +213,7 @@ preloadRender = do
         ]
     initializeGLState
 
-    tonormalmap <- initTexture 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/verticalRidge.png"
+    tonormalmap <- initTexture 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/squaresPattern.png"
     return $
         RenderData
             { _pictureShaders = shadV

src/Shader/Poke/Floor.hs

@@ -8,12 +8,13 @@ import Data.Tile
 import Foreign
 
 pokeTile :: Ptr Float -> Int -> Tile -> IO Int
-pokeTile ptr i t@Tile { _tilePoly = ps , _tileX = ttan } = do
-    let coords = map (calcTexCoord (_tileZero t) ttan) ps
-        coords3 = map (addZ (_tileZ t)) coords
-    foldM (pokeTileVerx ttan ptr) i $ triangulate $ zip ps coords3
+pokeTile ptr i t@Tile { _tilePoly = ps } = do
+    foldM (pokeTileVerx ttan (_tileZ t) ptr) i $ triangulate $ zip ps (tileTexCoords t)
+  where
+    ttan = _tileTangentPos t - _tileZero t
 
-pokeTileVerx :: Point2 -> Ptr Float -> Int -> (Point2,Point3) -> IO Int
-pokeTileVerx (V2 t s) ptr i (V2 x y,V3 u v w) = do
-    zipWithM_ (\off -> pokeElemOff ptr (i*8 + off)) [0..] [x,y,s,t,u,v,w,1]
+pokeTileVerx :: Point2 -> Float -> Ptr Float -> Int -> (Point2,Point2) -> IO Int
+pokeTileVerx tangent tilez ptr i (V2 x y,V2 s t) = do
+    let a = argV tangent
+    zipWithM_ (\off -> pokeElemOff ptr (i*8 + off)) [0..] [x,y,1,1,s,t,tilez,a]
     return $ i + 1

src/Tile.hs

@@ -1,33 +1,35 @@
 module Tile
+    ( tileTexCoords
+    , makeTileFromPoly
+    )
      where
 import Data.Tile
 import Geometry
 
-tileToRenderList :: Tile -> [(Point3,Point3)]
-tileToRenderList t = polyToTris $ zip ps3 coords3
+tileTexCoords :: Tile -> [Point2]
+tileTexCoords t = map 
+    (calcTexCoord (_tileZero t) tangent (- vNormal tangent))
+    (_tilePoly t)
   where
-    ps = _tilePoly t
-    coords = map (calcTexCoord (_tileZero t) (_tileX t)) ps
-    ps3 = map (addZ 0) ps
-    coords3 = map (addZ (_tileZ t)) coords
+    tangent = _tileTangentPos t - _tileZero t
 
 calcTexCoord
     :: Point2   -- ^ tile (0,0)
-    -> Point2   -- ^ tile (1,0)
+    -> Point2   -- ^ tile tangent
+    -> Point2   -- ^ tile cotangent
     -> Point2   -- ^ world point
     -> Point2
-calcTexCoord c p x = V2 (vectorAmountIn xdir) (vectorAmountIn ydir)
+calcTexCoord zp tangent cotangent p = V2 (f tangent) (f cotangent)
   where
-    vectorAmountIn dir = 0.02 * dotV (p -.- c) dir
-    xdir = x -.- c
-    ydir = vNormal xdir
+    f t = closestPointOnLineParam zp (zp + t) p
+    
 
 makeTileFromPoly :: [Point2] -> Float -> Tile
 makeTileFromPoly poly z = Tile
     { _tilePoly = poly
     , _tileZero = c
-    , _tileX  = c +.+ normalizeV ((poly !! 1) -.- c)
+    , _tileTangentPos = c + (32 * normalizeV (d -.- c))
     , _tileZ = z
     }
   where
-    c = head poly
+    (c:d:_) = poly