Abstract and unify door mechanisms

This commit is contained in:
jgk
2021-07-20 15:14:58 +02:00
parent 316a4141ab
commit ea739bd2cd
2 changed files with 4 additions and 35 deletions
+2 -11
View File
@@ -97,16 +97,7 @@ autoDoorPane (trigx,trigy) n closedPos openPos = Door
, _drPositions = DS.singleton closedPos
}
where
a = fst closedPos
b = snd closedPos
dm w
| any (crNearSeg 40 trigx trigy) $ IM.filter isAnimate $ _creatures w
= flip (foldr changeZonedWall) zoneps $ over walls (IM.adjust openDoor n) w
| otherwise
= flip (foldr changeZonedWall') zoneps $ over walls (IM.adjust closeDoor n) w
dm = doorMechan n (zoneps closedPos) openDoor closeDoor cond
cond = any (crNearSeg 40 trigx trigy) . IM.filter isAnimate . _creatures
openDoor = moveDoorToward openPos
closeDoor = moveDoorToward 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
+2 -24
View File
@@ -155,21 +155,9 @@ triggerDoorPaneLinear c cond n closedPos openPos = Door
, _drPositions = DS.singleton closedPos
}
where
a = fst closedPos
b = snd closedPos
dm w | cond w = flip (foldr changeZonedWall) zoneps
$ over walls (IM.adjust openDoor n) w -- . wlLine . ix 0) (mvPointToward a')
| otherwise = flip (foldr changeZonedWall') zoneps
$ over walls (IM.adjust closeDoor n) w -- . wlLine . ix 0) (mvPointToward a)
zoneps | dist a b <= 2 * zoneSize = [zoneOfPoint $ pHalf a b]
| otherwise = map zoneOfPoint $ divideLine (2*zoneSize) a b
dm = doorMechan n (zoneps closedPos) openDoor closeDoor cond
openDoor = moveDoorToward openPos
closeDoor = moveDoorToward closedPos
changeZonedWall (!x,!y)
= over wallsZone $ adjustIMZone openDoor x y n
changeZonedWall' (!x,!y)
= over wallsZone $ adjustIMZone closeDoor x y n
{- |
Zoning might be an issue here.
It is necessary in the current version, but I am not sure of its behaviour. -}
@@ -190,19 +178,9 @@ triggerDoorPane c cond n poss = Door
, _drPositions = DS.fromListL poss
}
where
dm w | cond w = flip (foldr changeZonedWall) allZoneps
$ over walls (IM.adjust openDoor n) w -- . wlLine . ix 0) (mvPointToward a')
| otherwise = flip (foldr changeZonedWall') allZoneps
$ over walls (IM.adjust closeDoor n) w -- . wlLine . ix 0) (mvPointToward a)
dm = doorMechan n allZoneps openDoor closeDoor cond
openDoor = updatePos . (drPositions %~ DS.pushL)
closeDoor = updatePos . (drPositions %~ DS.pushR)
updatePos :: Wall -> Wall
updatePos d = d & wlLine %~ maybe id const (DS.head <$> (d ^? drPositions))
changeZonedWall (!x,!y)
= over wallsZone $ adjustIMZone openDoor x y n
changeZonedWall' (!x,!y)
= over wallsZone $ adjustIMZone closeDoor x y n
allZoneps = nub $ concatMap zoneps poss
zoneps (a,b)
| dist a b <= 2 * zoneSize = [zoneOfPoint $ pHalf a b]
| otherwise = map zoneOfPoint $ divideLine (2*zoneSize) a b