directional walls

src/Init.hs

@@ -44,16 +44,30 @@ load = do
     <$> (Window <$> newTVarIO [])
     <*> (Mouse <$> newTVarIO [])
   (ws, _) <- yieldSystemT (0, defWorld) (return ())
-  mwall <- createImage nvg (FileName "assets/walls/wall_desc.png") 0
+  mwallasc <- createImage nvg (FileName "assets/walls/wall_asc.png") 0
-  when (isNothing mwall) $ do
+  mwalldesc <- createImage nvg (FileName "assets/walls/wall_desc.png") 0
-    logIO Error "Failed to load wall"
+  mwallcornern <- createImage nvg (FileName "assets/walls/wall_corner_n.png") 0
+  mwallcornere <- createImage nvg (FileName "assets/walls/wall_corner_e.png") 0
+  mwallcorners <- createImage nvg (FileName "assets/walls/wall_corner_s.png") 0
+  mwallcornerw <- createImage nvg (FileName "assets/walls/wall_corner_w.png") 0
+  mwalltne <- createImage nvg (FileName "assets/walls/wall_t_ne.png") 0
+  mwalltse <- createImage nvg (FileName "assets/walls/wall_t_se.png") 0
+  mwalltsw <- createImage nvg (FileName "assets/walls/wall_t_sw.png") 0
+  mwalltnw <- createImage nvg (FileName "assets/walls/wall_t_nw.png") 0
+  mwallcross <- createImage nvg (FileName "assets/walls/wall_cross.png") 0
+  let mwalls = [ mwallasc, mwalldesc,
+        mwallcornern, mwallcornere, mwallcorners, mwallcornerw,
+        mwalltne, mwalltse, mwalltsw, mwalltnw,
+        mwallcross ]
+  when (any isNothing mwalls) $ do
+    logIO Error "Failed to load walls"
     exitFailure
+  let walls = zipWith (\a b -> (a, fromJust b)) [ImgWallAsc ..] mwalls
   return UserData
     { state       = Menu
     , subsystems  = subs
     , assetImages = M.fromList
-      [ (ImgWall, fromJust mwall)
+      walls
-      ]
     , nano        = nvg
     , uuid        = []
     , worldState  = ws

src/Test.hs

@@ -10,7 +10,7 @@ import Control.Monad (when, void)
 import Control.Monad.IO.Class (liftIO)
 
 import Data.Map.Strict as Map
-import Data.Matrix as M (toLists, (!))
+import Data.Matrix as M (toLists, (!), Matrix, safeGet)
 import Data.Ecstasy as E
 
 import NanoVG hiding (V2(..))
@@ -28,7 +28,7 @@ import Debug.Trace
 loadMap :: Affection UserData ()
 loadMap = do
   ud <- getAffection
-  let fc = FloorConfig (20, 20) [(5,5), (45, 75)] (80,80)
+  let fc = FloorConfig (20, 20) [(5,5), (45, 75)] (80,40)
       (Subsystems _ m) = subsystems ud
   matrix <- liftIO $ buildHallFloorIO fc
   (nws, _) <- yieldSystemT (worldState ud) $ do
@@ -68,7 +68,6 @@ mouseToPlayer mv2 = do
     emap $ do
       with player
       pos' <- E.get pos
-      liftIO $ logIO A.Debug $ show pos'
       pure $ defEntity'
         { vel = Set $ V2 dr dc
         }
@@ -131,6 +130,21 @@ updateMap dt = do
     { worldState = nws
     }
 
+neighWalls :: Int -> Int -> Matrix TileState -> Int
+neighWalls row col mat =
+  Prelude.foldl (\acc (ir, ic) ->
+    if M.safeGet (row + ir) (col + ic) mat == Just Wall ||
+       M.safeGet (row + ir) (col + ic) mat == Just Door
+    then acc + 1
+    else acc
+    )
+    0
+    [ (0, -1)
+    , (-1, 0)
+    , (0, 1)
+    , (1, 0)
+    ]
+
 drawTile :: Int -> Int -> TileState -> Affection UserData ()
 drawTile row col tile = do
   ud <- getAffection
@@ -168,9 +182,70 @@ drawTile row col tile = do
     closePath ctx
     fill ctx
     when (tile == Wall) $ do
+      let img = case neighWalls prow pcol mat of
+            4 ->
+               assetImages ud Map.! ImgWallCross
+            3
+               | M.safeGet (prow + 1) pcol mat /= Just Wall &&
+                 M.safeGet (prow + 1) pcol mat /= Just Door ->
+                 assetImages ud Map.! ImgWallTNW
+               | M.safeGet prow (pcol + 1) mat /= Just Wall &&
+                 M.safeGet prow (pcol + 1) mat /= Just Door ->
+                 assetImages ud Map.! ImgWallTSW
+               | M.safeGet (prow - 1) pcol mat /= Just Wall &&
+                 M.safeGet (prow - 1) pcol mat /= Just Door ->
+                 assetImages ud Map.! ImgWallTSE
+               | otherwise ->
+                 assetImages ud Map.! ImgWallTNE
+            2
+               | (M.safeGet (prow + 1) pcol mat == Just Wall ||
+                 M.safeGet (prow + 1) pcol mat == Just Door) &&
+                 (M.safeGet (prow - 1) pcol mat == Just Wall ||
+                 M.safeGet (prow - 1) pcol mat == Just Door) ->
+                   assetImages ud Map.! ImgWallDesc
+               | (M.safeGet prow (pcol + 1) mat == Just Wall ||
+                 M.safeGet prow (pcol + 1) mat == Just Door) &&
+                 (M.safeGet prow (pcol - 1) mat == Just Wall ||
+                 M.safeGet prow (pcol - 1) mat == Just Door) ->
+                   assetImages ud Map.! ImgWallAsc
+               | (M.safeGet (prow - 1) pcol mat == Just Wall ||
+                 M.safeGet (prow - 1) pcol mat == Just Door) &&
+                 (M.safeGet prow (pcol - 1) mat == Just Wall ||
+                 M.safeGet prow (pcol - 1) mat == Just Door) ->
+                   assetImages ud Map.! ImgWallCornerW
+               | (M.safeGet prow (pcol - 1) mat == Just Wall ||
+                 M.safeGet prow (pcol - 1) mat == Just Door) &&
+                 (M.safeGet (prow + 1) pcol mat == Just Wall ||
+                 M.safeGet (prow + 1) pcol mat == Just Door) ->
+                   assetImages ud Map.! ImgWallCornerS
+               | (M.safeGet (prow + 1) pcol mat == Just Wall ||
+                 M.safeGet (prow + 1) pcol mat == Just Door) &&
+                 (M.safeGet prow (pcol + 1) mat == Just Wall ||
+                 M.safeGet prow (pcol + 1) mat == Just Door) ->
+                   assetImages ud Map.! ImgWallCornerE
+               | otherwise ->
+                   assetImages ud Map.! ImgWallCornerN
+            1
+               | M.safeGet (prow - 1) pcol mat == Just Wall ||
+                 M.safeGet (prow - 1) pcol mat == Just Door ->
+                 assetImages ud Map.! ImgWallDesc
+               | M.safeGet (prow + 1) pcol mat == Just Wall ||
+                 M.safeGet (prow + 1) pcol mat == Just Door ->
+                 assetImages ud Map.! ImgWallDesc
+               | M.safeGet prow (pcol + 1) mat == Just Wall ||
+                 M.safeGet prow (pcol + 1) mat == Just Door ->
+                 assetImages ud Map.! ImgWallAsc
+               | otherwise ->
+                 assetImages ud Map.! ImgWallAsc
+            0 ->
+             assetImages ud Map.! ImgWallCross
+            _ ->
+             error "unexpected number if neighbouring walls"
+          mat = mapMat (stateData ud)
+          (prow, pcol) = (row + 1, col + 1)
       paint <- imagePattern
         ctx x (y - (74 - realToFrac tileHeight)) 64 74 0
-        ((assetImages ud) Map.! ImgWall)
+        img
         1
       beginPath ctx
       rect ctx x (y - (74 - realToFrac tileHeight)) 64 74

src/Types/UserData.hs

@@ -37,8 +37,18 @@ data StateData
     }
 
 data ImgId
-  = ImgWall
+  = ImgWallAsc
-  deriving (Show, Eq, Ord)
+  | ImgWallDesc
+  | ImgWallCornerN
+  | ImgWallCornerE
+  | ImgWallCornerS
+  | ImgWallCornerW
+  | ImgWallTNE
+  | ImgWallTSE
+  | ImgWallTSW
+  | ImgWallTNW
+  | ImgWallCross
+  deriving (Show, Eq, Ord, Enum)
 
 data Direction
   = N