Refactor, try to limit dependencies
This commit is contained in:
+87
-84
@@ -1,128 +1,131 @@
|
||||
module Dodge.Room.RezBox where
|
||||
import Dodge.LevelGen.Data
|
||||
import Dodge.Cleat
|
||||
--import Dodge.PlacementSpot
|
||||
--import Dodge.Room.RunPast
|
||||
import Dodge.RoomLink
|
||||
import Dodge.LightSource
|
||||
--import Dodge.Room.LasTurret
|
||||
import Dodge.Data
|
||||
--import Dodge.Default
|
||||
--import Dodge.RoomLink
|
||||
import Dodge.Tree
|
||||
import 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 LensHelp
|
||||
--import Color
|
||||
--import Shape
|
||||
|
||||
import qualified Data.Set as S
|
||||
--import Data.Maybe
|
||||
import Dodge.Cleat
|
||||
import Dodge.Data.GenWorld
|
||||
import Dodge.Item.Random
|
||||
import Dodge.LevelGen.Data
|
||||
import Dodge.LightSource
|
||||
import Dodge.Placement.Instance
|
||||
import Dodge.Room.Corridor
|
||||
import Dodge.Room.Door
|
||||
import Dodge.Room.Link
|
||||
import Dodge.Room.Procedural
|
||||
import Dodge.Room.RoadBlock
|
||||
import Dodge.RoomLink
|
||||
import Dodge.Tree
|
||||
import Geometry
|
||||
import LensHelp
|
||||
import Padding
|
||||
import RandomHelp
|
||||
|
||||
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)
|
||||
& rmName .~ "rezBox"
|
||||
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)
|
||||
& rmName .~ "rezBox"
|
||||
|
||||
rezBox' :: RandomGen g => State g (MetaTree Room String)
|
||||
rezBox' = do
|
||||
col <- rezColor
|
||||
return $ tToBTree "rezBox'" $ treePost
|
||||
[roomRect 40 60 1 1
|
||||
& rmPmnts .~ [ sPS (V2 20 1) 0 $ PutLS col]
|
||||
& restrictInLinks (\(V2 _ h,_)-> h < 1)
|
||||
& restrictOutLinks (\(V2 _ h,_)-> h > 59)
|
||||
& rmName .~ "rezBox"
|
||||
, cleatOnward door
|
||||
]
|
||||
return $
|
||||
tToBTree "rezBox'" $
|
||||
treePost
|
||||
[ roomRect 40 60 1 1
|
||||
& rmPmnts .~ [sPS (V2 20 1) 0 $ PutLS col]
|
||||
& restrictInLinks (\(V2 _ h, _) -> h < 1)
|
||||
& restrictOutLinks (\(V2 _ h, _) -> h > 59)
|
||||
& rmName .~ "rezBox"
|
||||
, cleatOnward door
|
||||
]
|
||||
|
||||
rezBoxesWp :: RandomGen g => State g (Tree Room)
|
||||
rezBoxesWp = do
|
||||
w <- state $ randomR (100,400)
|
||||
h <- state $ randomR (40,40)
|
||||
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
|
||||
centralRoom <-
|
||||
shuffleLinks $(roomRectAutoLinks w h){_rmPmnts = []}
|
||||
& rmLinks %~ setLinkType InLink isnorth
|
||||
onwardpassage <- shootOutPassage
|
||||
let n = length $ getLinksOfType (OnEdge North) $ _rmLinks centralRoom
|
||||
let rezrooms = map adddoor
|
||||
$ wpAdd theweapon aroom : replicate (n-2) aroom
|
||||
return $ treeFromTrunk [ rezBox thecol , door ]
|
||||
$ Node centralRoom (rezrooms ++ [onwardpassage])
|
||||
let n = length $ getLinksOfType (OnEdge North) $ _rmLinks centralRoom
|
||||
let rezrooms =
|
||||
map adddoor $
|
||||
wpAdd theweapon aroom : replicate (n -2) aroom
|
||||
return $
|
||||
treeFromTrunk [rezBox thecol, door] $
|
||||
Node centralRoom (rezrooms ++ [onwardpassage])
|
||||
where
|
||||
adddoor rm = treeFromPost [ connectsToNorth door ] rm
|
||||
adddoor rm = treeFromPost [connectsToNorth door] rm
|
||||
connectsToNorth = rmConnectsTo .~ S.member (OnEdge North)
|
||||
|
||||
maybeBlockedPassage :: RandomGen g => State g (Tree Room)
|
||||
maybeBlockedPassage = fmap (pure . cleatOnward)
|
||||
$ join $ takeOne [return corridor, blockedCorridorCloseBlocks]
|
||||
maybeBlockedPassage =
|
||||
fmap (pure . cleatOnward) $
|
||||
join $ takeOne [return corridor, blockedCorridorCloseBlocks]
|
||||
|
||||
shootOutPassage :: RandomGen g => State g (Tree Room)
|
||||
shootOutPassage = fmap (pure . cleatOnward)
|
||||
$ join $ takeOne [ blockedCorridorCloseBlocks]
|
||||
shootOutPassage =
|
||||
fmap (pure . cleatOnward) $
|
||||
join $ takeOne [blockedCorridorCloseBlocks]
|
||||
|
||||
rezBoxesWpCrit :: RandomGen g => State g (Tree Room)
|
||||
rezBoxesWpCrit = do
|
||||
w <- state $ randomR (200,400)
|
||||
h <- state $ randomR (40,40)
|
||||
w <- state $ randomR (200, 400)
|
||||
h <- state $ randomR (40, 40)
|
||||
thecol <- rezColor
|
||||
theweapon <- randBlockBreakWeapon
|
||||
let bottomEdgeTest (V2 _ y,_) = y < 1
|
||||
let bottomEdgeTest (V2 _ y, _) = y < 1
|
||||
aroom = rezInvBox thecol
|
||||
let centralRoom = (roomRectAutoLinks w h) {_rmPmnts = []}
|
||||
let centralRoom = (roomRectAutoLinks w h){_rmPmnts = []}
|
||||
onwardpassage <-
|
||||
over root (rmConnectsTo .~ S.member (OnEdge West)) <$> maybeBlockedPassage
|
||||
let n = length $ filter bottomEdgeTest $ map lnkPosDir $ _rmLinks centralRoom
|
||||
i <- state $ randomR (0,n-3)
|
||||
j <- state $ randomR (i,n-2)
|
||||
let rezrooms = map adddoor
|
||||
$ insertAt i (wpAdd theweapon aroom)
|
||||
$ insertAt j (crAdd aroom)
|
||||
$ replicate (n-3) aroom
|
||||
return $ treeFromTrunk [rezBox thecol , door]
|
||||
$ Node centralRoom (rezrooms ++ [onwardpassage])
|
||||
i <- state $ randomR (0, n -3)
|
||||
j <- state $ randomR (i, n -2)
|
||||
let rezrooms =
|
||||
map adddoor $
|
||||
insertAt i (wpAdd theweapon aroom) $
|
||||
insertAt j (crAdd aroom) $
|
||||
replicate (n -3) aroom
|
||||
return $
|
||||
treeFromTrunk [rezBox thecol, door] $
|
||||
Node centralRoom (rezrooms ++ [onwardpassage])
|
||||
where
|
||||
adddoor rm = treeFromPost [ door & rmConnectsTo .~ S.member (OnEdge North)] rm
|
||||
adddoor rm = treeFromPost [door & rmConnectsTo .~ S.member (OnEdge North)] rm
|
||||
|
||||
crAdd :: Room -> Room
|
||||
crAdd = rmPmnts .:~ sPS (V2 20 10) (0.5*pi) randC1
|
||||
crAdd = rmPmnts .:~ sPS (V2 20 10) (0.5 * pi) randC1
|
||||
|
||||
rezBoxes :: RandomGen g => State g (MetaTree Room String)
|
||||
rezBoxes = do
|
||||
w <- state $ randomR (100,400)
|
||||
h <- state $ randomR (40,40)
|
||||
w <- state $ randomR (100, 400)
|
||||
h <- state $ randomR (40, 40)
|
||||
thecol <- rezColor
|
||||
let bottomEdgeTest = S.member (OnEdge South) . _rlType
|
||||
dbox = treeFromPost [ door & rmConnectsTo .~ S.member (OnEdge South)]
|
||||
(rezInvBox thecol)
|
||||
centralRoom <- shuffleLinks $ (roomRectAutoLinks w h) {_rmPmnts = []}
|
||||
& rmLinks %~ setInLinks bottomEdgeTest
|
||||
let bottomEdgeTest = S.member (OnEdge South) . _rlType
|
||||
dbox =
|
||||
treeFromPost
|
||||
[door & rmConnectsTo .~ S.member (OnEdge South)]
|
||||
(rezInvBox thecol)
|
||||
centralRoom <-
|
||||
shuffleLinks $
|
||||
(roomRectAutoLinks w h){_rmPmnts = []}
|
||||
& rmLinks %~ setInLinks bottomEdgeTest
|
||||
let n = length $ filter bottomEdgeTest $_rmLinks centralRoom
|
||||
return $ tToBTree "rezBoxes" $treeFromTrunk [rezBox thecol, door]
|
||||
$ Node centralRoom (replicate (n-1) dbox ++ [Node (cleatOnward door) []])
|
||||
return $
|
||||
tToBTree "rezBoxes" $treeFromTrunk [rezBox thecol, door] $
|
||||
Node centralRoom (replicate (n -1) dbox ++ [Node (cleatOnward door) []])
|
||||
|
||||
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]
|
||||
h <- takeOne [30, 50, 80, 90, 90, 90, 90]
|
||||
rad <- takeOne [150, 200, 200, 250, 250, 300, 300, 300]
|
||||
return $ lsPosColRad (V3 0 0 h) col rad
|
||||
|
||||
rezInvBox :: LightSource -> Room
|
||||
@@ -131,6 +134,6 @@ 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 (x : xs) = sPS (V2 15 30) 1 (PutFlIt wp) : g x : xs
|
||||
f _ = [sPS (V2 15 30) 1 (PutFlIt wp)]
|
||||
g x = x & plIDCont .~ const flickerMod
|
||||
|
||||
Reference in New Issue
Block a user