loop/src/Dodge/Room/Start.hs

module Dodge.Room.Start 
    where
import Dodge.LevelGen.Data
import Dodge.Room.RunPast
import Dodge.Data
import Dodge.Default
import Dodge.Layout.Tree.Either
import Dodge.RandomHelp
import Dodge.Room.Door
import Dodge.Room.Corridor
import Dodge.Room.Room
import Dodge.Room.Link
import Dodge.Room.Procedural
import Dodge.Room.Foreground
import Dodge.Room.RoadBlock
import Dodge.Placement.Instance
import Dodge.Layout.Tree.Polymorphic
import Dodge.Item.Random
--import Dodge.LevelGen.Data
import Geometry.Data
import Padding
import Color
import Shape

import Data.Tree
import Control.Monad.State
import Control.Lens
import System.Random
--import qualified Data.IntMap.Strict as IM

minigunfakeout :: RandomGen g => State g (Tree (Either Room Room))
minigunfakeout = do
    rcol <- rezColor
    ncor <- state $ randomR (1,5)
    return $ ([Left $ rezBox rcol,Left door] ++ replicate ncor (Left corridor)
            ++ [Left keyholeCorridor,Left corridor])
        `treeFromPost` Right door

startRoom :: RandomGen g => State g (Tree (Either Room Room))
startRoom = join $ takeOne 
    [ minigunfakeout
    --, rezBoxesWp
    --, rezBoxesThenWeaponRoom
    --, rezBoxThenWeaponRoom
    --, rezBoxesWpCrit
    --, runPastStart
    ]

runPastStart :: RandomGen g => State g (Tree (Either Room Room))
runPastStart = do
    s <- rezBoxStart
    rp <- runPastRoom
    return $ s `appendEitherTree` [rp]

rezBoxStart :: RandomGen g => State g (Tree (Either Room Room))
rezBoxStart = do
    ls <- rezColor
    return $ treeFromPost [Left $ rezBox ls] (Right door)

rezBox :: LightSource -> Room
rezBox ls = roomRect 40 60 1 1 
    & rmPmnts .~ [ sPS (V2 20 1) 0 $ PutLS ls]
rezColor :: RandomGen g => State g LightSource
rezColor = do
    col <- takeOne [V3 0.0 0.1 0.5, V3 0.0 0.5 0.1]
    h   <- takeOne [30,50,80,90,90,90,90]
    rad <- takeOne [150,200,200,250,250,300,300,300]
    return defaultLS
        { _lsPos = V3 0 0 h
        , _lsIntensity = col
        , _lsRad = rad
        }

rezInvBox :: LightSource -> Room
rezInvBox = (rmLinks %~ reverse) . rezBox

crAdd :: Room -> Room
crAdd = rmPmnts %~ (sPS (V2 20 10) (0.5*pi) randC1 :)

wpAdd :: Item -> Room -> Room
wpAdd wp = rmPmnts %~ f
  where
    f (x:xs) = sPS (V2 15 30) 1 (PutFlIt wp) : g x : xs
    f _ = [sPS (V2 15 30) 1 (PutFlIt wp)]
    g x = x & plIDCont .~ flickerMod


rezBoxesThenWeaponRoom :: RandomGen g => State g (Tree (Either Room Room))
rezBoxesThenWeaponRoom = do
    rboxes <- rezBoxes
    wroom  <- weaponRoom
    return $ rboxes `appendEitherTree` [wroom]

rezBoxThenWeaponRoom :: RandomGen g => State g (Tree (Either Room Room))
rezBoxThenWeaponRoom = do
    rcol <- rezColor
    treeFromTrunk [Left $ rezBox rcol,Left door] <$> weaponRoom

rezBoxesWpCrit :: RandomGen g => State g (Tree (Either Room Room))
rezBoxesWpCrit = do
    w <- state $ randomR (200,400)
    h <- state $ randomR (40,40)
    thecol <- rezColor
    theweapon <- randBlockBreakWeapon
    let bottomEdgeTest (V2 _ y,_) = y < 1
        bottomLeftTest (V2 x y,_) = y < 1 && x < 21
        aroom = rezInvBox thecol
    centralRoom <- filterSortOutLinksOn bottomEdgeTest ((\(V2 a b) -> (b,a)) . fst) <$>
            (randomiseOutLinks =<< changeLinkTo bottomLeftTest 
                    ((roomRectAutoLinks w h) {_rmPmnts = []}))
    let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom
    i <- state $ randomR (0,n-3)
    j <- state $ randomR (i,n-2)
    blcor <- blockedCorridor'
    let rezrooms = map adddoor 
            $ insertAt i (wpAdd theweapon aroom) 
            $ insertAt j (crAdd aroom)
            $ replicate (n-3) aroom
    return $ treeFromTrunk [Left $ rezBox thecol
        , Left door
        ] 
        (Node (Left centralRoom) (rezrooms ++ [onwardtree blcor]))
  where
    adddoor rm = treeFromPost [Left door] (Left rm)
    onwardtree blcor = treeFromPost [Left door] (Right blcor)

rezBoxesWp :: RandomGen g => State g (Tree (Either Room Room))
rezBoxesWp = do
    w <- state $ randomR (100,400)
    h <- state $ randomR (40,40)
    theweapon <- randBlockBreakWeapon
    thecol <- rezColor
    let bottomEdgeTest (V2 _ y,_) = y < 1
        aroom = rezInvBox thecol
    centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest 
        ((roomRectAutoLinks w h) {_rmPmnts = []})
    blcor <- blockedCorridor'
    let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom
    let rezrooms = map adddoor 
            $ wpAdd theweapon aroom : replicate (n-2) aroom
    centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
    return $ treeFromTrunk [Left $ rezBox thecol
        , Left door
        ] 
        (Node (Left centralRoom') (rezrooms ++ [onwardtree blcor]))
  where
    adddoor rm = treeFromPost [Left door] (Left rm)
    onwardtree blcor = treeFromPost [Left door] (Right blcor)

rezBoxes :: RandomGen g => State g (Tree (Either Room Room))
rezBoxes = do
    w <- state $ randomR (100,400)
    h <- state $ randomR (40,40)
    thecol <- rezColor
    let bottomEdgeTest (V2 _ y,_) = y < 1
        dbox = treeFromPost [Left door] (Left $ rezInvBox thecol)
    centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest 
        ((roomRectAutoLinks w h) {_rmPmnts = []})
    let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom
    centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
    return $ treeFromTrunk [Left $ rezBox thecol
        , Left door
        ] 
        (Node (Left centralRoom') (replicate (n-1) dbox ++ [Node (Right door) []]))

startRoom' :: RandomGen g => State g (Tree (Either Room Room))
startRoom' = do
    w <- state $ randomR (100,400)
    h <- state $ randomR (200,400)
    let plmnts = 
            [ sPS (V2 0 0) 0 $ PutForeground $ girderV 40 20 10 (V2 0 (h/2)) (V2 w (h/2))
            --, mntLS jShape (V2 0 (h/3)) (V3 40 (h/3) 70)
            , tankSquareEmboss4 (dim orange) 50 (h-60)
            , tankSquare (dim orange) 50 50
            , tankSquare (dim orange) 50 120
            , lightSensor (V2 (0.8*w) (0.25*h)) 0
            , putLasTurret & plSpot .~ PS (V2 (0.8*w) (0.8*h)) 0
            , sps0 $ PutForeground $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
            ]
    thecol <- rezColor
    treeFromPost [Left $ rezBox thecol, Left door] . Right 
        <$> randomiseOutLinks 
            (shiftRoomBy (V2 (-20) (-20),0) 
            ( roomRectAutoLinks w h & rmPmnts %~ (plmnts ++) 
            ) & rmShift .~ (0,0) )