More strictifiiiying

This commit is contained in:
2021-07-30 01:25:11 +02:00
parent 2d8b27746c
commit 7b7fd302d8
37 changed files with 459 additions and 448 deletions
+35 -35
View File
@@ -29,21 +29,21 @@ roomGlassOctogon x = defaultRoom
,rectNSWE 0 (-(x + 40)) (-20) 20
]
, _rmLinks =
[((0,x),0)
,((0,-(x+40)),pi)
[((V2 0 x),0)
,((V2 (0) (-(x+40))),pi)
]
, _rmPath = [((0,x),(0,-(x+40)))
,((0,-(x+40)),(0,x))]
, _rmPath = [((V2 (0) (x)),(V2 (0) (-(x+40))))
,((V2 (0) (-(x+40))),(V2 (0) (x)))]
, _rmPS =
[sPS (fx,fx) 0 putLamp
,sPS (-fx,fx) 0 putLamp
,sPS (fx,-fx) 0 putLamp
,sPS (-fx,-fx) 0 putLamp
,crystalLine (-x,x/2) (negate (x/2), x)
,crystalLine (x,x/2) (x/2, x)
,crystalLine (x/2,-x) (x,negate (x/2))
,crystalLine (negate $ x/2,-x) (-x,negate (x/2))
,blockLine (-40,40-x) (40,40-x)
[sPS (V2 fx fx) 0 putLamp
,sPS (V2 (-fx) (fx)) 0 putLamp
,sPS (V2 (fx) (-fx)) 0 putLamp
,sPS (V2 (-fx) (-fx)) 0 putLamp
,crystalLine (V2 (-x) (x/2)) (V2 (negate (x/2)) ( x))
,crystalLine (V2 (x) (x/2)) (V2 (x/2) ( x))
,crystalLine (V2 (x/2) (-x)) (V2 (x) (negate (x/2)))
,crystalLine (V2 (negate $ x/2) (-x)) (V2 (-x) (negate (x/2)))
,blockLine (V2 (-40) (40-x)) (V2 (40) (40-x))
]
, _rmBound = [rectNSWE x (-x) (-x) x]
}
@@ -51,11 +51,11 @@ roomGlassOctogon x = defaultRoom
fx = 4 * x / 5
bossRoom :: RandomGen g => Creature -> State g Room
bossRoom cr = randomMediumRoom <&> rmPS %~ ( sPS (0,100) (negate $ pi/2) (PutCrit cr) :)
bossRoom cr = randomMediumRoom <&> rmPS %~ ( sPS (V2 0 100) (negate $ pi/2) (PutCrit cr) :)
armouredChasers :: RandomGen g => State g (Tree Room)
armouredChasers = do
ps <- takeN 5 [(x,y) | x <- [-100,-80 .. 100] ,y <- [-100,-80 .. 100] ]
ps <- takeN 5 [(V2 x y) | x <- [-100,-80 .. 100] ,y <- [-100,-80 .. 100] ]
as <- replicateM 5 . state $ randomR (0,2*pi)
let theCrits = zipWith3 (\p a c -> sPS p a (PutCrit c)) ps as cs
treeFromPost [corridor,corridor] <$> (randomMediumRoom <&> rmPS %~ (++ theCrits))
@@ -80,21 +80,21 @@ roomCross x y = defaultRoom
,rectNSWE (-x) x y (-y)
]
, _rmLinks =
[((x,y-20),negate $ pi/2)
,((x,20-y),negate $ pi/2)
,((20-y,x),0)
,((y-20,x),0)
,((-x,y-20),pi/2)
,((-x,20-y),pi/2)
,((20-y,-x),pi)
,((y-20,-x),pi)
[((V2 (x) (y-20)),negate $ pi/2)
,((V2 (x) (20-y)),negate $ pi/2)
,((V2 (20-y) (x)),0)
,((V2 (y-20) (x)),0)
,((V2 (-x) (y-20)),pi/2)
,((V2 (-x) (20-y)),pi/2)
,((V2 (20-y) (-x)),pi)
,((V2 (y-20) (-x)),pi)
]
, _rmPath = []
, _rmPS =
[sPS ( x, 0) 0 putLamp
,sPS (-x, 0) 0 putLamp
,sPS ( 0, x) 0 putLamp
,sPS ( 0,-x) 0 putLamp
[sPS (V2 ( x) ( 0)) 0 putLamp
,sPS (-V2 (x) ( 0)) 0 putLamp
,sPS (V2 ( 0) ( x)) 0 putLamp
,sPS (V2 ( 0) (-x)) 0 putLamp
]
, _rmBound =
[rectNSWE y (-y) (-x) x
@@ -107,7 +107,7 @@ roomShuriken
-> Float -- ^ Second width/2
-> Room
roomShuriken x y =
let ps = [
let ps = [ map toV2
[ (0,-20)
, (x,-20)
, (x,y)
@@ -115,12 +115,12 @@ roomShuriken x y =
] ]
corner = defaultRoom
{ _rmPolys = ps
, _rmLinks = [((x-1,y-20),negate $ pi/2)]
, _rmLinks = [((V2 (x-1) (y-20)),negate $ pi/2)]
, _rmPath = []
, _rmPS = [sPS (x/2,x/2) 0 putLamp]
, _rmPS = [sPS (V2 (x/2) (x/2)) 0 putLamp]
, _rmBound = ps
}
in foldr1 combineRooms $ map (\r -> shiftRoomBy ((0,0), r) corner) [0,pi/2,pi,3*pi/2]
in foldr1 combineRooms $ map (\r -> shiftRoomBy ((V2 0 0), r) corner) [0,pi/2,pi,3*pi/2]
{- | TODO: pathing
Precondition: first float is less than the second by at least 40. -}
roomTwistCross
@@ -129,7 +129,7 @@ roomTwistCross
-> Float -- ^ Third width, should be smallest, possibly negative
-> Room
roomTwistCross x y z =
let ps = [ [ (x,negate $ z+20)
let ps = [ map toV2 [ (x,negate $ z+20)
, (x,x)
, (z,y)
, (z-20,x)
@@ -139,9 +139,9 @@ roomTwistCross x y z =
]
corner = defaultRoom
{ _rmPolys = ps
, _rmLinks = [((z,y-20), pi/2)]
, _rmLinks = [((V2 (z) (y-20)), pi/2)]
, _rmPath = []
, _rmPS = [sPS (x/2,x/2) 0 putLamp]
, _rmPS = [sPS (V2 (x/2) (x/2)) 0 putLamp]
, _rmBound = ps
}
in foldr1 combineRooms $ map (\r -> shiftRoomBy ((0,0), r) corner) [0,pi/2,pi,3*pi/2]
in foldr1 combineRooms $ map (\r -> shiftRoomBy ((V2 0 0), r) corner) [0,pi/2,pi,3*pi/2]