Files
loop/src/Dodge/Room/Boss.hs
T
2022-06-09 11:34:34 +01:00

152 lines
4.7 KiB
Haskell

{- Rooms containing particularly challenging creatures, that may drop useful loot. -}
module Dodge.Room.Boss
where
import Dodge.Data
import Dodge.RoomLink
import Dodge.Default.Room
import Dodge.Placement.Instance
import Dodge.LevelGen.Data
import Dodge.Room.Procedural
import Dodge.Room.Link
import Dodge.Room.Corridor
import Dodge.Room.Path
--import Dodge.LevelGen.Data
import Dodge.Creature
import RandomHelp
import Dodge.Tree
import Dodge.LevelGen.StaticWalls
import Geometry
import LensHelp
roomGlassOctogon
:: Float -- ^ Size
-> Room
roomGlassOctogon x = createPathGrid $ defaultRoom
{ _rmPolys =
[rectNSWE x (-x) (-x) x
,rectNSWE 0 (-(x + 40)) (-20) 20
]
, _rmLinks = map (uncurry outLink) (init lnks) ++ [uncurry inLink $ last lnks]
, _rmPath = linksAndPath lnks
[ ( V2 0 x , V2 0 (-(x+40)))
, ( V2 0 (-(x+40)), V2 0 x)
]
, _rmPmnts =
[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) (50-x)) (V2 40 (50-x))
]
, _rmBound = [rectNSWE x (-x) (-x) x]
, _rmName = "glass8gon"
}
where
fx = 4 * x / 5
lnks =
[ (V2 0 x,0)
, (V2 0 (-(x+40)),pi)
]
bossRoom :: RandomGen g => Creature -> State g Room
bossRoom cr = randomMediumRoom <&> rmPmnts .:~ sPS (V2 0 100) (negate $ pi/2) (PutCrit cr)
armouredChasers :: RandomGen g => State g (Tree Room)
armouredChasers = do
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 <&> rmPmnts %~ (++ theCrits))
where
cs = (armourChaseCrit & crState . crDropsOnDeath .~ DropSpecific [0])
: replicate 4 chaseCrit
randomMediumRoom :: RandomGen g => State g Room
randomMediumRoom = takeOne
[ roomGlassOctogon 300
, roomCross 180 300
, roomShuriken 200 300
, roomTwistCross 230 300 0
]
roomCross
:: Float -- ^ First width/2
-> Float -- ^ Second width/2
-> Room
roomCross x y = defaultRoom
{ _rmPolys = [rectNSWE y (-y) (-x) x
,rectNSWE (-x) x y (-y)
]
, _rmLinks = map (uncurry outLink)
[(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)
] ++
[uncurry inLink (V2 (y-20) (-x),pi)
]
, _rmPath = []
, _rmPmnts =
[ spanLightI (V2 (x+5) x) (V2 (x+5) (-x))
, spanLightI (V2 (-x-5) x) (V2 (-x-5) (-x))
]
, _rmBound =
[rectNSWE y (-y) (-x) x
,rectNSWE x (-x) (-y) y
]
, _rmName = "cross"
}
{- | TODO: pathing -}
roomShuriken
:: Float -- ^ First width/2
-> Float -- ^ Second width/2
-> Room
roomShuriken x y =
let ps = [ map toV2
[ (0,-20)
, (x,-20)
, (x,y)
, (0,x)
] ]
corner = defaultRoom
{ _rmPolys = ps
, _rmLinks = [toBothLnk (V2 (x-1) (y-20),negate $ pi/2)]
, _rmPath = []
, _rmPmnts = [mntLS iShape (V2 x x) (V3 (x-20) x 70)]
, _rmBound = ps
}
in (foldr1 combineRooms $ map (\r -> moveRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2])
{_rmName = "shuriken"}
{- | TODO: pathing
Precondition: first float is less than the second by at least 40. -}
roomTwistCross
:: Float -- ^ First width/2,
-> Float -- ^ Second width/2, should be biggest
-> Float -- ^ Third width, should be smallest, possibly negative
-> Room
roomTwistCross x y z =
let ps = [ map toV2 [ (x,negate $ z+20)
, (x,x)
, (z,y)
, (z-20,x)
, (z,negate $ z+20)
]
, rectNSWE (x-5) 0 0 (x-5)
]
corner = defaultRoom
{ _rmPolys = ps
, _rmLinks = [toBothLnk (V2 z (y-20), pi/2)]
, _rmPath = []
, _rmPmnts = [mntLS iShape (V2 x x) (V3 (x-20) (x-20) 70)]
, _rmBound = map (expandPolyCorners 10) ps
}
in (foldr1 combineRooms $ map (\r -> moveRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2])
{_rmName = "twistCross" }