placeholder walls

src/Init.hs

@@ -13,6 +13,7 @@ import NanoVG hiding (V2(..), V3(..))
 
 import Linear
 
+import Control.Monad (when)
 import Control.Monad.IO.Class (liftIO)
 
 import Control.Concurrent.STM
@@ -20,6 +21,9 @@ import Control.Concurrent.STM
 import qualified Data.Set as S
 import qualified Data.Map.Strict as M
 import Data.Ecstasy
+import Data.Maybe
+
+import System.Exit (exitFailure)
 
 import Foreign.C.Types (CInt(..))
 
@@ -40,10 +44,16 @@ load = do
     <$> (Window <$> newTVarIO [])
     <*> (Mouse <$> newTVarIO [])
   (ws, _) <- yieldSystemT (0, defWorld) (return ())
+  mwall <- createImage nvg (FileName "assets/walls/wall_desc.png") 0
+  when (isNothing mwall) $ do
+    logIO Error "Failed to load wall"
+    exitFailure
   return UserData
     { state       = Menu
     , subsystems  = subs
-    , assetImages = M.empty -- FILLME!
+    , assetImages = M.fromList
+      [ (ImgWall, fromJust mwall)
+      ]
     , nano        = nvg
     , uuid        = []
     , worldState  = ws

src/Test.hs

@@ -9,6 +9,7 @@ import qualified Graphics.Rendering.OpenGL as GL hiding (get)
 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.Ecstasy as E
 
@@ -66,6 +67,8 @@ mouseToPlayer mv2 = do
   (nws, _) <- yieldSystemT (worldState ud) $ do
     emap $ do
       with player
+      pos' <- E.get pos
+      liftIO $ logIO A.Debug $ show pos'
       pure $ defEntity'
         { vel = Set $ V2 dr dc
         }
@@ -123,7 +126,7 @@ updateMap dt = do
                 }
             | otherwise =
               defEntity'
-      pure ent
+      return ent
   putAffection ud
     { worldState = nws
     }
@@ -146,7 +149,7 @@ drawTile row col tile = do
     beginPath ctx
     let x = realToFrac $ 640 + ((fromIntegral col - pc + 1) +
           (fromIntegral row - pr + 1)) * (tileWidth / 2)
-        y = realToFrac $ 360 + ((fromIntegral row - pr + 1) -
+        y = realToFrac $ 360 - (tileHeight / 2) + ((fromIntegral row - pr + 1) -
           (fromIntegral col - pc + 1)) * (tileHeight / 2)
     fillColor ctx (case tile of
       Wall -> rgba 128 128 128 255
@@ -158,13 +161,22 @@ drawTile row col tile = do
       Elev -> rgba 0   0   0   255
       _    -> rgba 255 255 0   255
       )
-    moveTo ctx x y
-    lineTo ctx (x + realToFrac tileWidth / 2) (y + realToFrac tileHeight / 2)
-    lineTo ctx (x + realToFrac tileWidth) y
-    lineTo ctx (x + realToFrac tileWidth / 2) (y - realToFrac tileHeight / 2)
+    moveTo ctx x (y + realToFrac tileHeight / 2)
+    lineTo ctx (x + realToFrac tileWidth / 2) (y + realToFrac tileHeight)
+    lineTo ctx (x + realToFrac tileWidth) (y + realToFrac tileHeight / 2)
+    lineTo ctx (x + realToFrac tileWidth / 2) y
     closePath ctx
     fill ctx
-    when (floor pr + 1 == row && floor pc - 1 == col) $ do
+    when (tile == Wall) $ do
+      paint <- imagePattern
+        ctx x (y - (74 - realToFrac tileHeight)) 64 74 0
+        ((assetImages ud) Map.! ImgWall)
+        1
+      beginPath ctx
+      rect ctx x (y - (74 - realToFrac tileHeight)) 64 74
+      fillPaint ctx paint
+      fill ctx
+    when (floor pr == row && floor pc == col) $ do
       beginPath ctx
       circle ctx 640 360 5
       closePath ctx

src/Types/UserData.hs

@@ -37,7 +37,8 @@ data StateData
     }
 
 data ImgId
-  = ImgFloor
+  = ImgWall
+  deriving (Show, Eq, Ord)
 
 data Direction
   = N