Tweak switch doors

src/Dodge/LevelGen/TriggerDoor.hs

@@ -67,45 +67,40 @@ triggerDoor c cond a b wls = IM.union wls $ IM.fromList $ zip is $ mkTriggerDoor
 
 mkTriggerDoor :: Color -> (World -> Bool) -> Point2 -> Point2 -> [Int] -> [Wall]
 mkTriggerDoor c cond pl pr xs = addSound $ zipWith3 (triggerDoorPane c cond)
-                               xs
-                               [ [pld,hwd,hw,pl]
-                               , [hwd,hwu]
-                               , [hwu,plu,pl,hw]
-                               , [plu,pld]
-                               , [pru,hwu,hw,pr]
-                               , [hwu,hwd]
-                               , [hwd,prd,pr,hw]
-                               , [prd,pru]
-                               ]
-                               [ [plld,pld,pl,pl]
-                               , [pld,plu]
-                               , [plu,pllu,pl,pl]
-                               , [pllu,plld]
-                               , [prru,pru,pr,pr]
-                               , [pru,prd]
-                               , [prd,prrd,pr,pr]
-                               , [prrd,prru]
-                               ]
-    where norm = 14 *.* errorNormalizeV 49 ( vNormal (pr -.- pl))
-          hw = 0.5 *.* (pl +.+ pr)
-          perp = 20 *.* normalizeV (pl -.- pr)
-          --perp = pl -.- hw
-          plu = pl +.+ norm
-          pld = pl -.- norm
-          pru = pr +.+ norm
-          prd = pr -.- norm
-          hwu = hw +.+ norm
-          hwd = hw -.- norm
-          pllu = plu +.+ perp
-          plld = pld +.+ perp
-          prru = pru -.- perp
-          prrd = prd -.- perp
-          addSound (x:xs) = f x : xs
-          f wl = over doorMech g wl
-          g dm w | dist wp pld > 2 && dist wp hwd > 2 = soundFrom (WallSound (head xs)) (fromIntegral doorSound) 1 0
+    xs
+    (leftDoor ++ rightDoor)
+    (map shiftLeft leftDoor ++ map shiftRight rightDoor)
+  where 
+    leftDoor = 
+        [ [pld +.+ perp,hwd]
+        , [hwd,         hwu]
+        , [hwu,         plu +.+ perp]
+        , [plu +.+ perp,pld +.+ perp]
+        ]
+    rightDoor =
+        [ [pru -.- perp,hwu]
+        , [hwu,         hwd]
+        , [hwd,         prd -.- perp]
+        , [prd -.- perp,pru -.- perp]
+        ]
+    shiftRight = map (+.+ (0.5 *.* (pr -.- pl)))
+    shiftLeft = map (+.+ (0.5 *.* (pl -.- pr)))
+    norm = 14 *.* errorNormalizeV 49 ( vNormal (pr -.- pl))
+    hw = 0.5 *.* (pl +.+ pr)
+    perp = 5 *.* normalizeV (pl -.- pr)
+    plu = pl +.+ norm
+    pld = pl -.- norm
+    pru = pr +.+ norm
+    prd = pr -.- norm
+    hwu = hw +.+ norm
+    hwd = hw -.- norm
+    addSound (x:xs) = f x : xs
+    f wl = over doorMech g wl
+    g dm w | dist wp pld > 2 && dist wp hwd > 2 
+                    = soundFrom (WallSound (head xs)) (fromIntegral doorSound) 1 0
                                                                     $ dm w
-                 | otherwise = dm w
-            where wp = (_wlLine $ _walls w IM.! (head xs)) !! 1
+            | otherwise = dm w
+      where wp = (_wlLine $ _walls w IM.! (head xs)) !! 1
 
 triggerDoorPane :: Color -> (World -> Bool) -> Int -> [Point2] -> [Point2] -> Wall
 triggerDoorPane c cond n closedPos openPos = Door