Start to add mountable objects

2022-06-23 16:07:58 +01:00
parent 85406d06c1
commit e3d5c4eb4b
6 changed files with 31 additions and 11 deletions
@@ -35,8 +35,8 @@ postGenerationProcessing :: World -> World
 postGenerationProcessing w = foldl' assignPushDoors w (_doors w)

 assignPushDoors :: World -> Door -> World
-assignPushDoors w dr = case dr ^?! drSupport of
-    SupportedBy i -> w & doors . ix i . drPushes .~ Just (_drID dr)
+assignPushDoors w dr = case dr ^?! drPushedBy of
+    PushedBy i -> w & doors . ix i . drPushes ?~ _drID dr
    _ -> w

 layoutLevelFromSeed :: Int -> Int -> IO (IM.IntMap Room,[ConvexPoly])