Stop inanimate objects from opening walls
This commit is contained in:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user