Refactor, try to limit dependencies
This commit is contained in:
+160
-130
@@ -1,151 +1,181 @@
|
||||
{- 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
|
||||
module Dodge.Room.Boss where
|
||||
|
||||
import Dodge.Creature
|
||||
import RandomHelp
|
||||
import Dodge.Tree
|
||||
import Dodge.Data.GenWorld
|
||||
import Dodge.Default.Room
|
||||
import Dodge.LevelGen.Data
|
||||
import Dodge.LevelGen.StaticWalls
|
||||
import Dodge.Placement.Instance
|
||||
import Dodge.Room.Corridor
|
||||
import Dodge.Room.Link
|
||||
import Dodge.Room.Path
|
||||
import Dodge.Room.Procedural
|
||||
import Dodge.RoomLink
|
||||
import Dodge.Tree
|
||||
import Geometry
|
||||
import LensHelp
|
||||
import RandomHelp
|
||||
|
||||
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"
|
||||
}
|
||||
roomGlassOctogon ::
|
||||
-- | Size
|
||||
Float ->
|
||||
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)
|
||||
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)
|
||||
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)
|
||||
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))
|
||||
treeFromPost [corridor, corridor] <$> (randomMediumRoom <&> rmPmnts %~ (++ theCrits))
|
||||
where
|
||||
cs = (armourChaseCrit & crState . csDropsOnDeath .~ DropSpecific [0])
|
||||
: replicate 4 chaseCrit
|
||||
cs =
|
||||
(armourChaseCrit & crState . csDropsOnDeath .~ 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
|
||||
]
|
||||
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 = mempty
|
||||
, _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 = mempty
|
||||
, _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)
|
||||
roomCross ::
|
||||
-- | First width/2
|
||||
Float ->
|
||||
-- | Second width/2
|
||||
Float ->
|
||||
Room
|
||||
roomCross x y =
|
||||
defaultRoom
|
||||
{ _rmPolys =
|
||||
[ rectNSWE y (- y) (- x) x
|
||||
, rectNSWE (- x) x y (- y)
|
||||
]
|
||||
corner = defaultRoom
|
||||
{ _rmPolys = ps
|
||||
, _rmLinks = [toBothLnk (V2 z (y-20), pi/2)]
|
||||
, _rmPath = mempty
|
||||
, _rmPmnts = [mntLS iShape (V2 x x) (V3 (x-20) (x-20) 70)]
|
||||
, _rmBound = map (expandPolyCorners 10) ps
|
||||
, _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 = mempty
|
||||
, _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 ::
|
||||
-- | First width/2
|
||||
Float ->
|
||||
-- | Second width/2
|
||||
Float ->
|
||||
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 = mempty
|
||||
, _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 ::
|
||||
-- | First width/2,
|
||||
Float ->
|
||||
-- | Second width/2, should be biggest
|
||||
Float ->
|
||||
-- | Third width, should be smallest, possibly negative
|
||||
Float ->
|
||||
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 = mempty
|
||||
, _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"
|
||||
}
|
||||
in (foldr1 combineRooms $ map (\r -> moveRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2])
|
||||
{_rmName = "twistCross" }
|
||||
|
||||
Reference in New Issue
Block a user