Allow for more complex placement positioning
This commit is contained in:
@@ -16,6 +16,7 @@ module Dodge.Room.Link
|
||||
, changeLinkTo
|
||||
, changeLinkFrom
|
||||
, randomiseOutLinks
|
||||
, chooseOneInLink
|
||||
) where
|
||||
import Dodge.Placement.PlaceSpot
|
||||
import Dodge.LevelGen.Data
|
||||
@@ -29,6 +30,17 @@ import Control.Monad.State
|
||||
import Control.Lens
|
||||
import Data.List
|
||||
import qualified Data.Set as S
|
||||
--import System.Random
|
||||
|
||||
chooseOneInLink :: RandomGen g => Room -> State g Room
|
||||
chooseOneInLink r = restrictToFstInLink <$> shuffleLinks r
|
||||
|
||||
restrictToFstInLink :: Room -> Room
|
||||
restrictToFstInLink = rmLinks %~ f
|
||||
where
|
||||
f (rl:xs) | S.member InLink (_rlType rl) = rl : restrictLinkType InLink (const False) xs
|
||||
| otherwise = rl : f xs
|
||||
f [] = []
|
||||
|
||||
{- Shuffle the initial links of a room randomly. -}
|
||||
randomiseOutLinks :: RandomGen g => Room -> State g Room
|
||||
|
||||
@@ -5,10 +5,12 @@ module Dodge.Room.LongDoor where
|
||||
import Dodge.Data
|
||||
import Dodge.RoomLink
|
||||
import Dodge.Base
|
||||
import Dodge.Tree
|
||||
import Dodge.Default.Room
|
||||
import Dodge.LevelGen.Data
|
||||
import Dodge.Placement.Instance
|
||||
import Dodge.Room.Link
|
||||
import Dodge.Room.Door
|
||||
import Dodge.Room.Procedural
|
||||
--import Dodge.Layout.Tree.Either
|
||||
--import Dodge.LevelGen.Data
|
||||
@@ -20,6 +22,8 @@ import Dodge.LightSource
|
||||
import Picture
|
||||
import Geometry
|
||||
|
||||
import qualified Data.Set as S
|
||||
import Data.Tree
|
||||
import System.Random
|
||||
import Control.Lens
|
||||
import Control.Monad.State
|
||||
@@ -106,7 +110,7 @@ addButtonSlowDoor x h rm = do
|
||||
,( V2 (x/2+50) 5,0::Float)
|
||||
]
|
||||
thePlacement <- takeOne [butDoor butPos butRot ]
|
||||
shuffleLinks $ setOutLinks aboveH $ setInLinks belowH (rm
|
||||
shuffleLinks $ setOutLinksPD aboveH $ setInLinksPD belowH (rm
|
||||
& rmPmnts %~ (thePlacement :)
|
||||
& rmBound %~ (openDoorBound :)
|
||||
)
|
||||
@@ -116,9 +120,9 @@ addButtonSlowDoor x h rm = do
|
||||
aboveH y = (sndV2 . fst) y > h + 40
|
||||
butDoor _ _ = putLitButOnPos col butPosCond
|
||||
$ \btid -> Just $ putDoubleDoor False col (cond' btid) (V2 0 h) (V2 x h) 2
|
||||
butPosCond (UnusedLink (V2 x' y') a') | y' < 0.5 * h
|
||||
= Just (PS (V2 x' y') a' , PosPl (V2 x' y') a')
|
||||
butPosCond _ = Nothing
|
||||
butPosCond (UnusedLink (V2 x' y') a') _ | y' < 0.5 * h
|
||||
= Just (PS (V2 x' y') a' , UsedSpot (V2 x' y') a')
|
||||
butPosCond _ _ = Nothing
|
||||
--butPosCond _ = True -- y < h
|
||||
col = dim $ light red
|
||||
cond' btid w = w ^? buttons . ix btid . btState /= Just BtOff
|
||||
@@ -141,3 +145,12 @@ slowDoorRoom = do
|
||||
proom <- southPillarsRoom x y h
|
||||
addButtonSlowDoor x h (proom & rmPmnts %~ (++ (crits ++ barrels ++ lsources)))
|
||||
|
||||
slowDoorRoomRunPast :: RandomGen g => State g (SubCompTree Room)
|
||||
slowDoorRoomRunPast = do
|
||||
r <- slowDoorRoom
|
||||
return $ treeFromTrunk [PassDown door]
|
||||
(Node (PassDown r)
|
||||
[ singleUseAll door
|
||||
, return (UseLabel 0 $ door & rmConnectsTo .~ S.singleton InLink)
|
||||
]
|
||||
)
|
||||
|
||||
@@ -47,8 +47,9 @@ roomRect
|
||||
-> Room
|
||||
roomRect x y xn yn = defaultRoom
|
||||
{ _rmPolys = [rectNSWE y 0 0 x ]
|
||||
, _rmLinks = init lnks ++ [last lnks]
|
||||
, _rmLinks = lnks
|
||||
, _rmPath = concatMap doublePair pth
|
||||
, _rmPos = map (\p -> UnusedSpot p 0) posps
|
||||
, _rmPmnts = []
|
||||
, _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
|
||||
, _rmFloor = [Tile
|
||||
@@ -66,8 +67,10 @@ roomRect x y xn yn = defaultRoom
|
||||
wlnks = zip (map (+.+ V2 x 20) $ gridPoints 0 1 yd (yn+1)) (repeat (-pi/2))
|
||||
nlnks = zip (map (+.+ V2 20 y) $ gridPoints xd (xn+1) 0 1 ) (repeat 0 )
|
||||
slnks = zip (map (+.+ V2 20 0) $ gridPoints xd (xn+1) 0 1 ) (repeat pi )
|
||||
lnks = map toBothLnk $ nlnks ++ elnks ++ wlnks ++ slnks
|
||||
lnks = m North nlnks ++ m East elnks ++ m West wlnks ++ m South slnks
|
||||
m edge = map (lnkBothAnd (OnEdge edge))
|
||||
pth = linksAndPath' lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
|
||||
posps = map (+.+ V2 20 20) $ gridPoints xd xn yd yn
|
||||
{- Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size. -}
|
||||
-- it is not clear to me that this works for very small rooms (but it does seem
|
||||
-- to do so)
|
||||
|
||||
@@ -77,8 +77,8 @@ dirtPoly :: [Point2] -> PSType
|
||||
dirtPoly = PutBlock DirtBlock [1] dirtWall . reverse
|
||||
|
||||
-- | A single corridor with a destructible block blocking it.
|
||||
blockedCorridor' :: RandomGen g => State g Room
|
||||
blockedCorridor' = do
|
||||
blockedCorridorCloseBlocks :: RandomGen g => State g Room
|
||||
blockedCorridorCloseBlocks = do
|
||||
r <- state $ randomR (0,pi)
|
||||
theblocks <- takeOne
|
||||
[ -- [sPS (V2 20 40) r $ dirtPoly $ square 10]
|
||||
@@ -86,8 +86,10 @@ blockedCorridor' = do
|
||||
-- , 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 5 50) r $ dirtPoly $ square 10
|
||||
--, sPS (V2 35 35) (r+0.5) $ dirtPoly $ square 10
|
||||
[ sPS (V2 6 25) r $ dirtPoly $ square 10
|
||||
, sPS (V2 35 20) (r+0.5) $ dirtPoly $ square 10
|
||||
]
|
||||
]
|
||||
return $ corridor & rmPmnts .~ theblocks
|
||||
|
||||
+20
-20
@@ -53,8 +53,8 @@ roomPadCut ps p = defaultRoom
|
||||
, _rmPath = [(V2 0 0,p)]
|
||||
}
|
||||
roomPillars :: Room
|
||||
roomPillars = --over rmLinks init $ -- it is unclear to me the purpose of this: perhaps to get the in link in the center?
|
||||
set rmPmnts plmnts $ roomRect 240 240 2 2
|
||||
roomPillars = roomRect 240 240 2 2
|
||||
& rmPmnts .~ plmnts
|
||||
where
|
||||
plmnts = spanLightI (V2 120 24) (V2 120 216)
|
||||
: mntLS vShape (V2 12 12) (V3 25 25 70)
|
||||
@@ -106,8 +106,8 @@ glassSwitchBack = do
|
||||
hgt <- state $ randomR (400,600)
|
||||
wllen <- state $ randomR (60,wth/2-40)
|
||||
let hf = hgt/5
|
||||
con1 cond (UnusedLink (V2 x y) a) | cond y = Just (PS (V2 x y) a , PosPl (V2 x y) a)
|
||||
con1 _ _ = Nothing
|
||||
con1 cond (UnusedLink (V2 x y) a) _ | cond y = Just (PS (V2 x y) a , UsedSpot (V2 x y) a)
|
||||
con1 _ _ _ = Nothing
|
||||
plmnts =
|
||||
[ mntLightLnkCond $ con1 (< 0.5 * hgt)
|
||||
, mntLightLnkCond $ con1 (> 0.5 * hgt)
|
||||
@@ -134,8 +134,8 @@ glassSwitchBack = do
|
||||
|
||||
glassSwitchBackCrits :: RandomGen g => State g Room
|
||||
glassSwitchBackCrits = glassSwitchBack
|
||||
<&> rmPmnts %~ ([spNoID (PSRoomRand 0) (PutCrit miniGunCrit)
|
||||
, spNoID (PSRoomRand 1) randC1
|
||||
<&> rmPmnts %~ ([spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit miniGunCrit)
|
||||
, spNoID (PSRoomRand 1 (uncurry PS)) randC1
|
||||
] ++)
|
||||
|
||||
miniTree2 :: RandomGen g => State g (SubCompTree Room)
|
||||
@@ -182,7 +182,7 @@ rot90Around cen p = cen +.+ vNormal (p -.- cen)
|
||||
-- inside an inner tree
|
||||
roomMiniIntro :: RandomGen g => State g (SubCompTree Room)
|
||||
roomMiniIntro = do
|
||||
midroom <- join $ takeOne [miniTree2,glassLesson]
|
||||
midroom <- join $ takeOne [miniTree2] --,glassLesson]
|
||||
return $ chainUses [return $ UseAll door, midroom,return $ UseAll corridor]
|
||||
|
||||
roomCenterPillar :: RandomGen g => State g Room
|
||||
@@ -328,7 +328,7 @@ weaponLongCorridor :: RandomGen g => State g (SubCompTree Room)
|
||||
weaponLongCorridor = do
|
||||
root <- takeOne [tEast, tWest]
|
||||
connectingRoom <- takeOne
|
||||
[tEast & rmPmnts .~ [spanLightI (V2 (-40) 40) (V2 (-40) 80)]
|
||||
[tEast & rmPmnts .~ [spanLightI (V2 (-30) 40) (V2 (-30) 80)]
|
||||
]
|
||||
i1 <- state $ randomR (2,5)
|
||||
i2 <- state $ randomR (2,5)
|
||||
@@ -356,16 +356,16 @@ deadEndRoom = defaultRoom
|
||||
{- A random Either tree with a weapon and melee monster challenge. -}
|
||||
weaponRoom :: RandomGen g => State g (SubCompTree Room)
|
||||
weaponRoom = join $ takeOne
|
||||
[ weaponEmptyRoom
|
||||
, weaponUnderCrits
|
||||
, weaponBehindPillar
|
||||
, weaponBetweenPillars
|
||||
, weaponLongCorridor
|
||||
[-- weaponEmptyRoom
|
||||
--, weaponUnderCrits
|
||||
--, weaponBehindPillar
|
||||
weaponBetweenPillars
|
||||
--, weaponLongCorridor
|
||||
]
|
||||
|
||||
roomCCrits :: RandomGen g => State g Room
|
||||
roomCCrits = roomC 200 200
|
||||
<&> rmPmnts %~ (replicate 20 (spNoID (PSRoomRand 0) randC1) ++ )
|
||||
<&> rmPmnts %~ (replicate 20 (spNoID (PSRoomRand 0 (uncurry PS)) randC1) ++ )
|
||||
|
||||
longRoom :: RandomGen g => State g Room
|
||||
longRoom = do
|
||||
@@ -432,13 +432,13 @@ shootersRoom' = do
|
||||
shootersRoom1 :: RandomGen g => State g Room
|
||||
shootersRoom1 = shootersRoom' <&> rmPmnts %~
|
||||
( (
|
||||
RandomPlacement $ takeOne $ map (\i -> spNoID (PSRoomRand i) (PutCrit autoCrit))
|
||||
RandomPlacement $ takeOne $ map (\i -> spNoID (PSRoomRand i (uncurry PS)) (PutCrit autoCrit))
|
||||
[0,1,2]
|
||||
) :)
|
||||
|
||||
shootersRoom :: RandomGen g => State g Room
|
||||
shootersRoom = shootersRoom' <&> rmPmnts %~
|
||||
( map (\i -> spNoID (PSRoomRand i) (PutCrit autoCrit))
|
||||
( map (\i -> spNoID (PSRoomRand i (uncurry PS)) (PutCrit autoCrit))
|
||||
[0,1,2]
|
||||
++ )
|
||||
|
||||
@@ -477,9 +477,9 @@ pillarGrid = do
|
||||
pistolerRoom :: RandomGen g => State g Room
|
||||
pistolerRoom = pillarGrid
|
||||
<&> rmPmnts %~ (
|
||||
[spNoID (PSRoomRand 0) (PutCrit pistolCrit)
|
||||
,spNoID (PSRoomRand 0) (PutCrit pistolCrit)
|
||||
,spNoID (PSRoomRand 0) (PutCrit pistolCrit)
|
||||
[spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit pistolCrit)
|
||||
,spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit pistolCrit)
|
||||
,spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit pistolCrit)
|
||||
]
|
||||
++)
|
||||
|
||||
@@ -506,6 +506,6 @@ spawnerRoom = do
|
||||
x <- state $ randomR (250,300)
|
||||
y <- state $ randomR (300,400)
|
||||
roomWithSpawner <- roomC x y <&>
|
||||
rmPmnts %~ (spNoID (PSRoomRand 0) (PutCrit spawnerCrit) :)
|
||||
rmPmnts %~ (spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit spawnerCrit) :)
|
||||
aRoom <- airlock
|
||||
return $ treeFromTrunk [PassDown aRoom,PassDown corridor] $ singleUseAll roomWithSpawner
|
||||
|
||||
+6
-97
@@ -10,6 +10,7 @@ import Dodge.Default
|
||||
import Dodge.Tree
|
||||
import Dodge.RandomHelp
|
||||
import Dodge.Room.Door
|
||||
import Dodge.Room.RezBox
|
||||
import Dodge.Room.Corridor
|
||||
import Dodge.Room.Room
|
||||
import Dodge.Room.Link
|
||||
@@ -67,11 +68,11 @@ startRoom :: RandomGen g => Int -> State g (SubCompTree Room)
|
||||
startRoom i = join $ takeOne
|
||||
[-- roomMiniIntro
|
||||
--minigunfakeout
|
||||
rezBoxesWp
|
||||
, rezBoxesThenWeaponRoom
|
||||
, rezBoxThenWeaponRoom
|
||||
, rezBoxesWpCrit
|
||||
, runPastStart i
|
||||
-- rezBoxesWp
|
||||
rezBoxesThenWeaponRoom
|
||||
-- , rezBoxThenWeaponRoom
|
||||
-- rezBoxesWpCrit
|
||||
-- , runPastStart i
|
||||
]
|
||||
|
||||
runPastStart :: RandomGen g => Int -> State g (SubCompTree Room)
|
||||
@@ -85,33 +86,6 @@ rezBoxStart = do
|
||||
ls <- rezColor
|
||||
return $ treeFromPost [PassDown $ rezBox ls] (UseAll 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 = swapInOutLinks . 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 (SubCompTree Room)
|
||||
rezBoxesThenWeaponRoom = do
|
||||
@@ -124,72 +98,7 @@ rezBoxThenWeaponRoom = do
|
||||
rcol <- rezColor
|
||||
treeFromTrunk [PassDown $ rezBox rcol,PassDown door] <$> weaponRoom
|
||||
|
||||
rezBoxesWpCrit :: RandomGen g => State g (SubCompTree Room)
|
||||
rezBoxesWpCrit = do
|
||||
w <- state $ randomR (200,400)
|
||||
h <- state $ randomR (40,40)
|
||||
thecol <- rezColor
|
||||
theweapon <- randBlockBreakWeapon
|
||||
let bottomEdgeTest (V2 _ y,_) = y < 1
|
||||
bottomPassDownTest (V2 x y,_) = y < 1 && x < 21
|
||||
aroom = rezInvBox thecol
|
||||
centralRoom <- filterSortOutLinksOn bottomEdgeTest ((\(V2 a b) -> (b,a)) . fst) <$>
|
||||
(randomiseOutLinks =<< changeLinkTo bottomPassDownTest
|
||||
((roomRectAutoLinks w h) {_rmPmnts = []}))
|
||||
let n = length $ filter bottomEdgeTest $ map lnkPosDir $ _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 [PassDown $ rezBox thecol
|
||||
, PassDown door
|
||||
]
|
||||
(Node (PassDown centralRoom) (rezrooms ++ [onwardtree blcor]))
|
||||
where
|
||||
adddoor rm = treeFromPost [PassDown door] (PassDown rm)
|
||||
onwardtree blcor = treeFromPost [PassDown door] (UseAll blcor)
|
||||
|
||||
rezBoxesWp :: RandomGen g => State g (SubCompTree 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 $ map lnkPosDir $_rmLinks centralRoom
|
||||
let rezrooms = map adddoor
|
||||
$ wpAdd theweapon aroom : replicate (n-2) aroom
|
||||
centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
|
||||
return $ treeFromTrunk [PassDown $ rezBox thecol
|
||||
, PassDown door
|
||||
]
|
||||
(Node (PassDown centralRoom') (rezrooms ++ [onwardtree blcor]))
|
||||
where
|
||||
adddoor rm = treeFromPost [PassDown door] (PassDown rm)
|
||||
onwardtree blcor = treeFromPost [PassDown door] (UseAll blcor)
|
||||
|
||||
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 <- 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) []]))
|
||||
|
||||
startRoom' :: RandomGen g => State g (SubCompTree Room)
|
||||
startRoom' = do
|
||||
|
||||
Reference in New Issue
Block a user