Add file

src/Dodge/Room/RezBox.hs

@@ -0,0 +1,149 @@
+module Dodge.Room.RezBox where
+import Dodge.LevelGen.Data
+--import Dodge.PlacementSpot
+import Dodge.Room.RunPast
+import Dodge.RoomLink
+import Dodge.Room.LasTurret
+import Dodge.Data
+import Dodge.Default
+--import Dodge.RoomLink
+import Dodge.Tree
+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.Item.Random
+import Dodge.Item.Weapon.BulletGuns
+import Dodge.Item.Weapon.Utility
+--import Dodge.LevelGen.Data
+--import Geometry.Data
+import Geometry
+import Padding
+import Color
+import Shape
+
+import qualified Data.Set as S
+--import Data.Maybe
+import Data.Tree
+import Control.Monad.State
+import Control.Lens
+import System.Random
+
+rezBox :: LightSource -> Room
+rezBox ls = roomRect 40 60 1 1 
+    & rmPmnts .~ [ sPS (V2 20 1) 0 $ PutLS ls]
+    & restrictInLinks  (\(V2 _ h,_)-> h < 1)
+    & restrictOutLinks (\(V2 _ h,_)-> h > 59)
+
+rezBoxesWp :: RandomGen g => State g (SubCompTree Room)
+rezBoxesWp = do
+    w <- state $ randomR (100,400)
+    h <- state $ randomR (40,40)
+    theweapon <- randBlockBreakWeapon
+    thecol <- rezColor
+    let aroom = rezInvBox thecol -- & rmConnectsTo .~ S.singleton (OnEdge North)
+    let isnorth = S.member (OnEdge North) . _rlType
+    centralRoom <- shuffleLinks $(roomRectAutoLinks w h) {_rmPmnts = []} 
+        & rmLinks %~ (setLinkType InLink isnorth)
+    onwardpassage <- maybeBlockedPassage
+    let n = length $ getLinksOfType (OnEdge North) $  _rmLinks centralRoom
+    let rezrooms = map adddoor 
+            $ wpAdd theweapon aroom : replicate (n-2) aroom
+    return $ treeFromTrunk [PassDown $ rezBox thecol
+        , PassDown door
+        ] 
+        (Node (PassDown centralRoom) (rezrooms ++ [onwardpassage]))
+  where
+    adddoor rm = treeFromPost [PassDown $ connectsToNorth door ] (PassDown rm)
+    connectsToNorth = rmConnectsTo .~ S.singleton (OnEdge North)
+maybeBlockedPassage :: RandomGen g => State g (SubCompTree Room)
+maybeBlockedPassage = fmap singleUseAll $ join $ takeOne [return corridor, blockedCorridorCloseBlocks]
+rezBoxesWpCrit :: RandomGen g => State g (SubCompTree Room)
+rezBoxesWpCrit = do
+    w <- state $ randomR (200,400)
+    h <- state $ randomR (40,40)
+    thecol <- rezColor
+    theweapon <- randBlockBreakWeapon
+    horedge <- takeOne [OnEdge North,OnEdge South]
+    let centralRoom = (roomRectAutoLinks w h) {_rmPmnts = []}
+    onwardpassage <- fmap 
+        (applyToCompRoot (rmConnectsTo .~ S.singleton (OnEdge West))) $ maybeBlockedPassage
+    let bottomEdgeTest (V2 _ y,_) = y < 1
+        aroom = rezInvBox thecol
+    let n = length $ filter bottomEdgeTest $ map lnkPosDir $ _rmLinks centralRoom
+    i <- state $ randomR (0,n-3)
+    j <- state $ randomR (i,n-2)
+    blcor <- blockedCorridorCloseBlocks
+    let rezrooms = map adddoor 
+            $ insertAt i (wpAdd theweapon aroom) 
+            $ insertAt j (crAdd aroom)
+            $ replicate (n-3) aroom
+    return $ treeFromTrunk [PassDown $ rezBox thecol
+        , PassDown door
+        ] 
+        (Node (PassDown centralRoom) (rezrooms ++ [onwardpassage]))
+  where
+    adddoor rm = treeFromPost [PassDown door] (PassDown rm)
+
+crAdd :: Room -> Room
+crAdd = rmPmnts %~ (sPS (V2 20 10) (0.5*pi) randC1 :)
+
+corridorLRbranches :: RandomGen g => State g (SubCompTree Room)
+corridorLRbranches = do
+    w <- state $ randomR (100,400)
+    h <- state $ randomR (40,40)
+    thecol <- rezColor
+    let bottomEdgeTest (V2 _ y,_) = y < 1
+        dbox = treeFromPost [PassDown door] (PassDown $ rezInvBox thecol)
+    centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest 
+        ((roomRectAutoLinks w h) {_rmPmnts = []})
+    let n = length $ filter bottomEdgeTest $ map lnkPosDir $_rmLinks centralRoom
+    centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
+    return $ treeFromTrunk [PassDown $ rezBox thecol
+        , PassDown door
+        ] 
+        (Node (PassDown centralRoom') (replicate (n-1) dbox ++ [Node (UseAll door) []]))
+
+rezBoxes :: RandomGen g => State g (SubCompTree Room)
+rezBoxes = do
+    w <- state $ randomR (100,400)
+    h <- state $ randomR (40,40)
+    thecol <- rezColor
+    let bottomEdgeTest (V2 _ y,_) = y < 1
+        dbox = treeFromPost [PassDown door] (PassDown $ rezInvBox thecol)
+    centralRoom <- shuffleLinks $ setInLinksPD bottomEdgeTest
+        ((roomRectAutoLinks w h) {_rmPmnts = []})
+    let n = length $ filter bottomEdgeTest $ map lnkPosDir $_rmLinks centralRoom
+    centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
+    return $ treeFromTrunk [PassDown $ rezBox thecol
+        , PassDown door
+        ] 
+        (Node (PassDown centralRoom') (replicate (n-1) dbox ++ [Node (UseAll door) []]))
+  where
+    
+
+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 = swapInOutLinks . rezBox
+
+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