Refactor doors

src/Dodge/LevelGen/MoveDoor.hs

@@ -1,13 +1,20 @@
 {-# LANGUAGE BangPatterns #-}
 module Dodge.LevelGen.MoveDoor
-    where
+    ( doorMechan
+    , zoneps
+    , moveDoorToward
+    , addSoundToDoor
+    ) where
 import Dodge.Data
 import Dodge.Base
 import Dodge.Base.Zone
+import Dodge.SoundLogic
+import Dodge.SoundLogic.Synonyms
 import Geometry
 
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
+
 -- This deserves a clean up
 mvP :: Point2 -> Point2 -> Point2
 {-# INLINE mvP #-}
@@ -22,9 +29,11 @@ moveDoorToward :: (Point2,Point2) -> Wall -> Wall
 moveDoorToward (ex,ey) wls = wls & wlLine %~ mvPs (ex,ey)
 
 zoneps :: (Point2, Point2) -> [(Int,Int)]
+{-# INLINE zoneps #-}
 zoneps (a,b)
-    | dist a b <= 2 * zoneSize = [zoneOfPoint $ pHalf a b]
-    | otherwise = map zoneOfPoint $ divideLine (2*zoneSize) a b
+    | dist a b <= 2 * zoneSize 
+                = [zoneOfPoint $ pHalf a b]
+    | otherwise = map zoneOfPoint $ divideLine zoneSize a b
 
 doorMechan 
     :: Int
@@ -35,15 +44,28 @@ doorMechan
     -> World 
     -> World
 doorMechan n zonePs openEff closeEff cond w
-    | cond w = flip (foldr $ changeZonedWall'' openEff n) zonePs
+    | cond w = flip (foldr $ changeZonedWall openEff n) zonePs
                 $ over walls (IM.adjust openEff n) w
-    | otherwise = flip (foldr $ changeZonedWall'' closeEff n) zonePs
+    | otherwise = flip (foldr $ changeZonedWall closeEff n) zonePs
                 $ over walls (IM.adjust closeEff n) w
 
-changeZonedWall''
+changeZonedWall
     :: (Wall -> Wall)
     -> Int
     -> (Int,Int)
     -> World
     -> World
-changeZonedWall'' eff n (x,y) = over wallsZone $ adjustIMZone eff x y n
+changeZonedWall eff n (x,y) = over wallsZone $ adjustIMZone eff x y n
+
+addSoundToDoor :: Int -> Point2 -> Point2 -> [Wall] -> [Wall]
+addSoundToDoor _ _   _   [] = error "When creating door tried to add sound to nothing"
+addSoundToDoor i pld hwd (x:ys) = f x : ys
+  where
+    f wl = over doorMech g wl
+      where
+        g dm w 
+            | dist wp pld > 2 && dist wp hwd > 2 
+                        = soundFrom (WallSound i) (fromIntegral doorSound) 1 0 $ dm w
+            | otherwise = dm w
+          where 
+            wp = snd $ _wlLine (_walls w IM.! i)