Stop inanimate objects from opening walls

This commit is contained in:
jgk
2021-03-29 13:36:03 +02:00
parent 502832b2b8
commit a4afe05478
8 changed files with 76 additions and 59 deletions
+27 -24
View File
@@ -5,6 +5,8 @@ import Dodge.Data
import Dodge.Base
import Dodge.SoundLogic
import Dodge.Creature.Property
import Geometry
import Picture
@@ -24,7 +26,7 @@ autoDoorAt a b wls = IM.union wls $ IM.fromList $ zip is $ mkAutoDoor a b is
is = [i..]
mkAutoDoor :: Point2 -> Point2 -> [Int] -> [Wall]
mkAutoDoor pl pr xs = addSound $ zipWith3 (autoDoorPane [pl,pr])
mkAutoDoor pl pr xs = addSound $ zipWith3 (autoDoorPane (pl,pr))
xs
(lDoorClosed ++ rDoorClosed)
(map shiftL lDoorClosed ++ map shiftR rDoorClosed)
@@ -55,8 +57,8 @@ mkAutoDoor pl pr xs = addSound $ zipWith3 (autoDoorPane [pl,pr])
| otherwise = dm w
where wp = (_wlLine $ _walls w IM.! (head xs)) !! 1
autoDoorPane :: [Point2] -> Int -> [Point2] -> [Point2] -> Wall
autoDoorPane trigL n closedPos openPos = Door
autoDoorPane :: (Point2,Point2) -> Int -> [Point2] -> [Point2] -> Wall
autoDoorPane (trigx,trigy) n closedPos openPos = Door
{ _wlLine = closedPos
, _wlID = n
, _doorMech = dm
@@ -66,24 +68,25 @@ autoDoorPane trigL n closedPos openPos = Door
, _wlIsSeeThrough = False
, _doorPathable = True
}
where
a = closedPos !! 0
b = closedPos !! 1
dm w | crsNearLine 40 trigL w
= flip (foldr changeZonedWall) zoneps
$ over walls (IM.adjust openDoor n) w
| otherwise = flip (foldr changeZonedWall') zoneps
$ over walls (IM.adjust closeDoor n) w
mvP !ep !p = mvPointTowardAtSpeed 2 ep p
moveToward :: [Point2] -> Wall -> Wall
moveToward !ps w = let !newPs = zipWith mvP ps $ _wlLine w
in deepseq newPs $ w {_wlLine = newPs}
--deepseq ps $ w & wlLine %~ zipWith mvP ps
openDoor = moveToward openPos
closeDoor = moveToward closedPos
zoneps | dist a b <= 2 * zoneSize = [zoneOfPoint $ pHalf a b]
| otherwise = map zoneOfPoint $ divideLine (2*zoneSize) a b
changeZonedWall (!x,!y)
= over wallsZone $ adjustIMZone openDoor x y n
changeZonedWall' (!x,!y)
= over wallsZone $ adjustIMZone closeDoor x y n
where
a = closedPos !! 0
b = closedPos !! 1
dm w | any (crNearSeg 40 trigx trigy) $ IM.filter (_crIsAnimate) $ _creatures w
-- crsNearLine 40 trigL w
= flip (foldr changeZonedWall) zoneps
$ over walls (IM.adjust openDoor n) w
| otherwise = flip (foldr changeZonedWall') zoneps
$ over walls (IM.adjust closeDoor n) w
mvP !ep !p = mvPointTowardAtSpeed 2 ep p
moveToward :: [Point2] -> Wall -> Wall
moveToward !ps w = let !newPs = zipWith mvP ps $ _wlLine w
in deepseq newPs $ w {_wlLine = newPs}
--deepseq ps $ w & wlLine %~ zipWith mvP ps
openDoor = moveToward openPos
closeDoor = moveToward closedPos
zoneps | dist a b <= 2 * zoneSize = [zoneOfPoint $ pHalf a b]
| otherwise = map zoneOfPoint $ divideLine (2*zoneSize) a b
changeZonedWall (!x,!y)
= over wallsZone $ adjustIMZone openDoor x y n
changeZonedWall' (!x,!y)
= over wallsZone $ adjustIMZone closeDoor x y n