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

Move to using RoomLink datatype

Browse Source
This commit is contained in:
justin
2021-11-23 20:45:39 +00:00
parent a66ea1d922
commit 1f2d767d5e
18 changed files with 160 additions and 122 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Corridor.hs
+35 -23
View File
@@ -1,6 +1,7 @@
module Dodge.Room.Corridor
where
import Dodge.LevelGen.Data
import Dodge.RoomLink
--import Dodge.Room.Foreground
import Dodge.Default.Room
--import Dodge.LevelGen.Data
@@ -16,8 +17,8 @@ import Data.Bifunctor
corridor :: Room
corridor = defaultRoom
{ _rmPolys = [poly]
, _rmOutLinks = init lnks
, _rmInLinks = [last lnks]
, _rmOutLinks = init lnks'
, _rmInLinks = [last lnks']
, _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks
, _rmPmnts = [ spanLightI (V2 0 40) (V2 40 40) ]
, _rmBound = [ rectNSWE 50 30 0 40 ]
@@ -27,11 +28,17 @@ corridor = defaultRoom
}
where
poly = rectNSWE 80 0 0 40
lnks = map (first toV2)
[((20,70) ,0)
,((20,70), pi/6)
,((20,70), negate $ pi/6)
,((20,10) ,pi)
lnks' =
[uncurry outLink ((V2 20 70) ,0)
,uncurry outLink ((V2 20 70), pi/6)
,uncurry outLink ((V2 20 70), negate $ pi/6)
,uncurry inLink ((V2 20 10) ,pi)
]
lnks =
[ ((V2 20 70) ,0)
, ((V2 20 70), pi/6)
, ((V2 20 70), negate $ pi/6)
,((V2 20 10) ,pi)
]
keyholeCorridor :: Room
keyholeCorridor = corridor
@@ -54,8 +61,8 @@ corridorN = defaultRoom
, _rmPmnts = []
, _rmBound = [ rectNSWE 50 30 0 40 ]
}
where lnks = [(V2 20 70 ,0)
,(V2 20 10 ,pi)
where lnks = [uncurry outLink (V2 20 70 ,0)
,uncurry inLink (V2 20 10 ,pi)
]
pth = doublePair (V2 20 70,V2 20 10)
corridorWallN :: Room
@@ -68,8 +75,8 @@ corridorWallN = defaultRoom
, _rmPmnts = []
, _rmBound = [ rectNSWE 50 30 0 40 ]
}
where lnks = [(V2 20 70 ,0)
,(V2 20 10 ,pi)
where lnks = [uncurry outLink(V2 20 70 ,0)
,uncurry inLink(V2 20 10 ,pi)
]
pth = doublePair (V2 20 70,V2 20 10)
@@ -78,32 +85,37 @@ tEast = defaultRoom
{ _rmPolys = [rectNSWE 80 0 (-20) 20
,rectNSWE 80 40 (-40) 40
]
, _rmOutLinks = init lnks
, _rmInLinks = [last lnks]
, _rmOutLinks = init lnks'
, _rmInLinks = [last lnks']
, _rmPath = concatMap (doublePair . (,) (V2 0 60) . fst) lnks
, _rmPmnts = []
, _rmBound = [ rectNSWE 70 10 0 40 ]
}
where
lnks = map (first toV2)
[(( 30,60),-pi/2)
,((-30,60),pi/2)
,((0,10),pi)
lnks =
[(V2 ( 30) (60),-pi/2)
,(V2 (-30) (60),pi/2)
,((V2 0 10),pi)
]
lnks' =
[uncurry outLink(V2 ( 30) (60),-pi/2)
,uncurry outLink(V2 (-30) (60),pi/2)
,uncurry inLink((V2 0 10),pi)
]
tWest :: Room
tWest = defaultRoom
{ _rmPolys = [rectNSWE 80 0 (-20) 20
,rectNSWE 80 40 (-40) 40
]
, _rmOutLinks = init lnks
, _rmInLinks = [last lnks]
, _rmOutLinks = map (uncurry outLink) $ init lnks
, _rmInLinks = [uncurry inLink $ last lnks]
, _rmPath = concatMap (doublePair . (,) (V2 0 60) . fst) lnks
, _rmPmnts = []
, _rmBound = [ rectNSWE 70 10 0 40 ]
}
where
lnks = map (first toV2)
[((-30,60),pi/2)
,(( 30,60),-pi/2)
,((0,10),pi)
lnks =
[(V2 (-30) (60),pi/2)
,(V2 ( 30) (60),-pi/2)
,(V2 (0) (10),pi)
]