loop/src/Dodge/Room/Boss.hs

{- Rooms containing particularly challenging creatures, that may drop useful loot.  -}
module Dodge.Room.Boss where

import Dodge.Creature
import Dodge.Data.GenWorld
import Dodge.Default.Room
import Dodge.LevelGen.PlacementHelper
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
import Control.Monad

-- pathing needs to be done
roomGlassOctogon :: Float -> Room
roomGlassOctogon x =
--    createPathGrid $
        defaultRoom
            { _rmPolys =
                [ rectNSWE x (- x) (- x) x
                , rectNSWE 0 (- (x + 40)) (-20) 20
                ]
            , _rmLinks = lnks'
            , _rmPath =
                linksDAGToPath lnks' [ (V2 0 x, V2 0 (- (x + 40))) ]
            , _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 = 5 * x / 6
    lnks' = map (uncurry outLink) (init lnks) ++ [uncurry inLink $ last lnks]
    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 . csDropsOnDeath .~ DropSpecific [0]) :
        armourChaseCrit :
        replicate 4 chaseCrit

randomMediumRoom :: RandomGen g => State g Room
randomMediumRoom =
    takeOne
        [ roomGlassOctogon 300
        , roomCross 180 300
        , roomShuriken 200 300
        , roomTwistCross 230 300 0
        ]

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)
            ]
        , _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"
            }