101 lines
4.1 KiB
Haskell
101 lines
4.1 KiB
Haskell
module Dodge.Event.Test
|
|
( testEvent
|
|
)
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.Default
|
|
|
|
import Picture
|
|
import Geometry
|
|
|
|
import qualified Data.IntMap as IM
|
|
import Control.Lens
|
|
|
|
testEvent w = w
|
|
|
|
--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)])
|
|
-- ]
|
|
---- [(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)])
|
|
-- ]
|
|
---- [(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)])
|
|
-- ]
|
|
---- [(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
|