justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Merge branch 'master' into testing

Browse Source
This commit is contained in:
Ross
2021-03-29 10:59:10 +01:00
parent 8de5cfcb18 9608655947
commit c722b6f38f
16 changed files with 781 additions and 612 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Event/Keyboard.hs
+1 -3
View File
@@ -11,6 +11,7 @@ import Dodge.LightSources
import Dodge.LevelGen
import Dodge.Creature.Inanimate
import qualified Data.IntMap.Strict as IM
import Dodge.Event.Test
import SDL
import Data.Maybe
@@ -55,9 +56,6 @@ spaceAction w = case listToMaybe $ _closeActiveObjects w of
Just (Right but) -> _btEvent but but w
Nothing -> w
testEvent :: World -> World
testEvent w = w
pauseGame :: World -> World
pauseGame w = w {_menuState = PauseMenu}
src/Dodge/Event/Test.hs
+98
View File
@@ -0,0 +1,98 @@
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 :: 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] -> Wall
wallWithCol col ps = defaultWall & wlLine .~ ps & wlColor .~ col & wlSeen .~ True