justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Add more information to Room Positions

Browse Source
This commit is contained in:
justin
2022-06-15 12:34:36 +01:00
parent bf1bfa5453
commit 62dae5bebe
12 changed files with 192 additions and 112 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Containing.hs
+10 -7
View File
@@ -21,9 +21,11 @@ roomsContaining crs its = tToBTree "roomsContaining" <$> roomsContaining' crs it
roomsContaining' :: RandomGen g => [Creature] -> [Item] -> State g (Tree Room)
roomsContaining' crs its = do
endroom <- join $ takeOne
[ randomFourCornerRoomCrsIts crs its
, tanksRoom crs its
, roomPillarsContaining crs its
[roomPillarsSquare
-- [ randomFourCornerRoomCrsIts crs its
-- , tanksRoom crs its
-- , roomPillarsContaining crs its
-- , roomPillarsPassage <&> rmPmnts .++~ crsItmsUnused crs its
]
return (pure $ cleatOnward endroom)
@@ -31,10 +33,11 @@ roomPillarsContaining :: RandomGen g => [Creature] -> [Item] -> State g Room
roomPillarsContaining crs itms = do
(w,wn) <- takeOne [(240,2),(340,3)]
(h,hn) <- takeOne [(240,2),(340,3)]
let plmnts =
map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) itms
++ map (\cr -> sps0 (PutCrit cr) & plSpot .~ unusedSpotAwayFromLink 50) crs
roomPillars 30 w h wn hn <&> rmPmnts .++~ plmnts
roomPillars 30 w h wn hn <&> rmPmnts .++~ crsItmsUnused crs itms
crsItmsUnused :: [Creature] -> [Item] -> [Placement]
crsItmsUnused crs itms = map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) itms
++ map (\cr -> sps0 (PutCrit cr) & plSpot .~ unusedSpotAwayFromLink 50) crs
pedestalRoom :: RandomGen g => Item -> State g Room
src/Dodge/Room/Path.hs
+16 -3
View File
@@ -4,6 +4,7 @@ module Dodge.Room.Path
, linksAndPath'
, makeGrid
, createPathGrid
, gridPoints''
)
where
--import Dodge.LevelGen.Data
@@ -85,10 +86,22 @@ makeGrid x nx y ny
. concatMap (\p -> map (Tup.both (p +.+)) $ makeRect x y)
$ gridPoints x nx y ny
--gridPoints :: Float -> Int -> Float -> Int -> [Point2]
--gridPoints x nx y ny = [V2 a b | a <- take nx $ scanl (+) 0 $ repeat x
-- , b <- take ny $ scanl (+) 0 $ repeat y
-- ]
gridPoints :: Float -> Int -> Float -> Int -> [Point2]
gridPoints x nx y ny = [V2 a b | a <- take nx $ scanl (+) 0 $ repeat x
, b <- take ny $ scanl (+) 0 $ repeat y
]
gridPoints x nx y ny = map f $ gridPoints' nx ny
where
f (a,b) = V2 (fromIntegral a * x) (fromIntegral b * y)
gridPoints'' :: Float -> Int -> Float -> Int -> [(Point2,(Int,Int))]
gridPoints'' x nx y ny = map f $ gridPoints' nx ny
where
f (a,b) = (V2 (fromIntegral a * x) (fromIntegral b * y), (a,b))
gridPoints' :: Int -> Int -> [(Int,Int)]
gridPoints' nx ny = [(x,y) | x <- [0..nx-1], y <- [0..ny-1]]
makeRect :: Float -> Float -> [(Point2,Point2)]
makeRect x y = map (bimap toV2 toV2) [((0,0),(x,0))
src/Dodge/Room/Pillar.hs
+28 -3
View File
@@ -7,6 +7,7 @@ import Dodge.LevelGen.Data
import Dodge.Placement.Instance
--import Dodge.LevelGen.Data
import Dodge.Room.Procedural
import Dodge.Room.Link
import Geometry
import LensHelp
@@ -28,6 +29,9 @@ blockPillar w' h' = ps0jPushPS (aline tl tr)
bl = V2 (-w) (-h)
aline = PutLineBlock baseBlockPane StoneBlock 9 9
smallPillar :: PSType
smallPillar = PutBlock StoneBlock 5 [5,5] baseBlockPane $ reverse $ square 5
crossPillar :: Float -> Float -> Placement
crossPillar w' h' = ps0jPushPS (aline (V2 (-w) 0) (V2 w 0))
$ sps0 (aline (V2 0 (-h)) (V2 0 h))
@@ -36,14 +40,35 @@ crossPillar w' h' = ps0jPushPS (aline (V2 (-w) 0) (V2 w 0))
h = h' - 9
aline = PutLineBlock baseBlockPane StoneBlock 9 9
--longPillars :: Float -> Float
roomPillarsSquare :: RandomGen g => State g Room
roomPillarsSquare = return $ roomRectAutoLinks 400 400
& rmPmnts .++~ [sps (rprBool $ \rp _ -> t rp) smallPillar
,sps (rprBool $ \rp _ -> t rp) smallPillar
,sps (rprBool $ \rp _ -> t rp) smallPillar
,sps (rprBool $ \rp _ -> t rp) smallPillar
,sps (rprBool $ \rp _ -> t rp) smallPillar
]
where
t rp = any f (_rpType rp) && _rpPlacementUse rp == 0
f rpt = maybe False (PathFromEdge West 1 `S.member`) (rpt ^? onPathEdges)
roomPillarsPassage :: RandomGen g => State g Room
roomPillarsPassage = do
let rm = roomRect 100 300 1 3
shuffleLinks $ rm & rmPmnts .~
[mntLS iShape (V2 50 0) (V3 50 10 90)
,mntLS iShape (V2 50 300) (V3 50 290 90)
,mntLS iShape (V2 0 150) (V3 10 150 90)
,mntLS iShape (V2 100 150) (V3 90 150 90)
] ++
[ sPS (V2 30 y) 0 smallPillar | y <- [50,90.. 250] ] ++
[ sPS (V2 70 y) 0 smallPillar | y <- [50,90.. 250] ]
roomPillars :: RandomGen g => Float -> Float -> Float -> Int -> Int -> State g Room
roomPillars pillarsize w h wn hn = do
let rm = roomRect w h wn hn
npillars = length $ filter (S.member RoomPosOffPath . _rpType) $ _rmPos rm
npillars = length $ filter rpIsOffPath $ _rmPos rm
let plmnts = replicate npillars (blockPillar (0.5*pilw) (0.5*pilh) & plSpot .~ rprBool
(\rp _ -> RoomPosOffPath `S.member` _rpType rp
(\rp _ -> rpIsOffPath rp
&& _rpPlacementUse rp == 0
&& _rpLinkStatus rp == NotLink )
)
src/Dodge/Room/Procedural.hs
+11 -2
View File
@@ -49,8 +49,9 @@ roomRect x y xn yn = defaultRoom
, _rmLinks = lnks
, _rmName = "rect"
, _rmPath = concatMap doublePair pth
, _rmPos = map (roomposat RoomPosOnPath) posps
++ map (roomposat RoomPosOffPath) interposps
--, _rmPos = map (roomposat (RoomPosOnPath S.empty)) posps
, _rmPos = map (makeonpos) posps'
++ map (roomposat (RoomPosOffPath S.empty)) interposps
, _rmPmnts = []
, _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
, _rmFloor = Tiled [Tile
@@ -85,6 +86,14 @@ roomRect x y xn yn = defaultRoom
m edge edgefrom1 edgefrom2 = zipWith (lnkBothAnd (OnEdge edge) edgefrom1 edgefrom2) [0..]
. zipCountDown
pth = linksAndPath' lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
makeonpos (p,a) = RoomPos p 0 (S.singleton $ RoomPosOnPath $ makerpedges a) NotLink 0
makerpedges (a,b) = S.fromList
[PathFromEdge South b
,PathFromEdge North (yn-b)
,PathFromEdge East (yn-a)
,PathFromEdge West a
]
posps' = map (over _1 (+.+ V2 20 20)) $ gridPoints'' xd (xn+1) yd (xn+1)
posps = map (+.+ V2 20 20) $ gridPoints xd (xn+1) yd (yn+1)
interposps = map (+.+ V2 (20 + xd/2) (20 + yd/2)) $ gridPoints xd xn yd yn
src/Dodge/Room/Room.hs
+7 -7
View File
@@ -40,9 +40,9 @@ roomC :: RandomGen g => Float -> Float -> State g Room
roomC w h = do
wallf <- takeOne [ crystalLine , windowLine ]
ntanks <- takeOne [0,0,0,0,0,1,1,1,1,2,3,4]
thetank <- randomTank <&> plSpot .~ (rprBool $ \rp _ ->
thetank <- randomTank <&> plSpot .~ rprBool (\rp _ ->
_rpPlacementUse rp == 0
&& RoomPosOffPath `S.member` _rpType rp
&& rpIsOffPath rp
&& (xV2 (_rpPos rp) > w / 2 + 5 || xV2 (_rpPos rp) < w / 2 - 5 ))
maybeaddgird <- takeOne [return, addRandomGirderFrom West 0, addRandomGirderFrom North 0]
maybeaddgird =<< shuffleLinks (roomRectAutoLinks w h
@@ -196,14 +196,14 @@ weaponBetweenPillars = do
(w,wn) <- takeOne [(240,2),(340,3)]
(h,hn) <- takeOne [(240,2),(340,3)]
let wpPos = rprBool $ \rp r -> and
[ RoomPosOnPath `S.member` _rpType rp
[ rpIsOnPath rp
, _rpPlacementUse rp == 0
, _rpLinkStatus rp == NotLink
, any ((<100) . dist (_rpPos rp)) (usedRoomInLinkPoss r)
]
ncrits <- state $ randomR (1,3)
critPlacementSpots <- replicateM ncrits $ randDirPS $ rprBool $ \rp r ->
RoomPosOnPath `S.member` _rpType rp
rpIsOnPath rp
&& _rpPlacementUse rp == 0
&& all ((>100) . dist (_rpPos rp)) (usedRoomLinkPoss r)
fmap pure $ roomPillars 30 w h wn hn
@@ -242,7 +242,7 @@ deadEndRoom = defaultRoom
weaponRoom :: RandomGen g => Int -> State g (MetaTree Room String)
weaponRoom i = join $ takeOne
[ weaponEmptyRoom >>= rToOnward "weaponEmptyRoom"
, weaponUnderCrits i
, weaponUnderCrits i -- this int is used for PickOnePlacement
, weaponBehindPillar >>= rToOnward "weaponBehindPillar"
, weaponBetweenPillars >>= rToOnward "weaponBetweenPillars"
, weaponLongCorridor >>= rToOnward "weaponLongCorridor"
@@ -300,7 +300,7 @@ pistolerRoom :: RandomGen g => State g Room
pistolerRoom = do
(w,wn) <- takeOne [(200,3),(255,4)]
roomPillars 10 w 200 wn 3 <&> rmPmnts .++~ replicate 3
(spNoID (rprBool $ \rp _ -> _rpPlacementUse rp == 0 && RoomPosOnPath `S.member` _rpType rp)
(spNoID (rprBool $ \rp _ -> _rpPlacementUse rp == 0 && rpIsOnPath rp)
(PutCrit pistolCrit))
shootingRange :: RandomGen g => State g (MetaTree Room String)
@@ -328,7 +328,7 @@ spawnerRoom = do
x <- state $ randomR (250,300)
y <- state $ randomR (300,400)
roomWithSpawner <- roomC x y <&> rmPmnts .:~ spNoID
(rprBool $ \rp _ -> _rpPlacementUse rp == 0 && RoomPosOnPath `S.member` _rpType rp
(rprBool $ \rp _ -> _rpPlacementUse rp == 0 && rpIsOnPath rp
&& xV2 (_rpPos rp) < x/2 && yV2 (_rpPos rp) < y/2 )
(PutCrit spawnerCrit)
aRoom <- airlock
src/Dodge/Room/Start.hs
+1
View File
@@ -55,6 +55,7 @@ powerFakeout = do
, keyholeCorridor, corridor
,cleatOnward door]
-- the i is used either for a PickOnePlacement or a room id, this is not great
startRoom :: RandomGen g => Int -> State g (MetaTree Room String)
startRoom i = join $ takeOne
[ attachOnward "startThenWeaponRoom" <$> preCritStart <*> weaponRoom i