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

Allow for complex room bounds for clip checks

Browse Source
This commit is contained in:
jgk
2021-05-03 00:57:17 +02:00
parent f71724ae8b
commit 2bf23db935
14 changed files with 92 additions and 152 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Airlock.hs
+4 -4
View File
@@ -28,7 +28,7 @@ airlockOneWay n = Room
(M.insert (DoorNumOpen n) True))
]
--, _rmBound = rectNSWE 90 30 (-30) 30
, _rmBound = rectNSWE 75 15 0 40
, _rmBound = [rectNSWE 75 15 0 40]
}
where lnks = [((0,85),0)
,((0, 5),pi)
@@ -66,7 +66,7 @@ airlock0 n = Room
(over worldState (M.insert (DoorNumOpen n) False))
,PS (-25, 50) 0 putLamp
]
, _rmBound = rectNSWE 75 15 0 40
, _rmBound = [rectNSWE 75 15 0 40]
}
where
lnks = [((20,95),0)
@@ -105,12 +105,12 @@ airlock90 n = Room
,PS (60, 60) 0 putLamp
]
, _rmBound =
[ (10,10)
[[ (10,10)
, (10,100)
, (100,150)
, (150,100)
, (100,10)
]
]]
}
where
cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
src/Dodge/Room/Boss.hs
+23 -2
View File
@@ -35,13 +35,14 @@ roomOctogon x = Room
,crystalLine (negate $ x/2,-x) (-x,negate (x/2))
,blockLine (-40,40-x) (40,40-x)
]
, _rmBound = rectNSWE x (-x) (-x) x
, _rmBound = [rectNSWE x (-x) (-x) x]
}
where
fx = 4 * x / 5
bossRoom :: RandomGen g => Creature -> State g Room
bossRoom cr = pure $ roomOctogon 300 & rmPS %~ ( PS (0,100) (negate $ pi/2) (PutCrit cr) :)
--bossRoom cr = pure $ roomOctogon 300 & rmPS %~ ( PS (0,100) (negate $ pi/2) (PutCrit cr) :)
bossRoom cr = pure $ roomCross 200 300 & rmPS %~ ( PS (0,100) (negate $ pi/2) (PutCrit cr) :)
armouredChasers :: RandomGen g => State g Room
armouredChasers = do
@@ -52,3 +53,23 @@ armouredChasers = do
where
cs = (armourChaseCrit & crState . crDropsOnDeath .~ DropSpecific [0])
: replicate 4 chaseCrit
roomCross
:: Float -- ^ First width/2
-> Float -- ^ Second width/2
-> Room
roomCross x y = Room
{ _rmPolys = [rectNSWE y (-y) (-x) x
,rectNSWE (-x) x y (-y)
]
, _rmLinks = [((x,y-20),negate $ pi/2)]
, _rmPath = []
, _rmPS =
[PS ( x, 0) 0 putLamp
,PS (-x, 0) 0 putLamp
,PS ( 0, x) 0 putLamp
,PS ( 0,-x) 0 putLamp
]
, _rmBound = [rectNSWE x (-x) (-x) x]
}
where
src/Dodge/Room/Corridor.hs
+4 -4
View File
@@ -15,7 +15,7 @@ corridor = Room
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (20,60) . fst) lnks
, _rmPS = []
, _rmBound = rectNSWE 50 30 0 40
, _rmBound = [ rectNSWE 50 30 0 40 ]
}
where
lnks =
@@ -31,7 +31,7 @@ corridorN = Room
, _rmLinks = lnks
, _rmPath = pth
, _rmPS = []
, _rmBound = rectNSWE 50 30 0 40
, _rmBound = [ rectNSWE 50 30 0 40 ]
}
where lnks = [((20,70) ,0)
,((20,10) ,pi)
@@ -46,7 +46,7 @@ tEast = Room
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (0,60) . fst) lnks
, _rmPS = []
, _rmBound = rectNSWE 70 10 0 40
, _rmBound = [ rectNSWE 70 10 0 40 ]
}
where lnks = [(( 30,60),-pi/2)
,((-30,60),pi/2)
@@ -60,7 +60,7 @@ tWest = Room
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (0,60) . fst) lnks
, _rmPS = []
, _rmBound = rectNSWE 70 10 0 40
, _rmBound = [ rectNSWE 70 10 0 40 ]
}
where
lnks =
src/Dodge/Room/Data.hs
+1 -1
View File
@@ -21,6 +21,6 @@ data Room = Room
, _rmLinks :: [(Point2,Float)]
, _rmPath :: [(Point2, Point2)]
, _rmPS :: [PlacementSpot]
, _rmBound :: [Point2]
, _rmBound :: [ [Point2] ]
}
makeLenses ''Room
src/Dodge/Room/Link.hs
+1 -1
View File
@@ -69,7 +69,7 @@ shiftRoomBy shift@(pos,rot) r =
$ over rmLinks (fmap (shiftLinkBy shift))
$ over rmPath (map (shiftPathPointBy shift))
$ over rmPS (fmap (shiftPSBy shift))
$ over rmBound (map (shiftPointBy shift))
$ over rmBound (fmap (map (shiftPointBy shift)))
r
shiftLinkBy (pos,rot) (p,r) = (shiftPointBy (pos,rot) p, r + rot)
src/Dodge/Room/Procedural.hs
+21 -35
View File
@@ -4,7 +4,7 @@ Procedural creation of rooms and subroom parts.
module Dodge.Room.Procedural
( roomRect
, roomRectAutoLinks
, testRoom
, randomFourCornerRoom
, centerVaultRoom
) where
import Dodge.Data
@@ -43,7 +43,7 @@ roomRect x y xn yn = Room
, _rmLinks = lnks
, _rmPath = concatMap doublePair pth
, _rmPS = [PS (x/2,y/2) 0 putLamp]
, _rmBound = rectNSWE (y+5) (-5) (-5) (x+5)
, _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
}
where
yd = (y - 40) / fromIntegral yn
@@ -81,22 +81,17 @@ linksAndPath :: [(Point2,Float)] -> [(Point2,Point2)] -> [(Point2,Point2)]
linksAndPath lnks subpth = subpth ++ concatMap linkClosest lnks
where
linkClosest (p,_) = doublePair (p, minimumBy (compare `on` dist p) $ map fst subpth)
{- Combines two rooms into one room.
Combines into one big bound, concatenates the rest.
-}
Combines into one big bound, concatenates the rest. -}
combineRooms :: Room -> Room -> Room
combineRooms r r' = Room
{ _rmPolys = _rmPolys r ++ _rmPolys r'
, _rmLinks = _rmLinks r ++ _rmLinks r'
, _rmPath = _rmPath r ++ _rmPath r'
, _rmPS = _rmPS r ++ _rmPS r'
, _rmBound = convexHull . nubBy (\a b -> dist a b < 5) $ _rmBound r ++ _rmBound r'
, _rmBound = _rmBound r ++ _rmBound r'
}
{-
The top fourth of a room of a given height.
-}
{- The top fourth of a room of a given height. -}
fourth
:: Float -- ^ Distance from center of room to top edge
-> Room
@@ -107,24 +102,13 @@ fourth w = Room
, _rmPS =
[PS (0,w/2) 0 putLamp
]
, _rmBound = [(w,w),(-w,w)]
, _rmBound = [[(0,0),(w,w),(-w,w)]]
}
{-
Randomly generate a top fourth of a room possibly with a wall.
Add a light and a 'PutNothing' placement.
-}
{- Randomly generate a top fourth of a room possibly with a wall.
Add a light and a 'PutNothing' placement. -}
fourthWall :: RandomGen g => Float -> State g Room
fourthWall w = do
b <- takeOne
--[ [ PS (20-w,w-40) 0 putLamp
-- , PS (w-20,w-40) pi PutNothing
-- ]
-- [ [ PS (20-w,w-40) 0 putLamp
-- , PS (0,40) 0 putLamp
-- , PS (w-20,w-40) pi PutNothing
-- , blockLine (w/2,w) (negate $ w/2,w/2)
-- ]
[ [ PS (20-w,w-40) 0 putLamp
, PS (0,40) 0 putLamp
, PS (w-20,w-20) pi PutNothing
@@ -147,7 +131,7 @@ fourthWall w = do
, _rmLinks = [((0,w), 0)]
, _rmPath = [((0,w),(0,0)),((0,0),(0,w))]
, _rmPS = b
, _rmBound = [(w,w),(-w,w)]
, _rmBound = [[(0,0),(w,w),(-w,w)]]
}
fourthCorner :: Float -> Room
@@ -159,7 +143,7 @@ fourthCorner w = Room
]
, _rmPath = [((0,w),(0,0)),((0,0),(0,w))]
, _rmPS = [PS (0,w) 0 putLamp]
, _rmBound = [(w,w),(0,2*w),(-w,w)]
, _rmBound = [[(w,w),(0,2*w),(-w,w)]]
}
fourthCornerWall :: RandomGen g => Float -> State g Room
@@ -196,9 +180,9 @@ fourthCornerWall w = do
]
, _rmPath = [((0,w),(0,0)),((0,0),(0,w))]
, _rmPS = b
, _rmBound = [(w,w),(0,2*w),(-w,w)]
, _rmBound = [[(w,w),(0,2*w),(-w,w)]]
}
{- | Replace the first 'PutNothing' with a given 'PSType'. -}
fillNothingPlacement :: PSType -> Room -> Room
fillNothingPlacement pst r =
r & rmPS %~ replaceNothingWith pst
@@ -206,17 +190,20 @@ fillNothingPlacement pst r =
replaceNothingWith x (PS p rot PutNothing: pss) = PS p rot x : pss
replaceNothingWith x (ps:pss) = ps : replaceNothingWith x pss
replaceNothingWith _ [] = []
{- | Successively fill 'PutNothing' placements with a list of given 'PSType's.
-}
fillNothingPlacements :: [PSType] -> Room -> Room
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 $ _rmPS r
return $ r & rmPS .~ newPSs
testRoom :: RandomGen g => State g Room
testRoom = do
{- | A randomly generate room based on four randomly generated corners.
Tight corridors, random placements. -}
randomFourCornerRoom :: RandomGen g => State g Room
randomFourCornerRoom = do
corners <- replicateM 4 . join $ takeOne [fourthWall 100, fourthCornerWall 100]
nItms <- state $ randomR (1,2)
itms <- takeN nItms $ fmap PutFlIt $ [autoRadar,autoSonar,remoteLauncher,jetPack,blinkGun] ++ replicate 5 (medkit 500)
@@ -228,7 +215,6 @@ testRoom = do
. foldr1 combineRooms
$ zipWith (\r a -> shiftRoomBy ((0,0),a) r) corners [0,pi/2,pi,3*pi/2]
)
{- | Creates room with a central vault with doors around it.
-}
centerVaultRoom
@@ -268,7 +254,7 @@ centerVaultRoom n w h d = do
]
++ concat (zipWith (\i r -> map (shiftPSBy ((0,0),r)) $ theDoor i)
[n, n+1, n+2, n+3] [0,pi/2,pi,3*pi/2])
, _rmBound = rectNSWE h (-h) (-w) w
, _rmBound = [rectNSWE h (-h) (-w) w]
}
where
col = dim $ dim $ bright red
src/Dodge/Room/RoadBlock.hs
+1 -1
View File
@@ -47,7 +47,7 @@ litCorridor90 = do
, PS ( 20,h-40) 0 $ PutID 0
, PS (-20,h-80) 0 $ PutID 2
]
, _rmBound = poly
, _rmBound = [poly]
}
noWeaponTest :: RandomGen g => State g (Tree (Either Room Room))
src/Dodge/Room/Treasure.hs
+1 -1
View File
@@ -39,7 +39,7 @@ triLootRoom w h = pure $ Room
,PS (0,h-15) 0 putLamp
,PS (0,-60) 0 putLamp
]
, _rmBound = convexHull $ tri ++ base
, _rmBound = [tri , base]
}
where
tri =