Refactor wall points from lists to pairs

src/Dodge/LevelGen/TriggerDoor.hs

@@ -87,12 +87,12 @@ mkTriggerDoor
 mkTriggerDoor c cond ppairs is = zipWith (triggerDoorPane c cond) is $
     transpose $ map toPanePoints ppairs
 
-toPanePoints :: (Point2,Point2) -> [[Point2]]
+toPanePoints :: (Point2,Point2) -> [(Point2,Point2)]
 toPanePoints (x,y) = 
-    [ [y +.+ perp, y -.- perp]
-    , [y -.- perp, x -.- perp]
-    , [x -.- perp, x +.+ perp]
-    , [x +.+ perp, y +.+ perp]
+    [ (y +.+ perp, y -.- perp)
+    , (y -.- perp, x -.- perp)
+    , (x -.- perp, x +.+ perp)
+    , (x +.+ perp, y +.+ perp)
     ]
   where
     perp = 9 *.* errorNormalizeV 49 ( vNormal (x -.- y))
@@ -104,19 +104,20 @@ mkTriggerDoubleDoor c cond pl pr xs = addSound $ zipWith3 (triggerDoorPaneLinear
     (map shiftLeft leftDoor ++ map shiftRight rightDoor)
   where 
     leftDoor = 
-        [ [pld +.+ perp,hwd]
-        , [hwd,         hwu]
-        , [hwu,         plu +.+ perp]
-        , [plu +.+ perp,pld +.+ perp]
+        [ (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]
+        [ (pru -.- perp,hwu)
+        , (hwu,         hwd)
+        , (hwd,         prd -.- perp)
+        , (prd -.- perp,pru -.- perp)
         ]
-    shiftRight = map (+.+ (0.5 *.* (pr -.- pl)))
-    shiftLeft = map (+.+ (0.5 *.* (pl -.- pr)))
+    shiftRight = h (+.+ (0.5 *.* (pr -.- pl)))
+    shiftLeft = h (+.+ (0.5 *.* (pl -.- pr)))
+    h func (x,y) = (func x,func y)
     norm = 9 *.* errorNormalizeV 49 ( vNormal (pr -.- pl))
     hw = 0.5 *.* (pl +.+ pr)
     perp = 5 *.* normalizeV (pl -.- pr)
@@ -133,14 +134,14 @@ mkTriggerDoubleDoor c cond pl pr xs = addSound $ zipWith3 (triggerDoorPaneLinear
                     = soundFrom (WallSound (head xs)) (fromIntegral doorSound) 1 0 $ dm w
         | otherwise = dm w
       where 
-        wp = _wlLine (_walls w IM.! head xs) !! 1
+        wp = snd $ _wlLine (_walls w IM.! head xs)
 
 triggerDoorPaneLinear
     :: Color 
     -> (World -> Bool)  -- ^ Opening condition
     -> Int              -- ^ Wall id
-    -> [Point2]         -- ^ Closed position
-    -> [Point2]         -- ^ Open position
+    -> (Point2,Point2)         -- ^ Closed position
+    -> (Point2,Point2)         -- ^ Open position
     -> Wall
 triggerDoorPaneLinear c cond n closedPos openPos = Door
     { _wlLine = closedPos
@@ -153,8 +154,8 @@ triggerDoorPaneLinear c cond n closedPos openPos = Door
     , _drPositions = DS.singleton closedPos
     }
   where 
-    a = closedPos !! 0
-    b = closedPos !! 1
+    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
@@ -162,9 +163,9 @@ triggerDoorPaneLinear c cond n closedPos openPos = Door
     zoneps | dist a b <= 2 * zoneSize = [zoneOfPoint $ pHalf a b]
            | otherwise = map zoneOfPoint $ divideLine (2*zoneSize) a b
     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}
+    mvPs (ex,ey) (sx,sy) = (mvP ex sx,mvP ey sy)
+    moveToward :: (Point2,Point2) -> Wall -> Wall
+    moveToward (ex,ey) wls = wls & wlLine %~ mvPs (ex,ey)
     openDoor = moveToward openPos
     closeDoor = moveToward closedPos
     changeZonedWall (!x,!y) 
@@ -179,7 +180,7 @@ triggerDoorPane
     :: Color 
     -> (World -> Bool)  -- ^ Opening condition
     -> Int              -- ^ Wall id
-    -> [[Point2]]       -- ^ List of positions: closed to open
+    -> [(Point2,Point2)]       -- ^ List of positions: closed to open
     -> Wall
 triggerDoorPane c cond n poss = Door
     { _wlLine = head poss
@@ -205,6 +206,6 @@ triggerDoorPane c cond n poss = Door
     changeZonedWall' (!x,!y) 
           = over wallsZone $ adjustIMZone closeDoor x y n
     allZoneps = nub $ concatMap zoneps poss
-    zoneps [a,b]
+    zoneps (a,b)
         | dist a b <= 2 * zoneSize = [zoneOfPoint $ pHalf a b]
         | otherwise = map zoneOfPoint $ divideLine (2*zoneSize) a b