copiers are placed properly

src/MainGame/WorldMap.hs

@@ -85,7 +85,7 @@ loadMapFork ud future progress = do
   _ <- liftIO $ swapMVar progress (11 / loadSteps, "Converting to images")
   let imgmat = convertTileToImg mat
       exits = Prelude.foldl
-        (\acc coord@(r, c) -> if imgmat M.! coord == Just (ImgEmpty [])
+        (\acc coord@(r, c) -> if imgmat M.! coord == Just ImgEmpty
           then ReachPoint RoomExit (V2 r c) NE : acc
           else acc
           )
@@ -156,7 +156,9 @@ loadMapFork ud future progress = do
       { mapMat = mat
       , imgMat = M.fromList (nrows inter) (ncols inter) $
         Prelude.map
-          (\a -> if a == Just (ImgEmpty []) then Nothing else a)
+          (\a -> if a == Just ImgEmpty || a == Just ImgEmptyNoWalk
+            then Nothing
+            else a)
           (M.toList inter)
       , reachPoints = rps
       , mmImgMat = mmimgmat
@@ -297,15 +299,15 @@ drawTile ud ctx posanims pr pc row col img =
         mapM_ drawAnim beh
         maybe (return ()) (draw ud x (y - 42) 64 74 fact)
           ((assetImages ud Map.!) <$> case img of
-            Just (ImgEmpty _) -> Nothing
+            Just ImgEmpty -> Nothing
             _ -> img
             )
         mapM_ drawAnim bef
         restore ctx
-        when (floor pr == row && floor pc == col) $ do
+        -- when (floor pr == row && floor pc == col) $ do
-          A.logIO A.Debug ("sorted: " ++ show sorted)
+        --   A.logIO A.Debug ("sorted: " ++ show sorted)
-          A.logIO A.Debug ("beh: " ++ show beh)
+        --   A.logIO A.Debug ("beh: " ++ show beh)
-          A.logIO A.Debug ("bef: " ++ show bef)
+        --   A.logIO A.Debug ("bef: " ++ show bef)
   where
     delimiter (V2 nr nc, _, mbnds) =
       all delimit mb
@@ -328,7 +330,7 @@ drawTile ud ctx posanims pr pc row col img =
     tileWidth = 64 :: Double
     tileHeight = 32 :: Double
     sorted = sortOn (\(V2 sr sc, _, mbnds) -> case mbnds of
-      Just (Boundaries (minr, minc) (maxr, maxc)) -> minr * 10 + (1 - minc)
+      Just (Boundaries (minr, minc) (maxr, maxc)) -> maxr * 10 + (1 - minc)
       _ -> (sr - (fromIntegral ((floor sr) :: Int))) * 10 +
         (1 - (sc - (fromIntegral ((floor sc) :: Int))))
       ) posanims
@@ -456,6 +458,12 @@ updateMap dt = do
               , anim = Set nstat
               }
         return ent
+      obstacleBounds <- efor allEnts $ do
+        with obstacle
+        with pos
+        b <- query obstacle
+        pos' <- query pos
+        return (pos', b)
       emap allEnts $ do
         with player
         with vel
@@ -517,10 +525,17 @@ updateMap dt = do
               (
                 concatMap
                 (\(dr, dc) ->
-                  let bs = maybe [] collisionObstacle (fromMaybe Nothing $ M.safeGet
+                  let bs = (++)
-                        (fromIntegral $ floor pr + dr)
+                        (maybe [] collisionObstacle (fromMaybe Nothing $ M.safeGet
-                        (fromIntegral $ floor pc + dc)
+                          (fromIntegral $ floor pr + dr)
-                        (imgMat (stateData ud)))
+                          (fromIntegral $ floor pc + dc)
+                          (imgMat (stateData ud))))
+                        (Prelude.map snd $ Prelude.filter
+                          (\((V2 br bc), _) ->
+                            floor pr + dr == floor br &&
+                            floor pc + dc == floor bc
+                            )
+                          obstacleBounds)
                   in  Prelude.map (\(Boundaries (minr, minc) (maxr, maxc))->
                         Boundaries
                           (minr + fromIntegral dr, minc + fromIntegral dc)

src/Types/Collidible.hs

@@ -76,5 +76,6 @@ instance Collidible ImgId where
     [ Boundaries (0, 0) (0.63, 1)
     , Boundaries (0, 0.34) (1, 1)
     ]
-  collisionObstacle (ImgEmpty b) = b
+  collisionObstacle ImgEmptyNoWalk =
+    [ Boundaries (0, 0) (1, 1) ]
   collisionObstacle _ = []

src/Types/ImgId.hs

@@ -3,7 +3,8 @@ module Types.ImgId where
 import Types.Map
 
 data ImgId
-  = ImgEmpty [Boundaries Double] -- TODO: Find better solution than empty image.
+  = ImgEmpty -- TODO: Find better solution than empty image.
+  | ImgEmptyNoWalk
   | ImgWallAsc
   | ImgWallDesc
   | ImgWallCornerN
@@ -29,7 +30,7 @@ data ImgId
   -- | ImgIntrW
   -- | ImgIntrNW
   -- | ImgIntrN
-  deriving (Show, Eq, Ord)
+  deriving (Show, Eq, Ord, Enum)
 
 isWall :: ImgId -> Bool
 isWall ImgMiscBox1 = False

src/Types/Interior.hs

@@ -31,47 +31,47 @@ clusterMat ClusterBox1 =
     ]
 clusterMat ClusterTable1 =
   M.fromLists
-    [[Just (ImgEmpty []), Just ImgMiscTable1]]
+    [[Just ImgEmpty, Just ImgMiscTable1]]
 clusterMat ClusterTable2 =
   M.fromLists
     [ [Just ImgMiscTable2]
-    , [Just (ImgEmpty [])]
+    , [Just ImgEmpty]
     ]
 clusterMat ClusterTable3 =
   M.fromLists
-    [[Just ImgMiscTable3, Just (ImgEmpty [])]]
+    [[Just ImgMiscTable3, Just ImgEmpty]]
 clusterMat ClusterTable4 =
   M.fromLists
-    [ [Just (ImgEmpty [])]
+    [ [Just ImgEmpty]
     , [Just ImgMiscTable4]
     ]
 clusterMat ClusterCornerTable =
   M.fromLists
     [ [Just ImgMiscTable2, Just ImgMiscTableCorner]
-    , [Just (ImgEmpty []), Just ImgMiscTable1]
+    , [Just ImgEmpty, Just ImgMiscTable1]
     ]
 clusterMat ClusterTableGroup =
   M.fromLists
-    [ [ Just (ImgEmpty []), Just ImgMiscTable2, Just ImgMiscTableCorner
+    [ [ Just ImgEmpty, Just ImgMiscTable2, Just ImgMiscTableCorner
-      , Just (ImgEmpty []), Just ImgMiscTable2, Just ImgMiscTableCorner
+      , Just ImgEmpty, Just ImgMiscTable2, Just ImgMiscTableCorner
       ]
-    , [ Just (ImgEmpty []), Just (ImgEmpty []), Just ImgMiscTable1
+    , [ Just ImgEmpty, Just ImgEmpty, Just ImgMiscTable1
-      , Just (ImgEmpty []), Just (ImgEmpty []), Just ImgMiscTable1
+      , Just ImgEmpty, Just ImgEmpty, Just ImgMiscTable1
       ]
-    , [ Just (ImgEmpty []), Just (ImgEmpty []), Just (ImgEmpty [])
+    , [ Just ImgEmpty, Just ImgEmpty, Just ImgEmpty
-      , Just (ImgEmpty []), Just (ImgEmpty []), Just (ImgEmpty [])
+      , Just ImgEmpty, Just ImgEmpty, Just ImgEmpty
       ]
     , [ Nothing, Nothing, Nothing
-      , Just (ImgEmpty []), Just ImgMiscTable2, Just ImgMiscTableCorner
+      , Just ImgEmpty, Just ImgMiscTable2, Just ImgMiscTableCorner
       ]
     , [ Nothing, Nothing, Nothing
-      , Just (ImgEmpty []), Just (ImgEmpty []), Just ImgMiscTable1
+      , Just ImgEmpty, Just ImgEmpty, Just ImgMiscTable1
       ]
     ]
 clusterMat ClusterCopier =
   M.fromLists
-    [ [ Just (ImgEmpty [Boundaries (10/36, 8/36) (28/36, 30/36)])]
+    [ [ Just ImgEmptyNoWalk]
-    , [ Just (ImgEmpty [])]
+    , [ Just ImgEmpty]
     ]
 
 clusterRoom :: Cluster -> TileState

src/Util.hs

@@ -100,7 +100,7 @@ convertTileToImg mat = fromLists conversion
           | any
             (\(rr, cc) -> M.safeGet (irow + rr) (icol + cc) mat == Just Door)
             [(1, 0), (-1, 0), (0, 1), (0, -1)] ->
-            Just (ImgEmpty [])
+            Just ImgEmpty
           | otherwise ->
             Nothing
         _ ->