{- Connecting rooms designed with a pass-through technique in mind.  -}
module Dodge.Room.RoadBlock where

import Control.Lens
import Dodge.Cleat
import Dodge.Creature
import Dodge.Data.GenWorld
import Dodge.Default.Block
import Dodge.Default.Room
import Dodge.Default.Wall
import Dodge.LevelGen.PlacementHelper
import Dodge.Placement.Instance
import Dodge.Room.Corridor
import Dodge.Room.Link
import Dodge.RoomLink
import Dodge.Tree
import Geometry
import RandomHelp

armouredCorridor :: RandomGen g => State g Room
armouredCorridor = fmap (replacePutID 0 [PutCrit $ addArmour autoCrit]) litCorridor90

{-
A corridor of random length with a 90 degree link at the end.
-}
litCorridor90 :: RandomGen g => State g Room
litCorridor90 = do
    h <- state $ randomR (500, 800)
    let poly = rectNSWE h 0 0 40
        poly2 = rectNSWE (h -60) (h -100) (-60) 5
    pure $
        defaultRoom
            { _rmPolys = [poly, poly2]
            , _rmLinks =
                [ outLink (V2 40 (h - 80)) (- pi / 2)
                , inLink (V2 20 0) pi
                ]
            , _rmPath =
                foldMap
                    doublePairSet
                    [ (V2 20 0, V2 20 (h -40))
                    , (V2 0 (h -40), V2 20 (h -40))
                    , (V2 40 (h -40), V2 20 (h -40))
                    ]
            , _rmPmnts =
                [ sPS (V2 20 (h -5)) 0 putLamp
                , spanLightI (V2 0 (0.4 * h)) (V2 40 (0.4 * h))
                , windowLine (V2 0 (h -20)) (V2 40 (h -20))
                , sPS (V2 (-50) (h -85)) 0 putLamp
                , windowLine (V2 (-40) (h -60)) (V2 (-40) (h -100))
                , sPS (V2 20 (h -40)) 0 $ PutID 0
                , sPS (V2 (-20) (h -80)) 0 $ PutID 2
                ]
            , _rmBound = [poly]
            }

-- | A random length corridor with a destructible block blocking it.
longBlockedCorridor :: RandomGen g => Int -> State g (Tree Room)
longBlockedCorridor maxn = do
    r <- state $ randomR (0, pi)
    n <- state $ randomR (0, maxn)
    let plmnts =
            [ sPS (V2 20 40) r $ dirtPoly $ square 10
            , sPS (V2 20 15) 0 putLamp
            ]
    sequence $
        treeFromPost (replicate n $ shuffleLinks corridor) $
            return $ cleatOnward $ set rmPmnts plmnts corridor

-- | A single corridor with a destructible block blocking it.
blockedCorridor :: RandomGen g => State g (Tree Room)
blockedCorridor = longBlockedCorridor 0

dirtPoly :: [Point2] -> PSType
dirtPoly = PutBlock defaultDirtBlock defaultDirtWall . reverse

-- | A single corridor with a destructible block blocking it.
blockedCorridorCloseBlocks :: RandomGen g => State g Room
blockedCorridorCloseBlocks = do
    r <- state $ randomR (0, pi)
    r' <- state $ randomR (0, pi)
    theblocks <-
        takeOne
            [ [sPS (V2 20 40) r $ dirtPoly $ square 8]
            , --,   [ sPS (V2 5 40) r $ dirtPoly $ square 10
              --    , sPS (V2 35 40) (r+0.5) $ dirtPoly $ square 10
              --    ]
              --,
              --[ sPS (V2 5 50) r $ dirtPoly $ square 10
              --, sPS (V2 35 35) (r+0.5) $ dirtPoly $ square 10

                [ sPS (V2 6 25) r $ dirtPoly $ square 8
                , sPS (V2 35 20) r' $ dirtPoly $ square 8
                ]
            ]
    return $ corridor & rmPmnts .~ theblocks