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

Work towards cross-room placements

Browse Source
This commit is contained in:
justin
2021-11-12 11:13:59 +00:00
parent d63c2ac943
commit 1d5b2ea765
20 changed files with 147 additions and 165 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Airlock.hs
+5 -5
View File
@@ -26,7 +26,7 @@ airlock0 = defaultRoom
{ _rmPolys = [ rectNSWE 100 0 0 40 , rectNSWE 65 35 (-40) 20 ]
, _rmLinks = lnks
, _rmPath = [(V2 20 95,V2 20 45) ,(V2 20 45,V2 20 5) ]
, _rmPS =
, _rmPmnts =
[Placement (PS (V2 (-35) 50) (negate $ pi/2)) (PutButton $ makeSwitch col red id id)
$ \btid -> Just $ putDoubleDoorThen False col (not . cond' btid) (V2 (-1) 20) (V2 41 20) 2
$ Just $ putDoubleDoorThen False col (cond' btid) (V2 (-1) 80) (V2 41 80) 2 Nothing
@@ -48,7 +48,7 @@ airlockSimple = defaultRoom
[ rectNSWE 120 0 0 180 ]
, _rmLinks = lnks
, _rmPath = concatMap (doublePair. (V2 90 30,) . fst) lnks
, _rmPS =
, _rmPmnts =
[ Placement (PS (V2 90 115) pi) (PutButton $ makeSwitch col red id id)
$ \btid -> jspsJ (V2 0 0) 0 (PutDoor col (cond btid) outDoorps)
$ sPS (V2 180 0) 0 (PutDoor col (cond btid) inDoorps)
@@ -77,7 +77,7 @@ airlockZ = defaultRoom
-- [(V2 0 40,V2 40 0)
-- ,(V2 40 0,V2 0 40)
-- ]
, _rmPS =
, _rmPmnts =
[ Placement (PS (V2 90 115) pi) (PutButton $ makeSwitch col red id id)
$ \btid -> jspsJ (V2 0 60) 0 (PutDoor col (cond btid) outDoorps)
$ sPS (V2 180 60) 0 (PutDoor col (cond btid) inDoorps)
@@ -117,7 +117,7 @@ airlock90 = defaultRoom
[(V2 0 40,V2 40 0)
,(V2 40 0,V2 0 40)
]
, _rmPS =
, _rmPmnts =
[ Placement (PS (V2 120 120) (3 * pi/4)) (PutButton $ makeSwitch col red id id)
$ \btid -> jsps (V2 5 5) 0 $ PutDoor col (cond btid) pss
,mountLightV (V2 20 20) (V3 70 70 50)
@@ -145,7 +145,7 @@ airlockCrystal = defaultRoom
]
, _rmLinks = [(V2 20 130,0) ,(V2 20 0 ,pi) ]
, _rmPath = [ ]
, _rmPS =
, _rmPmnts =
[ Placement (PS (V2 145 70) (pi/2)) ( PutButton $ makeSwitch col red id id)
$ \btid -> jsps0 $ PutDoor col (cond btid) pss
, crystalLine (V2 0 70) (V2 40 70)
src/Dodge/Room/Boss.hs
+6 -6
View File
@@ -34,7 +34,7 @@ roomGlassOctogon x = createPathGrid $ defaultRoom
[ ( V2 0 x , V2 0 (-(x+40)))
, ( V2 0 (-(x+40)), V2 0 x)
]
, _rmPS =
, _rmPmnts =
[sPS (V2 fx fx) 0 putLamp
,sPS (V2 (-fx) fx) 0 putLamp
,sPS (V2 fx (-fx)) 0 putLamp
@@ -55,14 +55,14 @@ roomGlassOctogon x = createPathGrid $ defaultRoom
]
bossRoom :: RandomGen g => Creature -> State g Room
bossRoom cr = randomMediumRoom <&> rmPS %~ ( sPS (V2 0 100) (negate $ pi/2) (PutCrit cr) :)
bossRoom cr = randomMediumRoom <&> rmPmnts %~ ( sPS (V2 0 100) (negate $ pi/2) (PutCrit cr) :)
armouredChasers :: RandomGen g => State g (Tree Room)
armouredChasers = do
ps <- takeN 5 [V2 x y | x <- [-100,-80 .. 100] ,y <- [-100,-80 .. 100] ]
as <- replicateM 5 . state $ randomR (0,2*pi)
let theCrits = zipWith3 (\p a c -> sPS p a (PutCrit c)) ps as cs
treeFromPost [corridor,corridor] <$> (randomMediumRoom <&> rmPS %~ (++ theCrits))
treeFromPost [corridor,corridor] <$> (randomMediumRoom <&> rmPmnts %~ (++ theCrits))
where
cs = (armourChaseCrit & crState . crDropsOnDeath .~ DropSpecific [0])
: replicate 4 chaseCrit
@@ -94,7 +94,7 @@ roomCross x y = defaultRoom
,(V2 (y-20) (-x),pi)
]
, _rmPath = []
, _rmPS =
, _rmPmnts =
[ spanLightI (V2 (x+5) x) (V2 (x+5) (-x))
, spanLightI (V2 (-x-5) x) (V2 (-x-5) (-x))
]
@@ -119,7 +119,7 @@ roomShuriken x y =
{ _rmPolys = ps
, _rmLinks = [(V2 (x-1) (y-20),negate $ pi/2)]
, _rmPath = []
, _rmPS = [mountLight (V2 x x) (V3 (x-20) x 70)]
, _rmPmnts = [mountLight (V2 x x) (V3 (x-20) x 70)]
, _rmBound = ps
}
in foldr1 combineRooms $ map (\r -> shiftRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2]
@@ -143,7 +143,7 @@ roomTwistCross x y z =
{ _rmPolys = ps
, _rmLinks = [(V2 z (y-20), pi/2)]
, _rmPath = []
, _rmPS = [mountLight (V2 x x) (V3 (x-20) (x-20) 70)]
, _rmPmnts = [mountLight (V2 x x) (V3 (x-20) (x-20) 70)]
, _rmBound = ps
}
in foldr1 combineRooms $ map (\r -> shiftRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2]
src/Dodge/Room/Corridor.hs
+5 -5
View File
@@ -17,7 +17,7 @@ corridor = defaultRoom
{ _rmPolys = [poly]
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks
, _rmPS = [ spanLightI (V2 0 40) (V2 40 40) ]
, _rmPmnts = [ spanLightI (V2 0 40) (V2 40 40) ]
, _rmBound = [ rectNSWE 50 30 0 40 ]
, _rmFloor = [makeTileFromPoly poly 2]
}
@@ -39,7 +39,7 @@ corridorDebug = defaultRoom
]
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks
, _rmPS = []
, _rmPmnts = []
, _rmBound = [ rectNSWE 50 30 0 40 ]
}
where
@@ -55,7 +55,7 @@ corridorN = defaultRoom
]
, _rmLinks = lnks
, _rmPath = pth
, _rmPS = []
, _rmPmnts = []
, _rmBound = [ rectNSWE 50 30 0 40 ]
}
where lnks = [(V2 20 70 ,0)
@@ -70,7 +70,7 @@ tEast = defaultRoom
]
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (V2 0 60) . fst) lnks
, _rmPS = []
, _rmPmnts = []
, _rmBound = [ rectNSWE 70 10 0 40 ]
}
where
@@ -86,7 +86,7 @@ tWest = defaultRoom
]
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (V2 0 60) . fst) lnks
, _rmPS = []
, _rmPmnts = []
, _rmBound = [ rectNSWE 70 10 0 40 ]
}
where
src/Dodge/Room/Data.hs
+10 -5
View File
@@ -9,6 +9,7 @@ import Data.Tile
import Control.Monad.State
import System.Random
import Control.Lens
import qualified Data.IntMap.Strict as IM
{-
The '_rmPolys' list states which polygons should be cut out to form the indestructible walls of the room.
Link pairs contain a position and rotation to attach to another room;
@@ -21,9 +22,11 @@ assigning no bounds will allow rooms to overlap.
data Room = Room
{ _rmPolys :: [ [Point2] ]
, _rmLinks :: [(Point2,Float)]
, _rmUsedLinks :: [(Point2,Float)]
, _rmUsedLinks :: [RoomPos]
, _rmPath :: [(Point2, Point2)]
, _rmPS :: [Placement]
, _rmPmnts :: [Placement]
, _rmLabelledPmnts :: IM.IntMap Placement
, _rmPartialPmnts :: IM.IntMap (Int -> Placement)
, _rmBound :: [ [Point2] ]
, _rmFloor :: [Tile]
, _rmName :: String
@@ -32,7 +35,9 @@ data Room = Room
, _rmRandPSs :: [State StdGen (Point2,Float)]
}
data RoomPos
= Link (Point2,Float)
| UsedLink (Point2,Float)
| LinkInt Int (Point2,Float)
= OutLink Int Point2 Float
| InLink Point2 Float
| PosInt Int Point2 Float
| PosPl Point2 Float
deriving (Eq,Ord,Show)
makeLenses ''Room
src/Dodge/Room/Door.hs
+2 -2
View File
@@ -14,8 +14,8 @@ door = defaultRoom
, _rmLinks = lnks
, _rmPath = [(V2 20 35,V2 20 5)]
-- door extends into side walls (for shadows as rendered 12/03)
, _rmPS = [putAutoDoor (V2 0 20) (V2 40 20)]
, _rmBound = []
, _rmPmnts = [putAutoDoor (V2 0 20) (V2 40 20)]
-- note no bounds
}
where lnks = [(V2 20 35,0)
,(V2 20 5,pi)
src/Dodge/Room/Link.hs
+8
View File
@@ -15,6 +15,7 @@ module Dodge.Room.Link
, randomiseOutLinks
, randomiseLinksBy
, invShiftLinkBy
, setLastLinkToUsed
) where
import Dodge.LevelGen
import Dodge.Room.Data
@@ -105,3 +106,10 @@ shiftPathBy
-> (Point2,Point2)
-> (Point2,Point2)
shiftPathBy s (p1,p2) = (shiftPointBy s p1, shiftPointBy s p2)
setLastLinkToUsed :: Room -> Room
setLastLinkToUsed rm = case _rmLinks rm of
(_:_) -> rm
& rmLinks %~ init
& rmUsedLinks %~ (uncurry InLink (last (_rmLinks rm)) :)
_ -> rm
src/Dodge/Room/LongDoor.hs
+6 -6
View File
@@ -38,7 +38,7 @@ twinSlowDoorRoom w h x = defaultRoom
, (V2 0 (-h), pi)
]
, _rmPath = []
, _rmPS =
, _rmPmnts =
[ Placement (PS (V2 0 (h-5)) pi) ( PutButton $ makeButton col id)
$ \btid -> jsps0J (PutSlideDoor False col (cond' btid) (V2 x 1) (V2 x h) wlSpeed)
$ ps0 (PutSlideDoor False col (cond' btid) (V2 (-x) 1) (V2 (-x) h) wlSpeed)
@@ -73,7 +73,7 @@ twinSlowDoorChasers = do
rps = V2 65 <$> [20,40 .. 180]
ps <- takeN 4 $ lps ++ rps
let plmnts = map (\p -> sPS p 0 $ PutCrit chaseCrit) ps
return $ twinSlowDoorRoom 80 200 40 & rmPS %~ (plmnts ++)
return $ twinSlowDoorRoom 80 200 40 & rmPmnts %~ (plmnts ++)
southPillarsRoom :: RandomGen g => Float -> Float -> Float -> State g Room
southPillarsRoom x y h = do
@@ -85,7 +85,7 @@ southPillarsRoom x y h = do
pillarsc = putBlockRect (x/3-20) (x/3+20) (h/2-20) (h/2+20)
++ putBlockRect (2*x/3-20) (2*x/3+20) (h/2-20) (h/2+20)
pillars <- takeOne [pillarsa, pillarsb, pillarsc]
return $ roomRectAutoLinks x y & rmPS .~ pillars
return $ roomRectAutoLinks x y & rmPmnts .~ pillars
addSouthPillars :: RandomGen g => Float -> Float -> Room -> State g Room
addSouthPillars x h r = do
@@ -97,7 +97,7 @@ addSouthPillars x h r = do
pillarsc = putBlockRect (x/3-20) (x/3+20) (h/2-20) (h/2+20)
++ putBlockRect (2*x/3-20) (2*x/3+20) (h/2-20) (h/2+20)
pillars <- takeOne [pillarsa, pillarsb, pillarsc]
return $ r & rmPS %~ (++ pillars)
return $ r & rmPmnts %~ (++ pillars)
addButtonSlowDoor :: RandomGen g => Float -> Float -> Room -> State g Room
addButtonSlowDoor x h rm = do
@@ -107,7 +107,7 @@ addButtonSlowDoor x h rm = do
]
thePlacement <- takeOne [butDoor butPos butRot ]
changeLinkFrom aboveH =<< changeLinkTo belowH (rm
& rmPS %~ (thePlacement :)
& rmPmnts %~ (thePlacement :)
& rmBound %~ (openDoorBound :)
)
where
@@ -138,7 +138,7 @@ slowDoorRoom = do
lsources = [sPS (V2 (x/2) 30) 0 putLamp, sPS (V2 (x/2) (y-30)) 0 putLamp]
barrels = zipWith (\x' y' -> sPS (V2 x' y') 0 $ PutCrit explosiveBarrel) xs' ys'
proom <- southPillarsRoom x y h
addButtonSlowDoor x h (proom & rmPS %~ (++ (crits ++ barrels ++ lsources)))
addButtonSlowDoor x h (proom & rmPmnts %~ (++ (crits ++ barrels ++ lsources)))
randC1 :: PSType
randC1 = RandPS $ takeOne $ map PutCrit $ armourChaseCrit : replicate 50 chaseCrit
src/Dodge/Room/NoNeedWeapon.hs
+1 -1
View File
@@ -34,5 +34,5 @@ centerVaultExplosiveExit = do
,sPS (V2 0 120) 0 $ PutCrit explosiveBarrel
,sPS (V2 0 0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll)
]
r <- centerVaultRoom 120 120 50 <&> rmPS %~ (extraPS ++)
r <- centerVaultRoom 120 120 50 <&> rmPmnts %~ (extraPS ++)
randomiseLinksBy shuffleTail r <&> rmLinks %~ take 2
src/Dodge/Room/Procedural.hs
+11 -11
View File
@@ -48,7 +48,7 @@ roomRect x y xn yn = defaultRoom
{ _rmPolys = [rectNSWE y 0 0 x ]
, _rmLinks = lnks
, _rmPath = concatMap doublePair pth
, _rmPS = []
, _rmPmnts = []
, _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
, _rmFloor = [Tile
{ _tilePoly = rectNSWE y 0 0 x
@@ -69,7 +69,7 @@ roomRect x y xn yn = defaultRoom
{- Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size. -}
roomRectAutoLinks :: Float -> Float -> Room
roomRectAutoLinks x y = (roomRect x y ((ceiling x - 40) `div` 60) ((ceiling y - 40) `div` 60))
{_rmPS = plmnts}
{_rmPmnts = plmnts}
where
plmnts =
[mntLightLnkCond (const True)
@@ -83,8 +83,8 @@ combineRooms r r' = defaultRoom
, _rmLinks = _rmLinks r ++ _rmLinks r'
, _rmPath = map clampPath $ _rmPath r
++ _rmPath r'
, _rmPS = map (shiftPlacement $ _rmShift r) (_rmPS r)
++ map (shiftPlacement $ _rmShift r') (_rmPS r')
, _rmPmnts = map (shiftPlacement $ _rmShift r) (_rmPmnts r)
++ map (shiftPlacement $ _rmShift r') (_rmPmnts r')
, _rmBound = _rmBound r ++ _rmBound r'
, _rmFloor = _rmFloor r ++ _rmFloor r'
, _rmShift = (V2 0 0 , 0)
@@ -126,7 +126,7 @@ quarterRoomFlat w = do
,(V2 0 (w-20),V2 0 0)
,(V2 (55-w) (w-20),V2 0 0)
]
, _rmPS = b
, _rmPmnts = b
, _rmBound = [[V2 0 0,V2 w w,V2 (-w) w]]
}
@@ -167,13 +167,13 @@ fourthCornerWall w = do
,(V2 0 0,V2 0 (w-40))
-- ,(V2 (20-w) (w-20),V2 (40-w) (w))
]
, _rmPS = b
, _rmPmnts = b
, _rmBound = [map toV2 [(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
r & rmPmnts %~ replaceNothingWith pst
where
replaceNothingWith x (Placement (PS p rot) PutNothing _: pss) = sPS p rot x : pss
replaceNothingWith x (ps:pss) = ps : replaceNothingWith x pss
@@ -186,8 +186,8 @@ fillNothingPlacements pst r = foldr fillNothingPlacement r pst
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
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 => State g Room
@@ -201,7 +201,7 @@ randomFourCornerRoom = do
++ replicate 20 chaseCrit
randomiseAllLinks . fillNothingPlacements (crits ++ itms) =<<
( shufflePlacements
. over rmPS ( sps0 putLamp :)
. over rmPmnts ( sps0 putLamp :)
. foldr1 combineRooms
$ zipWith (\r a -> shiftRoomBy (V2 0 0,a) r) corners [0,pi/2,pi,3*pi/2]
)
@@ -221,7 +221,7 @@ centerVaultRoom w h d = do
,(V2 0 (-h), pi )
]
, _rmPath = []
, _rmPS =
, _rmPmnts =
[sps0 $ PutWall (rectNSEW d (d - 30) d (d - 30)) defaultWall
,sps0 $ PutWall (rectNSEW d (d - 30) (-d) (30 - d)) defaultWall
,sps0 $ PutWall (rectNSEW (-d) (30 - d) d (d - 30)) defaultWall
src/Dodge/Room/RoadBlock.hs
+4 -4
View File
@@ -41,7 +41,7 @@ litCorridor90 = do
,( V2 0 (h-40) , V2 20 (h-40) )
,( V2 40 (h-40) , V2 20 (h-40) )
]
, _rmPS =
, _rmPmnts =
[ sPS (V2 20 (h-5)) 0 putLamp
, spanLightI (V2 0 (0.4*h)) (V2 40 (0.4*h))
, windowLine (V2 0 (h-20)) (V2 40 (h-20))
@@ -63,7 +63,7 @@ longBlockedCorridor = do
,sPS (V2 20 15) 0 putLamp
]
sequence $ treeFromPost (replicate n $ Left <$> randomiseOutLinks corridor)
$ return $ Right $ set rmPS plmnts corridor
$ return $ Right $ set rmPmnts plmnts corridor
-- | A single corridor with a destructible block blocking it.
blockedCorridor :: RandomGen g => State g (Tree (Either Room Room))
@@ -74,14 +74,14 @@ blockedCorridor = do
$ reverse $ rectNSWE 10 (-10) (-10) 10
,spanLightI (V2 0 15) (V2 40 15)
]
sequence $ treeFromPost [] $ return $ Right $ set rmPS plmnts corridor
sequence $ treeFromPost [] $ return $ Right $ set rmPmnts plmnts corridor
lasTunnel :: Room
lasTunnel = defaultRoom
{ _rmPolys = polys
, _rmBound = polys
, _rmLinks = [(V2 20 190,1.5* pi),(V2 0 20,0.5* pi)]
, _rmPS = [putLasTurret & plSpot .~ PS (V2 10 240) (1.5*pi)
, _rmPmnts = [putLasTurret & plSpot .~ PS (V2 10 240) (1.5*pi)
, lowWall (rectNSEW 65 40 0 25)
, mountLightV (V2 50 10) (V3 40 20 50)
]
src/Dodge/Room/Start.hs
+2 -2
View File
@@ -20,7 +20,7 @@ import System.Random
rezBox :: Room
rezBox = shiftRoomBy (V2 (-20) (-10),0) $ roomRect 40 20 1 1
& rmPS .~ [ spanColLightI (V3 0 0.7 0.2) 70 (V2 0 10) (V2 40 10) ]
& rmPmnts .~ [ spanColLightI (V3 0 0.7 0.2) 70 (V2 0 10) (V2 40 10) ]
startRoom :: RandomGen g => State g (Tree (Either Room Room))
startRoom = do
@@ -30,7 +30,7 @@ startRoom = do
girderV 40 20 10 (V2 0 (h/2)) (V2 w (h/2))
treeFromPost [Left rezBox, Left door] . Right
<$> randomiseOutLinks (shiftRoomBy (V2 (-20) (-20),0)
$ roomRectAutoLinks w h & rmPS %~
$ roomRectAutoLinks w h & rmPmnts %~
(
[ fground
, mountLightJ (V2 0 (h/3)) (V3 40 (h/3) 70)
src/Dodge/Room/Teleport.hs
+1 -1
View File
@@ -22,7 +22,7 @@ telRoomLev
telRoomLev _ = do
w <- state $ randomR (200,300)
h <- state $ randomR (200,300)
return $ roomRectAutoLinks w h & rmPS .~
return $ roomRectAutoLinks w h & rmPmnts .~
[ sPS (V2 (w/2) (h/2)) 0 $ PutPressPlate telPP
, sPS (V2 (w/2) (h/2+ 30)) 0 putLamp
]
src/Dodge/Room/Treasure.hs
+1 -1
View File
@@ -28,7 +28,7 @@ triLootRoom w h = pure $ defaultRoom
]
, _rmLinks = [(V2 0 (-80) , pi)]
, _rmPath = doublePair (V2 0 (-80) , V2 0 (h/2))
, _rmPS =
, _rmPmnts =
[sPS (V2 (15-w) 15 ) 0 $ PutID 0
,sPS (V2 (w-15) 15 ) pi $ PutID 0
,sPS (V2 0 (h-35)) 0 $ PutID 2