Split autodoor module

src/Dodge/LevelGen.hs

@@ -14,17 +14,17 @@ import Dodge.Data
 import Dodge.Base
 import Dodge.SoundLogic
 import Dodge.Prototypes
+
 import Dodge.LevelGen.Block
 import Dodge.LevelGen.Pathing
-
 import Dodge.LevelGen.StaticWalls
+import Dodge.LevelGen.AutoDoor
 
 import Geometry
 import Picture
 
 import System.Random
 
-import Control.DeepSeq (deepseq)
 
 import Control.Monad.State
 import Data.List
@@ -293,9 +293,6 @@ triggerDoorPane c cond n [a,b] [a',b'] = Door
         changeZonedWall' (!x,!y) 
               = over wallsZone $ adjustIMZone closeDoor x y n
 
-addAutoDoor :: Point2 -> Point2 -> World -> World
-addAutoDoor a b = over walls (autoDoorAt a b)
-
 putWindowBlock :: Point2 -> Point2 -> World -> World
 putWindowBlock a b w = removePathsCrossing a b $ foldr makeBlockAt w $ zip ps ns
     where d = dist a b
@@ -363,113 +360,7 @@ putWindowBlock a b w = removePathsCrossing a b $ foldr makeBlockAt w $ zip ps ns
                 f = IM.insert k0 l . IM.insert k1 t . IM.insert k2 r . IM.insert k3 b
             in  over walls f w
                                     
-autoDoorAt :: Point2 -> Point2 -> IM.IntMap Wall -> IM.IntMap Wall
-autoDoorAt a b wls = IM.union wls $ IM.fromList $ zip is $ mkAutoDoor a b is
-    where i = newKey wls
-          is = [i..]
 
-mkAutoDoor :: Point2 -> Point2 -> [Int] -> [Wall]
-mkAutoDoor pl pr xs = addSound $ zipWith4 (autoDoorPane [pl,pr])
-                               xs
-                               [ True
-                               , False
-                               , True
-                               , True
-                               , False
-                               , True
-                               ]
-                               [ [pld,hwd,hw,pl]
-                               , [hwd,hwu]
-                               , [hwu,plu,pl,hw]
-                               , [pru,hwu,hw,pr]
-                               , [hwu,hwd]
-                               , [hwd,prd,pr,hw]
-                               ]
-                               [ [plld,pld,pl,pl]
-                               , [pld,plu]
-                               , [plu,pllu,pl,pl]
-                               , [prru,pru,pr,pr]
-                               , [pru,prd]
-                               , [prd,prrd,pr,pr]
-                               ]
-    where norm = 15.1 *.* errorNormalizeV 49 ( vNormal (pr -.- pl))
-                    -- .1 hack, there was flickering
-          hw = 0.5 *.* (pl +.+ pr)
-          parallel = 20 *.* normalizeV (pl -.- pr)
-          plu = pl +.+ norm
-          pld = pl -.- norm
-          pru = pr +.+ norm
-          prd = pr -.- norm
-          hwu = hw +.+ norm
-          hwd = hw -.- norm
-          pllu = plu +.+ parallel
-          plld = pld +.+ parallel
-          prru = pru -.- parallel
-          prrd = prd -.- parallel
-          addSound (x:xs) = f x : xs
-          f wl = over doorMech g wl
-          g dm w | dist wp pld > 1 && dist wp hwd > 1 = soundFrom (WallSound (head xs)) (fromIntegral doorSound) 1 0 
-                                                                    $ dm w
-                 | otherwise = dm w
-            where wp = (_wlLine $ _walls w IM.! (head xs)) !! 1
-
-mvPointTowardAtSpeed :: Float -> Point2 -> Point2 -> Point2
-mvPointTowardAtSpeed speed !ep !p 
-    | dist p ep < speed = ep
-    | otherwise         = p +.+ speed *.* normalizeV (ep -.- p)
-
-mvPointToward :: Point2 -> Point2 -> Point2
-mvPointToward !ep !p | dist p ep < 1 = ep
-                     | otherwise     = p +.+ normalizeV (ep -.- p)
-
-drawAutoDoor :: Wall -> Drawing
-drawAutoDoor wl = onLayerL [levLayer WlLayer, layer2] 
-        $ pictures [color c $ polygon [x,x +.+ n2,y +.+ n2, y]
-                   ,color (dark c) $ line [x,y]
-                   ]
-    where 
-        (x:y:_) = _wlLine wl
-        c = _wlColor wl
-        nm = errorNormalizeV 543 (y -.- x)
-        t = 5 *.* nm
-        n = vNormal t
-        n2 = 3 *.* n
-        layer2 | _wlIsSeeThrough wl = 0
-               | isJust $ wl ^? doorMech = 1
-               | otherwise = 2
-
-autoDoorPane :: [Point2] -> Int -> Bool -> [Point2] -> [Point2] -> Wall
-autoDoorPane trigL n castShad closedPos openPos = AutoDoor
-    { _wlLine = closedPos
-    , _wlID = n
-    , _doorMech = dm
-    , _wlColor = dim $ yellow
-    , _wlDraw = Nothing
-    , _wlSeen = False
-    , _wlIsSeeThrough = False
-    , _wlCastShadow = castShad
-    }
-    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
 
 shiftPointBy (pos,rot) p = pos +.+ rotateV rot p