Cleanup

src/Dodge/LevelGen/DoorPane.hs

@@ -1,17 +1,10 @@
-module Dodge.LevelGen.DoorPane ( rectanglePairs) where
-import Geometry.Vector
-import Geometry.Data
+module Dodge.LevelGen.DoorPane (mkRectangle) where
 
-rectanglePairs :: Float -> Point2 -> Point2 -> [(Point2,Point2)]
-rectanglePairs wdth a b =
-    [ (aup, ad)
-    , (ad, bd)
-    , (bd, bu)
-    , (bu, aup)
-    ]
+import Geometry.Data
+import Geometry.Vector
+import Linear
+
+mkRectangle :: Float -> Point2 -> [ Point2]
+mkRectangle wdth b = [ n , - n , b - n , b + n ]
   where
-    aup = a +.+ norm
-    ad = a -.- norm
-    bu = b +.+ norm
-    bd = b -.- norm
-    norm = wdth *.* normalizeV ( vNormal (b -.- a))
+    n = wdth *^ normalizeV (vNormal b)

src/Dodge/Placement/PlaceSpot.hs

@@ -134,7 +134,7 @@ placeSpotID rid ps pt w = case pt of
     PutMachine pps mc mitm -> plMachine (map doShift pps) mc mitm p rot w
     PutLS ls -> plNewUpID (gwWorld . cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
     RandPS _ -> error "RandPS should not be reachable here" --evaluateRandPS rid rgn ps w
-    PutDoor dr wl -> plDoor' (dr & drZeroPos %~ pashift & drOnePos %~ pashift) wl w
+    PutDoor dr wl -> plDoor (dr & drZeroPos %~ pashift & drOnePos %~ pashift) wl w
     PutCoord cp -> plNewID (gwWorld . coordinates) (doShift cp) w
     PutBlock bl wl ps' ->
         plBlock

src/Dodge/Placement/PlaceSpot/TriggerDoor.hs

@@ -1,27 +1,20 @@
 module Dodge.Placement.PlaceSpot.TriggerDoor (
-    plDoor',
     plDoor,
-    plSlideDoor,
 ) where
 
 import Dodge.Door.DoorLerp
 import Dodge.Data.GenWorld
-import Dodge.Default.Door
-import Dodge.Default.Wall
-import Dodge.LevelGen.DoorPane
 import Dodge.Placement.PlaceSpot.Block
 import Dodge.ShiftPoint
-import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
-import Linear
 
-plDoor' ::
+plDoor ::
     Door ->
     Wall ->
     GenWorld ->
     (Int, GenWorld)
-plDoor' dr wl gw = 
+plDoor dr wl gw = 
     ( drid
     , over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors . at drid ?~ newdr
     -- carefull with the ordering of addWalls
@@ -42,78 +35,3 @@ plDoor' dr wl gw =
             (map fst pps & each %~ shiftPointBy lerposa)
             drid
             wlid
-
-plDoor ::
-    WdBl ->
-    Float ->
-    Point2A ->
-    Point2A ->
-    GenWorld ->
-    (Int, GenWorld)
-plDoor cond l p1 p2 gw =
-    ( drid
-    , over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors . at drid ?~ addDoor
-    -- carefull with the ordering of addWalls
-    )
-  where
-    isauto = case cond of
-        WdBlCrFilterNearPoint{} -> True
-        _ -> False
-    drid = IM.newKey $ _doors (_lWorld (_cWorld $ _gwWorld gw))
-    addDoor =
-        defaultDoor
-            { _drID = drid
-            , _drTrigger = cond
-            , _drUpdate = DoorLerp 0.01
-            , _drZeroPos = p1
-            , _drOnePos = p2
-            , _drLerp = 0
-            , _drFootPrint = IM.fromList . zip wlids $ wlps'
-            }
-    wlids = take 4 [wlid ..]
-    wlid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . walls
-    wlps' = rectanglePairs 9 0 (V2 l 0)
-    addWalls =
-        insertStructureWalls
-            (`DoorPart` isauto)
-            defaultDoorWall
-            (map fst wlps' & each %~ shiftPointBy p1)
-            drid
-            wlid
-
-plSlideDoor ::
-    Door ->
-    Wall ->
-    Float ->
-    Point2 ->
-    Point2 ->
-    GenWorld ->
-    (Int, GenWorld)
-plSlideDoor dr wl shiftOffset a b gw =
-    (drid, over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors %~ addDoor)
-  where
-    isauto = case dr ^. drTrigger of
-        WdBlCrFilterNearPoint{} -> True
-        _ -> False
-    drid = IM.newKey $ _doors (_lWorld (_cWorld $ _gwWorld gw))
-    addDoor =
-        IM.insert drid $
-            dr
-                { _drID = drid
-                , _drUpdate = DoorLerp $ 1 / distance a (shiftLeft a)
-                , _drZeroPos = (a, 0)
-                , _drOnePos = (shiftLeft a, 0)
-                , _drLerp = 0
-                , _drFootPrint = IM.fromList $ zip wlids $ rectanglePairs 9 0 (b - a)
-                }
-    pairs = rectanglePairs 9 a b
-    shiftLeft = (+.+ (a -.- b +.+ shiftOffset *.* normalizeV (b -.- a)))
-    wlids = take 4 [wlid ..]
-    wlid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . walls
-    addWalls =
-        insertStructureWalls
-            (`DoorPart` isauto)
-            wl
-            (map fst pairs)
-            drid
-            wlid

src/Dodge/Room/Airlock.hs

@@ -121,7 +121,7 @@ putDoor cond l p1 p2 = PutDoor dr wl
             & drZeroPos .~ p1
             & drOnePos .~ p2
             & drFootPrint .~ IM.fromList (zip [0 ..] wlps')
-    wlps' = rectanglePairs 9 0 (V2 l 0)
+    wlps' = loopPairs $ mkRectangle 9 (V2 l 0)
 
 airlockSimple :: RandomGen g => State g Room
 airlockSimple = do