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

Add rooms, placements and room positions

Browse Source
This commit is contained in:
justin
2022-03-08 22:57:58 +00:00
parent 2e1c7f2687
commit ff6064a3b6
14 changed files with 315 additions and 138 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/LongDoor.hs
+2 -2
View File
@@ -118,8 +118,8 @@ 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' , UsedSpot (V2 x' y') a')
butPosCond (UnusedLink (V2 x' y') a' _) _ | y' < 0.5 * h
= Just (PS (V2 x' y') a' , UsedSpot (V2 x' y') a' (S.singleton RoomPosExLink))
butPosCond _ _ = Nothing
--butPosCond _ = True -- y < h
col = dim $ light red
src/Dodge/Room/Procedural.hs
+29 -7
View File
@@ -4,6 +4,7 @@ module Dodge.Room.Procedural
( roomRect
, roomRectAutoLinks
, randomFourCornerRoom
, randomFourCornerRoomCrsIts
, centerVaultRoom
, combineRooms
, linksAndPath
@@ -32,11 +33,13 @@ import Geometry
import Picture
import Data.Tile
import qualified Data.Set as S
import qualified Data.IntMap.Strict as IM
import Control.Lens
import Control.Monad
import Control.Monad.State
import System.Random
-- This will need a cleanup, but it might change a bit first
{- A simple rectangular room with a light in the center.
Creates links and pathfinding graph. -}
roomRect
@@ -49,7 +52,8 @@ roomRect x y xn yn = defaultRoom
{ _rmPolys = [rectNSWE y 0 0 x ]
, _rmLinks = lnks
, _rmPath = concatMap doublePair pth
, _rmPos = map (`UnusedSpot` 0) posps
, _rmPos = map (\pd -> UnusedSpot pd 0 $ S.singleton RoomPosOnPath) posps
++ map (\pd -> UnusedSpot pd 0 $ S.singleton RoomPosOffPath) interposps
, _rmPmnts = []
, _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
, _rmFloor = Tiled [Tile
@@ -67,10 +71,14 @@ 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 = m North nlnks ++ m East elnks ++ m West wlnks ++ m South slnks
m edge = map (lnkBothAnd (OnEdge edge))
lnks = zipWith (m North FromWest) [0..] nlnks
++ zipWith (m East FromSouth) [0..] elnks
++ zipWith (m West FromSouth) [0..] wlnks
++ zipWith (m South FromWest) [0..] slnks
m edge = 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+1) yd (yn+1)
interposps = map (+.+ V2 (20 + xd/2) (20 + yd/2)) $ 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)
@@ -80,7 +88,8 @@ roomRectAutoLinks x y = (roomRect x y xn yn)
where
xn = max 1 $ (ceiling x - 40) `div` 60
yn = max 1 $ (ceiling y - 40) `div` 60
plmnts = [mntLightLnkCond unusedLnkToPS ]
plmnts = [mntLightLnkCond unusedLnkToPS
, mntLightLnkCond unusedLnkToPS ]
{- Combines two rooms into one room.
- will have to work out exactly what to do with combining links
Mostly involves concatenation. -}
@@ -193,9 +202,10 @@ fillNothingPlacements pst r = foldr fillNothingPlacement r pst
{- | Randomise the ordering of placements in a room.
Useful for randomising the position of generic placements such as 'PutNothing'. -}
shufflePlacements :: RandomGen g => Room -> State g Room
shufflePlacements r = do
newPSs <- shuffle $ _rmPmnts r
return $ r & rmPmnts .~ newPSs
shufflePlacements = rmPmnts shuffle
--shufflePlacements r = do
-- newPSs <- shuffle $ _rmPmnts r
-- return $ r & rmPmnts .~ newPSs
{- | A randomly generate room based on four randomly generated corners.
Tight corridors, random placements. -}
randomFourCornerRoom :: RandomGen g => [Item] -> State g Room
@@ -211,6 +221,18 @@ randomFourCornerRoom its = do
. foldr1 combineRooms
$ zipWith (\r a -> moveRoomBy (V2 0 0,a) r) corners [0,pi/2,pi,3*pi/2]
)
{- | A randomly generate room based on four randomly generated corners.
Tight corridors. -}
randomFourCornerRoomCrsIts :: RandomGen g => [Creature] -> [Item] -> State g Room
randomFourCornerRoomCrsIts crits its = do
corners <- replicateM 4 . join $ takeOne [quarterRoomTri 100, quarterRoomSquare 100]
itms <- shuffle its
randomiseAllLinks . fillNothingPlacements (map PutCrit crits ++ map PutFlIt itms) =<<
( shufflePlacements
. over rmPmnts ( sps0 putLamp :)
. foldr1 combineRooms
$ zipWith (\r a -> moveRoomBy (V2 0 0,a) r) corners [0,pi/2,pi,3*pi/2]
)
{- | Creates room with a central vault with doors around it. -}
centerVaultRoom
:: Float -- ^ Width
src/Dodge/Room/Room.hs
+2 -1
View File
@@ -24,6 +24,7 @@ import Tile
import MonadHelp
import LensHelp
import qualified Data.Set as S
import Control.Monad.State
--import Control.Monad.Loops
import System.Random
@@ -82,7 +83,7 @@ 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 , UsedSpot (V2 x y) a)
con1 cond (UnusedLink (V2 x y) a _) _ | cond y = Just (PS (V2 x y) a , UsedSpot (V2 x y) a $ S.singleton RoomPosExLink)
con1 _ _ _ = Nothing
plmnts =
[ mntLightLnkCond $ con1 (< 0.5 * hgt)
src/Dodge/Room/Start.hs
+13 -18
View File
@@ -1,7 +1,9 @@
module Dodge.Room.Start where
import Dodge.Data
import Dodge.LevelGen.Data
--import Dodge.PlacementSpot
import Dodge.Room.RunPast
import Dodge.Room.Tanks
--import Dodge.RoomLink
--import Dodge.Data
--import Dodge.Default
@@ -14,18 +16,13 @@ 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.Item.Craftable
--import Dodge.LevelGen.Data
--import Geometry.Data
import Geometry
--import Padding
import Color
import Shape
--import Shape
import LensHelp
--import Data.Maybe
@@ -90,18 +87,16 @@ rezBoxThenWeaponRoom = do
rcol <- rezColor
treeFromTrunk [PassDown $ rezBox rcol,PassDown door] <$> weaponRoom
startCrafts :: RandomGen g => State g [Item]
startCrafts = takeOne $ map (map makeTypeCraft)
[ [PIPE,PIPE,HARDWARE]
, [TUBE,PIPE,HARDWARE]
]
startRoom' :: RandomGen g => State g (SubCompTree Room)
startRoom' = do
w <- state $ randomR (100,400)
h <- state $ randomR (200,400)
let plmnts =
[ sPS (V2 0 0) 0 $ PutShape $ 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
, sps0 $ PutShape $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
]
scrafts <- startCrafts
troom <- tanksRoom [] scrafts
thecol <- rezColor
treeFromPost [PassDown $ rezBox thecol, PassDown door] . UseAll
<$> shuffleLinks (roomRectAutoLinks w h & rmPmnts .++~ plmnts)
<$> shuffleLinks troom
src/Dodge/Room/Tanks.hs
+48
View File
@@ -0,0 +1,48 @@
module Dodge.Room.Tanks where
import Dodge.Data
import Dodge.LevelGen.Data
import Dodge.RandomHelp
import Dodge.Room.Procedural
import Dodge.Room.Foreground
--import Dodge.Room.RoadBlock
import Dodge.Placement.Instance
import Dodge.PlacementSpot
--import Padding
import Color
--import Shape
import LensHelp
--import Data.Maybe
--import Data.Tree
import Control.Monad.State
import System.Random
import qualified Data.Set as S
randomTank :: RandomGen g => State g Placement
randomTank = takeOne $ map (\f -> f (dim orange) orange)
[ tankSquareEmboss4
, tankSquareEmboss
, tankSquare
, roundTank
, roundTankCross
, tankSquareCross
]
tanksRoom :: RandomGen g => [Creature] -> [Item] -> State g Room
tanksRoom crs its = do
w <- state $ randomR (100,400)
h <- state $ randomR (200,400)
ntanks <- state $ randomR (3,6)
thetank <- randomTank <&> plSpot .~ unusedOffPathAwayFromLink 50
let room = roomRectAutoLinks w h
nwestlnks = length $ filter ((OnEdge West `S.member`) . _rlType) $ _rmLinks room
let plmnts =
--[ twoRoomPoss (isUnusedLinkType (OnEdge West)) (isUnusedLinkType (OnEdge East)) $ \ps1 ps2 ->
[ twoRoomPoss (isUnusedLinkType (FromSouth i)) (isUnusedLinkType (FromSouth i)) $ \ps1 ps2 ->
sps0 $ PutShape $ girderV 96 20 10 (_psPos ps1) (_psPos ps2)
| i <- [1 .. nwestlnks - 2]]
++ map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) its
++ map (\cr -> sps0 (PutCrit cr) & plSpot .~ unusedSpotAwayFromLink 50) crs
++ replicate ntanks thetank
-- , sps0 $ PutShape $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
return $ room & rmPmnts .++~ plmnts