remove world and add proper collision

src/Init.hs

@@ -39,14 +39,13 @@ load = do
   subs <- Subsystems
     <$> (Window <$> newTVarIO [])
     <*> (Mouse <$> newTVarIO [])
-  (ws, w) <- yieldSystemT (0, defWorld) (getWorld)
+  (ws, _) <- yieldSystemT (0, defWorld) (return ())
   return UserData
     { state       = Menu
     , subsystems  = subs
     , assetImages = M.empty -- FILLME!
     , nano        = nvg
     , uuid        = []
-    , world       = w
     , worldState  = ws
     , stateData   = None
     }

src/Test.hs

@@ -30,17 +30,15 @@ loadMap = do
   let fc = FloorConfig (20, 20) [(5,5), (45, 75)] (80,80)
       (Subsystems _ m) = subsystems ud
   matrix <- liftIO $ buildHallFloorIO fc
-  (nws, nworld) <- yieldSystemT (worldState ud) $ do
+  (nws, _) <- yieldSystemT (worldState ud) $ do
     void $ newEntity $ defEntity
       { pos = Just (V2 20 20)
       , vel = Just (V2 0 0)
       , player = Just True
       }
-    getWorld
   uu <- partSubscribe m movePlayer
   putAffection ud
-    { world = nworld
-    , worldState = nws
+    { worldState = nws
     , stateData = MenuData
       { mapMat = matrix
       , initCoords = (0, 500)
@@ -65,16 +63,14 @@ mouseToPlayer mv2 = do
   rela@(V2 rx ry) <- liftIO $ relativizeMouseCoords mv2
   let dr = (ry / sin (atan (1/2)) / 2) + rx
       dc = rx - (ry / sin (atan (1/2)) / 2)
-  (nws, nworld) <- yieldSystemT (worldState ud) $ do
+  (nws, _) <- yieldSystemT (worldState ud) $ do
     emap $ do
       with player
       pure $ defEntity'
         { vel = Set $ V2 dr dc
         }
-    getWorld
   putAffection ud
-    { world = nworld
-    , worldState = nws
+    { worldState = nws
     }
 
 movePlayer :: MouseMessage -> Affection UserData ()
@@ -83,16 +79,14 @@ movePlayer (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonLeft _ m) =
   mouseToPlayer m
 movePlayer (MsgMouseButton _ _ SDL.Released _ SDL.ButtonLeft _ m) = do
   ud <- getAffection
-  (nws, nw) <- yieldSystemT (worldState ud) $ do
+  (nws, _) <- yieldSystemT (worldState ud) $ do
     emap $ do
       with player
       pure $ defEntity'
         { vel = Set $ V2 0 0
         }
-    getWorld
   putAffection ud
-    { world = nw
-    , worldState = nws
+    { worldState = nws
     }
 movePlayer _ = return ()
 
@@ -106,18 +100,32 @@ drawMap = do
 updateMap :: Double -> Affection UserData ()
 updateMap dt = do
   ud <- getAffection
-  (nws, nw) <- yieldSystemT (worldState ud) $ do
+  let matrix = mapMat $ stateData ud
+  (nws, _) <- yieldSystemT (worldState ud) $ do
     emap $ do
-      with player
-      pos' <- E.get pos
+      with vel
+      with pos
+      pos'@(V2 or oc) <- E.get pos
       vel' <- E.get vel
-      pure $ defEntity'
-        { pos = Set $ pos' + fmap (* (4 * dt)) vel'
-        }
-    getWorld
+      let npos@(V2 nr nc) = pos' + fmap (* (4 * dt)) vel'
+      let ent
+            | Wall /= matrix M.! (floor nr, floor nc) =
+              defEntity'
+                { pos = Set npos
+                }
+            | Wall /= matrix M.! (floor nr, floor oc) =
+              defEntity'
+                { pos = Set (V2 nr oc)
+                }
+            | Wall /= matrix M.! (floor or, floor nc) =
+              defEntity'
+                { pos = Set (V2 or nc)
+                }
+            | otherwise =
+              defEntity'
+      pure ent
   putAffection ud
-    { world = nw
-    , worldState = nws
+    { worldState = nws
     }
 
 drawTile :: Int -> Int -> TileState -> Affection UserData ()
@@ -136,10 +144,10 @@ drawTile row col tile = do
   liftIO $ do
     save ctx
     beginPath ctx
-    let x = realToFrac $ (640 + tileWidth / 2) + ((fromIntegral col - pc) +
-          (fromIntegral row - pr)) * (tileWidth / 2)
-        y = realToFrac $ 360 + ((fromIntegral row - pr) -
-          (fromIntegral col - pc)) * (tileHeight / 2)
+    let x = realToFrac $ 640 + ((fromIntegral col - pc + 1) +
+          (fromIntegral row - pr + 1)) * (tileWidth / 2)
+        y = realToFrac $ 360 + ((fromIntegral row - pr + 1) -
+          (fromIntegral col - pc + 1)) * (tileHeight / 2)
     fillColor ctx (case tile of
       Wall -> rgba 128 128 128 255
       Door -> rgba 255 128 128 255
@@ -156,7 +164,7 @@ drawTile row col tile = do
     lineTo ctx (x + realToFrac tileWidth / 2) (y - realToFrac tileHeight / 2)
     closePath ctx
     fill ctx
-    when (floor pr + 1 == row && floor pc + 1 == col) $ do
+    when (floor pr + 1 == row && floor pc - 1 == col) $ do
       beginPath ctx
       circle ctx 640 360 5
       closePath ctx

src/Types/UserData.hs

@@ -21,7 +21,6 @@ data UserData = UserData
   , assetImages :: M.Map ImgId Image
   , nano        :: Context
   , uuid        :: [UUID]
-  , world       :: Entity 'WorldOf
   , worldState  :: SystemState Entity
   , stateData   :: StateData
   }