From ea739bd2cdeddcdda32732ab4c7d3e686bac5e24 Mon Sep 17 00:00:00 2001
From: jgk <justin.g.kruger@gmail.com>
Date: Tue, 20 Jul 2021 15:14:58 +0200
Subject: [PATCH] Abstract and unify door mechanisms

---
 src/Dodge/LevelGen/AutoDoor.hs    | 13 ++-----------
 src/Dodge/LevelGen/TriggerDoor.hs | 26 ++------------------------
 2 files changed, 4 insertions(+), 35 deletions(-)

diff --git a/src/Dodge/LevelGen/AutoDoor.hs b/src/Dodge/LevelGen/AutoDoor.hs
index 455ce60f9..c3e692bcc 100644
--- a/src/Dodge/LevelGen/AutoDoor.hs
+++ b/src/Dodge/LevelGen/AutoDoor.hs
@@ -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
diff --git a/src/Dodge/LevelGen/TriggerDoor.hs b/src/Dodge/LevelGen/TriggerDoor.hs
index a10fc9ddf..911e0d6e4 100644
--- a/src/Dodge/LevelGen/TriggerDoor.hs
+++ b/src/Dodge/LevelGen/TriggerDoor.hs
@@ -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