module Dodge.Room.LongRoom where

import Control.Monad
import qualified Data.Set as S
import Data.Tile
import Dodge.Cleat
import Dodge.Creature
import Dodge.Data.GenWorld
import Dodge.Default.Wall
import Dodge.LevelGen.PlacementHelper
import Dodge.Placement.Instance
import Dodge.Room.Corridor
import Dodge.Room.Door
import Dodge.Room.Link
import Dodge.Room.Procedural
import Dodge.RoomLink
import Dodge.Tree
import Geometry
import LensHelp
import RandomHelp

longRoom :: RandomGen g => State g Room
longRoom = do
    h <- state $ randomR (1500, 1500)
    let w = 75
    let wlsNSEWs wln wls listew =
            [ sps0 $ PutWall (rectNSWE wln wls wallw walle) defaultCrystalWall
            | (wallw, walle) <- listew
            ]
    let ws = wlsNSEWs (h -35) (h -135) [(-10, 10), (15, 35), (40, 60), (65, 85)]
    let wsDefense = wlsNSEWs 95 70 [(0, 25), (50, 75)]
    brlN <- state $ randomR (0, 5)
    brlOffsets <- replicateM brlN $ randInRect (w -20) 900
    let brls = [sPS (p +.+ V2 10 200) 0 $ PutCrit explosiveBarrel | p <- brlOffsets]
    rm <-
        shuffleLinks $
            roomRect w (h + 70) 1 1 & rmPolys .++~ [rectNSWE h (h -165) (-45) (w + 45)]
                & rmFloor .~ InheritFloor
    return $
        restrictInLinks (\x -> (sndV2 . fst) x < 40) $
            restrictOutLinks (\x -> (sndV2 . fst) x > h * 0.75) $
                rm & rmPmnts .~ ws ++ brls ++ wsDefense
                    ++ [ sPS (V2 crx (h -25)) 0 $ PutCrit longCrit
                       | crx <- [12.5, 37.5, 62.5]
                       ]
                    ++ [sPS (V2 25 lampy) 0 putLamp | lampy <- [20, h -10]]

longRoomRunPast :: RandomGen g => State g (MetaTree Room String)
longRoomRunPast = do
    r <- longRoom
    rToOnward "longRoomRunPast" $
        treeFromTrunk [door] $
            Node
                r
                [ pure $ cleatOnward door
                , treePost [corridor & rmConnectsTo .~ S.member InLink, cleatLabel 0 door]
                ]