Refactor wall points from lists to pairs

2021-05-04 01:31:55 +02:00
parent e21178b688
commit 6d4c17fc07
23 changed files with 260 additions and 255 deletions
@@ -12,87 +12,89 @@ import Geometry
 import qualified Data.IntMap as IM
 import Control.Lens

-testEvent :: World -> World
-testEvent w = over walls (IM.union testWalls) w
-  where
-    k = newKey $ _walls w
-    setKeys = zipWith (\i wl -> wl & wlID .~ i) [k..]
+testEvent w = w

-    testWalls = IM.fromList $ zip [k..] $ setKeys (startWalls ++ errorWalls ++ (errorWall : polyWalls) ++ endWalls)
-
-    polyPairs = makeLoopPairs 
-        $ reverse [(-340.0,59.999996),(-374.64102,79.99999),(-340.0,100.0)]
--        [(4172.5835,2597.1892),(3855.1414,2597.1895),(3855.141,2324.7563),(4172.5835,2324.756)]
-    polyWalls = map (wallWithCol red . flat2) polyPairs
- 
-    errorWallPair = 
-        (9,[(-340.0,60.0),(-320.0,60.0)])
--        (48,[(3855.1414,2587.1892),(3855.141,2324.7563)])
-    errorWall = wallWithCol green $ snd errorWallPair
-
-    errorWallPairs = 
-        [(1,[(-400.0,59.999996),(-340.0,60.0)])
-        ,(12,[(-340.0,60.0),(-340.0,59.999996)])
-        ]
--        [(43,[(3855.1414,2598.1895),(3855.1414,2587.1892)])
--        ,(49,[(3855.1414,2597.1895),(3855.1414,2587.1892)])
+--testEvent :: World -> World
+--testEvent w = over walls (IM.union testWalls) w
+--  where
+--    k = newKey $ _walls w
+--    setKeys = zipWith (\i wl -> wl & wlID .~ i) [k..]
+--
+--    testWalls = IM.fromList $ zip [k..] $ setKeys (startWalls ++ errorWalls ++ (errorWall : polyWalls) ++ endWalls)
+--
+--    polyPairs = makeLoopPairs 
+--        $ reverse [(-340.0,59.999996),(-374.64102,79.99999),(-340.0,100.0)]
+----        [(4172.5835,2597.1892),(3855.1414,2597.1895),(3855.141,2324.7563),(4172.5835,2324.756)]
+--    polyWalls = map (wallWithCol red . flat2) polyPairs
+-- 
+--    errorWallPair = 
+--        (9,[(-340.0,60.0),(-320.0,60.0)])
+----        (48,[(3855.1414,2587.1892),(3855.141,2324.7563)])
+--    errorWall = wallWithCol green $ snd errorWallPair
+--
+--    errorWallPairs = 
+--        [(1,[(-400.0,59.999996),(-340.0,60.0)])
+--        ,(12,[(-340.0,60.0),(-340.0,59.999996)])
 --        ]
-    errorWalls = map (wallWithCol blue . snd) errorWallPairs
-    
-    startWallPairs = 
-        [(0,[(-320.0,60.0),(-320.0,100.0)])
-        ,(1,[(-400.0,59.999996),(-320.0,60.0)])
-        ,(2,[(-400.0,100.0),(-400.0,59.999996)])
-        ,(3,[(-320.0,100.0),(-400.0,100.0)])
-        ,(4,[(-260.0,60.0),(-225.35898,80.0)])
-        ,(5,[(-260.0,100.0),(-260.0,60.0)])
-        ,(6,[(-225.35898,80.0),(-260.0,100.0)])
-        ]
--        [(5,[(3875.1414,2761.8303),(3855.1414,2727.1892)])
--        ,(16,[(3895.1414,2727.1892),(3875.1414,2761.8303)])
--        ,(18,[(3855.1414,2727.1892),(3855.1414,2667.1892)])
--        ,(19,[(3875.1414,2552.548),(3895.1414,2587.1892)])
--        ,(32,[(3855.1414,2587.1892),(3875.1414,2552.548)])
--        ,(36,[(3895.1414,2667.1892),(3895.1414,2727.1892)])
--        ,(37,[(3895.1414,2587.1892),(3895.1414,2647.1892)])
--        ,(38,[(3855.1414,2647.1892),(3855.1414,2587.1892)])
--        ,(39,[(3855.1414,2667.1892),(3855.1414,2647.1892)])
--        ,(40,[(3895.1414,2647.1892),(3895.1414,2667.1892)])
+----        [(43,[(3855.1414,2598.1895),(3855.1414,2587.1892)])
+----        ,(49,[(3855.1414,2597.1895),(3855.1414,2587.1892)])
+----        ]
+--    errorWalls = map (wallWithCol blue . snd) errorWallPairs
+--    
+--    startWallPairs = 
+--        [(0,[(-320.0,60.0),(-320.0,100.0)])
+--        ,(1,[(-400.0,59.999996),(-320.0,60.0)])
+--        ,(2,[(-400.0,100.0),(-400.0,59.999996)])
+--        ,(3,[(-320.0,100.0),(-400.0,100.0)])
+--        ,(4,[(-260.0,60.0),(-225.35898,80.0)])
+--        ,(5,[(-260.0,100.0),(-260.0,60.0)])
+--        ,(6,[(-225.35898,80.0),(-260.0,100.0)])
 --        ]
-    startWalls = map (wallWithCol yellow . snd) startWallPairs
-    
-    endWalls = map (wallWithCol (withAlpha 0.2 orange) . snd) endWallPairs
-    endWallPairs = 
-        [(0,[(-320.0,60.0),(-320.0,100.0)])
-        ,(1,[(-400.0,59.999996),(-340.0,60.0)])
-        ,(2,[(-400.0,100.0),(-400.0,59.999996)])
-        ,(3,[(-320.0,100.0),(-340.0,100.0)])
-        ,(4,[(-260.0,60.0),(-225.35898,80.0)])
-        ,(5,[(-260.0,100.0),(-260.0,60.0)])
-        ,(6,[(-225.35898,80.0),(-260.0,100.0)])
-        ,(9,[(-340.0,60.0),(-320.0,60.0)])
-        ,(11,[(-340.0,100.0),(-400.0,100.0)])
-        ,(12,[(-340.0,60.0),(-340.0,59.999996)])
-        ]
--        [(5,[(3875.1414,2761.8303),(3855.1414,2727.1892)])
--        ,(16,[(3895.1414,2727.1892),(3875.1414,2761.8303)])
--        ,(18,[(3855.1414,2727.1892),(3855.1414,2667.1892)])
--        ,(36,[(3895.1414,2667.1892),(3895.1414,2727.1892)])
--        ,(38,[(3855.1414,2647.1892),(3855.1414,2598.1895)])
--        ,(39,[(3855.1414,2667.1892),(3855.1414,2647.1892)])
--        ,(40,[(3895.1414,2647.1892),(3895.1414,2667.1892)])
--        ,(43,[(3855.1414,2598.1895),(3855.1414,2587.1892)])
--        ,(45,[(3895.1414,2597.1895),(3895.1414,2647.1892)])
--        ,(46,[(4172.5835,2324.756),(4172.5835,2597.1892)])
--        ,(47,[(3855.141,2324.7563),(4172.5835,2324.756)])
--        ,(48,[(3855.1414,2587.1892),(3855.141,2324.7563)])
--        ,(49,[(3855.1414,2597.1895),(3855.1414,2587.1892)])
--        ,(50,[(3855.1414,2598.1895),(3855.1414,2597.1895)])
--        ,(51,[(4172.5835,2597.1892),(3895.1414,2597.1895)])
+----        [(5,[(3875.1414,2761.8303),(3855.1414,2727.1892)])
+----        ,(16,[(3895.1414,2727.1892),(3875.1414,2761.8303)])
+----        ,(18,[(3855.1414,2727.1892),(3855.1414,2667.1892)])
+----        ,(19,[(3875.1414,2552.548),(3895.1414,2587.1892)])
+----        ,(32,[(3855.1414,2587.1892),(3875.1414,2552.548)])
+----        ,(36,[(3895.1414,2667.1892),(3895.1414,2727.1892)])
+----        ,(37,[(3895.1414,2587.1892),(3895.1414,2647.1892)])
+----        ,(38,[(3855.1414,2647.1892),(3855.1414,2587.1892)])
+----        ,(39,[(3855.1414,2667.1892),(3855.1414,2647.1892)])
+----        ,(40,[(3895.1414,2647.1892),(3895.1414,2667.1892)])
+----        ]
+--    startWalls = map (wallWithCol yellow . snd) startWallPairs
+--    
+--    endWalls = map (wallWithCol (withAlpha 0.2 orange) . snd) endWallPairs
+--    endWallPairs = 
+--        [(0,[(-320.0,60.0),(-320.0,100.0)])
+--        ,(1,[(-400.0,59.999996),(-340.0,60.0)])
+--        ,(2,[(-400.0,100.0),(-400.0,59.999996)])
+--        ,(3,[(-320.0,100.0),(-340.0,100.0)])
+--        ,(4,[(-260.0,60.0),(-225.35898,80.0)])
+--        ,(5,[(-260.0,100.0),(-260.0,60.0)])
+--        ,(6,[(-225.35898,80.0),(-260.0,100.0)])
+--        ,(9,[(-340.0,60.0),(-320.0,60.0)])
+--        ,(11,[(-340.0,100.0),(-400.0,100.0)])
+--        ,(12,[(-340.0,60.0),(-340.0,59.999996)])
 --        ]
-
--flat2 :: (a,a) -> [a]
--flat2 (x,y) = [x,y]
-
-wallWithCol :: Color -> [Point2] -> Wall
-wallWithCol col ps = defaultWall & wlLine .~ ps & wlColor .~ col & wlSeen .~ True
+----        [(5,[(3875.1414,2761.8303),(3855.1414,2727.1892)])
+----        ,(16,[(3895.1414,2727.1892),(3875.1414,2761.8303)])
+----        ,(18,[(3855.1414,2727.1892),(3855.1414,2667.1892)])
+----        ,(36,[(3895.1414,2667.1892),(3895.1414,2727.1892)])
+----        ,(38,[(3855.1414,2647.1892),(3855.1414,2598.1895)])
+----        ,(39,[(3855.1414,2667.1892),(3855.1414,2647.1892)])
+----        ,(40,[(3895.1414,2647.1892),(3895.1414,2667.1892)])
+----        ,(43,[(3855.1414,2598.1895),(3855.1414,2587.1892)])
+----        ,(45,[(3895.1414,2597.1895),(3895.1414,2647.1892)])
+----        ,(46,[(4172.5835,2324.756),(4172.5835,2597.1892)])
+----        ,(47,[(3855.141,2324.7563),(4172.5835,2324.756)])
+----        ,(48,[(3855.1414,2587.1892),(3855.141,2324.7563)])
+----        ,(49,[(3855.1414,2597.1895),(3855.1414,2587.1892)])
+----        ,(50,[(3855.1414,2598.1895),(3855.1414,2597.1895)])
+----        ,(51,[(4172.5835,2597.1892),(3895.1414,2597.1895)])
+----        ]
+--
+----flat2 :: (a,a) -> [a]
+----flat2 (x,y) = [x,y]
+--
+--wallWithCol :: Color -> (Point2,Point2) -> Wall
+--wallWithCol col ps = defaultWall & wlLine .~ ps & wlColor .~ col & wlSeen .~ True