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

Further strictifying

Browse Source
This commit is contained in:
justin
2021-07-30 00:23:02 +02:00
parent bd8ef3f416
commit 2d8b27746c
33 changed files with 228 additions and 211 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Corridor.hs
+19 -14
View File
@@ -3,21 +3,24 @@ module Dodge.Room.Corridor
import Dodge.Room.Data
import Dodge.Default.Room
import Geometry
import Geometry.Data
import Tile
import Data.Bifunctor
{- | First exit due north, two other exits at angles next to this.
Entrance from south. -}
corridor :: Room
corridor = defaultRoom
{ _rmPolys = [poly]
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (20,60) . fst) lnks
, _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks
, _rmPS = []
, _rmBound = [ rectNSWE 50 30 0 40 ]
, _rmFloor = [oTile poly 2]
}
where
poly = rectNSWE 80 0 0 40
lnks =
lnks = map (first toV2)
[((20,70) ,0)
,((20,70), pi/6)
,((20,70), negate $ pi/6)
@@ -32,12 +35,12 @@ corridorDebug = defaultRoom
--, [ (0,0), (0,20) , (20,10)]
]
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (20,60) . fst) lnks
, _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks
, _rmPS = []
, _rmBound = [ rectNSWE 50 30 0 40 ]
}
where
lnks =
lnks = map (first toV2)
[((20,70) ,0)
,((20,70), pi/6)
,((20,70), negate $ pi/6)
@@ -52,10 +55,10 @@ corridorN = defaultRoom
, _rmPS = []
, _rmBound = [ rectNSWE 50 30 0 40 ]
}
where lnks = [((20,70) ,0)
,((20,10) ,pi)
where lnks = [((V2 20 70) ,0)
,((V2 20 10) ,pi)
]
pth = doublePair ((20,70),(20,10))
pth = doublePair ((V2 20 70),(V2 20 10))
tEast :: Room
tEast = defaultRoom
@@ -63,26 +66,28 @@ tEast = defaultRoom
,rectNSWE 80 40 (-40) 40
]
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (0,60) . fst) lnks
, _rmPath = concatMap (doublePair . (,) (V2 0 60) . fst) lnks
, _rmPS = []
, _rmBound = [ rectNSWE 70 10 0 40 ]
}
where lnks = [(( 30,60),-pi/2)
,((-30,60),pi/2)
,((0,10),pi)
]
where
lnks = map (first toV2)
[(( 30,60),-pi/2)
,((-30,60),pi/2)
,((0,10),pi)
]
tWest :: Room
tWest = defaultRoom
{ _rmPolys = [rectNSWE 80 0 (-20) 20
,rectNSWE 80 40 (-40) 40
]
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (0,60) . fst) lnks
, _rmPath = concatMap (doublePair . (,) (V2 0 60) . fst) lnks
, _rmPS = []
, _rmBound = [ rectNSWE 70 10 0 40 ]
}
where
lnks =
lnks = map (first toV2)
[((-30,60),pi/2)
,(( 30,60),-pi/2)
,((0,10),pi)