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

Tweak starting rooms

Browse Source
This commit is contained in:
justin
2021-11-16 22:48:45 +00:00
parent 5d0b48829c
commit 559d7e3a23
6 changed files with 102 additions and 92 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Floor.hs
+52 -52
View File
@@ -35,58 +35,58 @@ import qualified Data.IntMap.Strict as IM
initialAnoTree :: RandomGen g => Tree [Annotation g] initialAnoTree :: RandomGen g => Tree [Annotation g]
initialAnoTree = padSucWithCorridors $ treeFromTrunk initialAnoTree = padSucWithCorridors $ treeFromTrunk
[[StartRoom] [[StartRoom]
,[ChainAnos -- ,[ChainAnos
[[SetLabel 0 $ return $ roomRectAutoLinks 200 200 -- [[SetLabel 0 $ return $ roomRectAutoLinks 200 200
& rmExtPmnt ?~ triggerSwitchSPicLight (drawSwitchWire red red) -- & rmExtPmnt ?~ triggerSwitchSPicLight (drawSwitchWire red red)
(anyLnkInPS 5 & psLnkRoomEff .~ (putWireStart 0 . extractRoomPos) ) -- (anyLnkInPS 5 & psLnkRoomEff .~ (putWireStart 0 . extractRoomPos) )
& rmLinkEff .~ [putWireEnd 0] -- & rmLinkEff .~ [putWireEnd 0]
] -- ]
,[UseLabel 0 $ return switchDoorRoom] -- ,[UseLabel 0 $ return switchDoorRoom]
] -- ]
] -- ]
,[SpecificRoom $ return $ connectRoom lasTunnel ] -- ,[SpecificRoom $ return $ connectRoom lasTunnel ]
,[SpecificRoom $ fmap connectRoom slowDoorRoom ] -- ,[SpecificRoom $ fmap connectRoom slowDoorRoom ]
,[Corridor] -- ,[Corridor]
,[Corridor] -- ,[Corridor]
,[SpecificRoom $ fmap connectRoom roomCCrits] -- ,[SpecificRoom $ fmap connectRoom roomCCrits]
,[AirlockAno] -- ,[AirlockAno]
,[Corridor] -- ,[Corridor]
---- ,[SpecificRoom roomCCrits] ------ ,[SpecificRoom roomCCrits]
---- ,[Corridor] ------ ,[Corridor]
---- ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 ------ ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400
---- & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit armourChaseCrit ------ & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit armourChaseCrit
---- ,sPS (V2 50 25) 0 $ PutCrit armourChaseCrit ------ ,sPS (V2 50 25) 0 $ PutCrit armourChaseCrit
---- ,sPS (V2 50 0) 0 $ PutCrit armourChaseCrit ------ ,sPS (V2 50 0) 0 $ PutCrit armourChaseCrit
---- ]++) ------ ]++)
---- ] ------ ]
---- --,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 ------ --,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400
---- -- & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,202] ]++) ------ -- & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,202] ]++)
---- -- ] ------ -- ]
---- ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 ------ ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400
---- & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit pistolCrit ]++) ------ & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit pistolCrit ]++)
---- ] ------ ]
---- ,[Corridor] ------ ,[Corridor]
-- --,[SpecificRoom $ pure . Right <$> twinSlowDoorChasers] ---- --,[SpecificRoom $ pure . Right <$> twinSlowDoorChasers]
--- ,[SpecificRoom $ pure $ (pure . Right) (twinSlowDoorRoom 80 200 40)] ----- ,[SpecificRoom $ pure $ (pure . Right) (twinSlowDoorRoom 80 200 40)]
--- ,[DoorAno] ----- ,[DoorAno]
--- ,[SpecificRoom $ pure . Right <$> centerVaultExplosiveExit] ----- ,[SpecificRoom $ pure . Right <$> centerVaultExplosiveExit]
--- ,[SpecificRoom blockedCorridor] ----- ,[SpecificRoom blockedCorridor]
--- ,[OrAno [[DoorAno] ----- ,[OrAno [[DoorAno]
--- ,[Corridor] ----- ,[Corridor]
--- ,[DoorNumAno 0,AirlockAno]] ----- ,[DoorNumAno 0,AirlockAno]]
--- ] ----- ]
--- ,[FirstWeapon] ----- ,[FirstWeapon]
--- ,[CorridorDebug] ----- ,[CorridorDebug]
--- ,[SpecificRoom $ fmap (pure . Right) randomFourCornerRoom] ----- ,[SpecificRoom $ fmap (pure . Right) randomFourCornerRoom]
,[OrAno -- ,[OrAno
[[SpecificRoom $ branchRectWith $ fmap (fmap Left) armouredChasers] -- [[SpecificRoom $ branchRectWith $ fmap (fmap Left) armouredChasers]
,[BossAno $ addArmour launcherCrit & crHP +~ 800 -- ,[BossAno $ addArmour launcherCrit & crHP +~ 800
& crState . crDropsOnDeath .~ DropSpecific [0] ] -- & crState . crDropsOnDeath .~ DropSpecific [0] ]
] -- ]
] -- ]
-- ,[SpecificRoom $ fmap (pure . Right) armouredCorridor] ---- ,[SpecificRoom $ fmap (pure . Right) armouredCorridor]
,[Corridor] -- ,[Corridor]
,[TreasureAno [addArmour autoCrit,addArmour autoCrit] [launcher]] -- ,[TreasureAno [addArmour autoCrit,addArmour autoCrit] [launcher]]
] ]
$ treeFromPost [[Corridor,SpecificRoom $ fmap (pure . Right) randomFourCornerRoom]] $ treeFromPost [[Corridor,SpecificRoom $ fmap (pure . Right) randomFourCornerRoom]]
[EndRoom] [EndRoom]
src/Dodge/Layout.hs
+12 -8
View File
@@ -44,7 +44,7 @@ generateLevelFromRoomList gr' w
. flip (mapAccumR doRoomPlacements) rs' . flip (mapAccumR doRoomPlacements) rs'
$ w { _walls = wallsFromRooms rs $ w { _walls = wallsFromRooms rs
, _floorTiles = floorsFromRooms rs , _floorTiles = floorsFromRooms rs
, _gameRooms = gameRoomsFromRooms rs , _gameRooms = gameRoomsFromRooms rs'
, _pathGraph = path , _pathGraph = path
, _pathGraphP = pairPath , _pathGraphP = pairPath
} }
@@ -155,10 +155,10 @@ gameRoomsFromRooms = map gameRoomFromRoom
gameRoomFromRoom :: Room -> GameRoom gameRoomFromRoom :: Room -> GameRoom
gameRoomFromRoom rm = GameRoom gameRoomFromRoom rm = GameRoom
{ _grViewpoints = _rmViewpoints rm ++ (map fst . foldl' (flip cutWalls) [] $ _rmPolys rm) { _grViewpoints = map doshift $ _rmViewpoints rm ++ (map fst . foldl' (flip cutWalls) [] $ _rmPolys rm)
-- ++ map fst (_rmLinks rm) -- ++ map fst (_rmLinks rm)
, _grViewpointsEx = mapMaybe unpos (_rmPos rm) , _grViewpointsEx = concatMap unpos (_rmPos rm)
, _grBound = expandPolyCorners 50 . convexHullSafe . nubBy closePoints , _grBound = map doshift $ expandPolyCorners 50 . convexHullSafe . nubBy closePoints
. concat $ _rmBound rm ++ _rmPolys rm . concat $ _rmBound rm ++ _rmPolys rm
, _grDir = getDir $ _rmPos rm , _grDir = getDir $ _rmPos rm
, _grLinkDirs = mapMaybe undir $ _rmPos rm , _grLinkDirs = mapMaybe undir $ _rmPos rm
@@ -166,14 +166,18 @@ gameRoomFromRoom rm = GameRoom
} }
where where
doshift = shiftPointBy (_rmShift rm) doshift = shiftPointBy (_rmShift rm)
unpos (OutLink _ p _) = Just $ doshift p doubleShift p a = map doshift
unpos (InLink p _) = Just $ doshift p [p +.+ 10 *.* unitVectorAtAngle a
unpos _ = Nothing ,p -.- 10 *.* unitVectorAtAngle a
]
unpos (OutLink _ p a) = doubleShift p a
unpos (InLink p a) = doubleShift p a
unpos _ = []
undir (OutLink _ _ a) = Just $ 0.5*pi + a + snd (_rmShift rm) undir (OutLink _ _ a) = Just $ 0.5*pi + a + snd (_rmShift rm)
undir (InLink _ a) = Just $ 0.5*pi + a + snd (_rmShift rm) undir (InLink _ a) = Just $ 0.5*pi + a + snd (_rmShift rm)
undir _ = Nothing undir _ = Nothing
closePoints x y = roundPoint2 x == roundPoint2 y closePoints x y = roundPoint2 x == roundPoint2 y
getDir (InLink _ a:_) = a -- + snd (_rmShift rm) getDir (InLink _ a:_) = a + snd (_rmShift rm)
getDir (_:xs) = getDir xs getDir (_:xs) = getDir xs
getDir _ = 0 -- fallback getDir _ = 0 -- fallback
src/Dodge/LevelGen.hs
+2 -3
View File
@@ -7,12 +7,11 @@ import Dodge.Data
import Dodge.Floor import Dodge.Floor
import Dodge.Layout import Dodge.Layout
import Dodge.Initialisation import Dodge.Initialisation
--import qualified IntMapHelp as IM
--import Control.Lens import System.Random
generateWorldFromSeed :: Int -> IO World generateWorldFromSeed :: Int -> IO World
generateWorldFromSeed i = do generateWorldFromSeed i = do
roomList <- layoutLevelFromSeed 0 i roomList <- layoutLevelFromSeed 0 i
return $ generateLevelFromRoomList roomList return $ generateLevelFromRoomList roomList
initialWorld -- note this uses a random generator defined elsewhere initialWorld{_randGen=mkStdGen i}
src/Dodge/Room/Room.hs
+17 -13
View File
@@ -251,8 +251,10 @@ weaponEmptyRoom = do
--,sPS (V2 (w/2) (h/2)) 0 putLamp --,sPS (V2 (w/2) (h/2)) 0 putLamp
,mntLightLnkCond unusedLnkToPS ,mntLightLnkCond unusedLnkToPS
] ]
(fmap connectRoom . randomiseOutLinks) =<< treeFromTrunk [Left corridor]
<$> ((fmap connectRoom . randomiseOutLinks) =<<
changeLinkTo ((\p -> dist p (V2 (w/2) 0) < 10) . fst) (set rmPmnts plmnts $ roomRect w h 2 2) changeLinkTo ((\p -> dist p (V2 (w/2) 0) < 10) . fst) (set rmPmnts plmnts $ roomRect w h 2 2)
)
weaponUnderCrits :: RandomGen g => State g (Tree (Either Room Room)) weaponUnderCrits :: RandomGen g => State g (Tree (Either Room Room))
weaponUnderCrits = do weaponUnderCrits = do
@@ -275,18 +277,20 @@ weaponUnderCrits = do
weaponBehindPillar :: RandomGen g => State g (Tree (Either Room Room)) weaponBehindPillar :: RandomGen g => State g (Tree (Either Room Room))
weaponBehindPillar = do weaponBehindPillar = do
cpos <- takeOne $ [V2 x y | x <- [20,220], y <- [20,220]] ++ [V2 120 160,V2 120 200] wpa <- state $ randomR (0,pi)
let d p = argV $ V2 120 80 -.- p wpos <- takeOne [V2 120 160,V2 80 40,V2 160 40,V2 220 200,V2 40 200,V2 120 35]
let plmnts1 = cpos <- takeOne $ [V2 x y | x <- [20,220], y <- [20,40]] ++ [V2 120 160,V2 120 200]
[sPS (V2 120 160) 0 $ RandPS randFirstWeapon let d p = argV $ V2 120 80 -.- p
,sPS cpos (d cpos) randC1 let plmnts1 =
] [sPS wpos wpa $ RandPS randFirstWeapon
rcp <- roomCenterPillar ,sPS cpos (d cpos) randC1
return $ treeFromTrunk ]
[Left door rcp <- roomCenterPillar
,Left $ over rmLinks tail $ over rmPmnts (++ plmnts1) rcp return $ treeFromTrunk
] [Left corridor
(connectRoom $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN) ,Left $ over rmLinks tail $ over rmPmnts (++ plmnts1) rcp
]
(connectRoom $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN)
weaponBetweenPillars :: RandomGen g => State g (Tree (Either Room Room)) weaponBetweenPillars :: RandomGen g => State g (Tree (Either Room Room))
weaponBetweenPillars = do weaponBetweenPillars = do
src/Dodge/Room/Start.hs
+7 -3
View File
@@ -48,11 +48,15 @@ rezBoxesThenWeaponRoom = do
wroom <- weaponRoom wroom <- weaponRoom
return $ rboxes `appendEitherTree` [wroom] return $ rboxes `appendEitherTree` [wroom]
rezBoxThenWeaponRoom :: RandomGen g => State g (Tree (Either Room Room))
rezBoxThenWeaponRoom = treeFromTrunk [Left rezBox,Left door] <$> weaponRoom
startRoom :: RandomGen g => State g (Tree (Either Room Room)) startRoom :: RandomGen g => State g (Tree (Either Room Room))
startRoom = join $ takeOne startRoom = join $ takeOne
[-- rezBoxesWp [ rezBoxesWp
rezBoxesThenWeaponRoom , rezBoxesThenWeaponRoom
--, rezBoxesWpCrit , rezBoxThenWeaponRoom
, rezBoxesWpCrit
] ]
rezBoxesWpCrit :: RandomGen g => State g (Tree (Either Room Room)) rezBoxesWpCrit :: RandomGen g => State g (Tree (Either Room Room))
src/Dodge/Update/Camera.hs
+12 -13
View File
@@ -1,5 +1,4 @@
{- {- Functions controlling the movement of the screen camera:
Functions controlling the movement of the screen camera:
'_cameraCenter', '_cameraZoom', _cameraRot'; '_cameraCenter', '_cameraZoom', _cameraRot';
and the position that the character sees from: '_cameraViewFrom'. -} and the position that the character sees from: '_cameraViewFrom'. -}
module Dodge.Update.Camera module Dodge.Update.Camera
@@ -165,23 +164,23 @@ farWallDist p w = (winFac /) . min maxViewDistance $ ssfold (> maxViewDistance)
hw = halfWidth w hw = halfWidth w
hh = halfHeight w hh = halfHeight w
winFac = min hw hh winFac = min hw hh
vps = concatMap _grViewpoints grs ++ linkvps vps = concatMap _grViewpoints grs ++ extendedViewPoints p grs
linkvps = map extend (concatMap _grViewpointsEx grs)
extend :: Point2 -> Point2
extend outp = p +.+ maxViewDistance *.* safeNormalizeV (outp -.- p)
grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w) grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
wos = wallsOnScreen w wos = wallsOnScreen w
farWallPoints :: Point2 -> World -> [Point2] extendedViewPoints :: Point2 -> [GameRoom] -> [Point2]
farWallPoints p w = concatMap _grViewpoints grs ++ linkvps extendedViewPoints p grs = map extend
(concatMap _grViewpointsEx grs
++ map addDir (concatMap _grLinkDirs grs)
)
where where
grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
linkvps = map extend (concatMap _grViewpointsEx grs
++ map addDir (concatMap _grLinkDirs grs)
)
extend :: Point2 -> Point2
extend outp = p +.+ maxViewDistance *.* safeNormalizeV (outp -.- p) extend outp = p +.+ maxViewDistance *.* safeNormalizeV (outp -.- p)
addDir a = p +.+ unitVectorAtAngle a addDir a = p +.+ unitVectorAtAngle a
farWallPoints :: Point2 -> World -> [Point2]
farWallPoints p w = concatMap _grViewpoints grs ++ extendedViewPoints p grs
where
grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
maxViewDistance :: Float maxViewDistance :: Float
maxViewDistance = 800 maxViewDistance = 800