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

Function for adding random lights to roomNGon

Browse Source
This commit is contained in:
justin
2026-03-19 11:40:49 +00:00
parent d1c2870d63
commit 508b848204
20 changed files with 453 additions and 336 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Airlock.hs
+1 -1
View File
@@ -52,7 +52,7 @@ decontamRoom i =
]
-- & rmOutPmnt . at i ?~
-- analyser (NoItemZone ps) (PS 50 0) (PS mcpos 0)
& rmInPmnt .~ [(0, f)]
& rmInPmnt .~ [(0, return . f)]
& rmBound .~ [rectNSWE 75 15 0 40, switchcut]
where
f gw = fromMaybe (error "tried to put a door using an empty placement list") $ do
src/Dodge/Room/Containing.hs
+12 -12
View File
@@ -1,6 +1,7 @@
--{-# LANGUAGE TupleSections #-}
-- {-# LANGUAGE TupleSections #-}
module Dodge.Room.Containing where
import Control.Monad
import Dodge.Cleat
import Dodge.Data.GenWorld
import Dodge.Item.Display
@@ -15,28 +16,27 @@ import Dodge.Tree
import Geometry
import LensHelp
import RandomHelp
import Control.Monad
roomsContaining :: RandomGen g => [Creature] -> [Item] -> State g (MetaTree Room String)
roomsContaining :: (RandomGen g) => [Creature] -> [Item] -> State g (MetaTree Room String)
roomsContaining crs its = tToBTree str <$> roomsContaining' crs its
where
str = "roomsContaining " ++ concatMap _crName crs ++ concatMap (head . basicItemDisplay) its
roomsContaining' :: RandomGen g => [Creature] -> [Item] -> State g (Tree Room)
roomsContaining' :: (RandomGen g) => [Creature] -> [Item] -> State g (Tree Room)
roomsContaining' crs its = do
endroom <-
join $
takeOne
[-- roomPillarsSquare <&> rmPmnts ++.~ crsItmsUnused crs its
--, randomFourCornerRoomCrsIts crs its
--, tanksRoom crs its
-- tanksPipesRoom <&> rmPmnts ++.~ crsItmsUnused crs its
roomPillarsContaining crs its
-- , roomPillarsPassage <&> rmPmnts ++.~ crsItmsUnused crs its
[ roomPillarsSquare <&> rmPmnts ++.~ crsItmsUnused crs its
, randomFourCornerRoomCrsIts crs its
, tanksRoom crs its
, tanksPipesRoom <&> rmPmnts ++.~ crsItmsUnused crs its
, roomPillarsContaining crs its
, roomPillarsPassage <&> rmPmnts ++.~ crsItmsUnused crs its
]
return (pure $ cleatOnward endroom)
roomPillarsContaining :: RandomGen g => [Creature] -> [Item] -> State g Room
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)]
@@ -47,7 +47,7 @@ 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
pedestalRoom :: (RandomGen g) => Item -> State g Room
pedestalRoom it = do
let flit = PutFlIt it
x <- state $ randomR (150, 250)
src/Dodge/Room/Door.hs
+1 -1
View File
@@ -40,7 +40,7 @@ triggerDoorRoom i =
-- note no bounds
}
where
f gw = fromMaybe (error "tried to put a door using an empty placement list") $ do
f gw = return $ fromMaybe (error "tried to put a door using an empty placement list") $ do
pmnt <- gw ^? genPmnt . ix i
return $ putDoubleDoor defaultDoorWall (cond pmnt) (V2 0 20) (V2 40 20) 2
cond pmnt = WdTrig $ fromJust (_plMID pmnt)
src/Dodge/Room/LasTurret.hs
+5 -14
View File
@@ -17,6 +17,7 @@ module Dodge.Room.LasTurret (
storeRoomID,
) where
import Dodge.Room.Modify
import Color
import Control.Monad
import Data.Foldable
@@ -148,9 +149,9 @@ lasSensorTurretTest = do
let cenroom =
cenroom''
& rmInPmnt
<>~ [ (0, alight pi . f i)
, (0, alight (0.5 * pi) . f i)
, (0, alight (1.5 * pi) . f i)
<>~ [ (0, return . alight pi . f i)
, (0, return . alight (0.5 * pi) . f i)
, (0, return . alight (1.5 * pi) . f i)
]
rToOnward "lasSensorTurretTest" $
treePost
@@ -166,7 +167,7 @@ lasCenSensEdge n = do
(i, cenroom') <- storeRoomID =<< shuffleLinks =<< lightSensByDoor n =<< cenLasTur
lshape <- takeOne [vShape, lShape, jShape, liShape]
let alight a rp = mntLSCond (fmap (fmap $ colorSH black) lshape) (PS (rotateV a $ _rpPos rp) (a + _rpDir rp))
blight a = (0, alight a . f i)
blight a = (0, return . alight a . f i)
let cenroom = cenroom' & rmInPmnt <>~ map blight [pi, (0.5 * pi), (1.5 * pi)]
let doorroom = triggerDoorRoom n
rToOnward "lasCenSensEdge" $
@@ -181,16 +182,6 @@ lasCenSensEdge n = do
isused UsedOutLink{_rplsChildNum = 0} = True
isused _ = False
storeRoomID :: Room -> State LayoutVars (Int, Room)
storeRoomID x = do
i <- nextLayoutInt
return (i, x & rmPmnts .:~ sps0 (PutWorldUpdate (f i)))
where
f i rid _ gw = gw & genInts . at i ?~ (gw ^?! genRooms . ix rid . rmMID . _Just)
-- unsafe! assumes that storeRoomID has been called
getRoomFromID :: Int -> GenWorld -> Room
getRoomFromID i gw = gw ^?! genRooms . ix (gw ^?! genInts . ix i)
lasRunYinYang :: (RandomGen g) => State g (MetaTree Room String)
lasRunYinYang = do
src/Dodge/Room/Modify.hs
+75 -3
View File
@@ -1,4 +1,76 @@
module Dodge.Room.Modify
( module Dodge.Room.Modify.Girder
) where
module Dodge.Room.Modify (
module Dodge.Room.Modify.Girder,
storeRoomID,
getRoomFromID,
addLightsNGon,
removeLights,
) where
import Color
import Shape
import Dodge.Placement.Instance.LightSource
import Dodge.LevelGen.PlacementHelper
import LensHelp
import Dodge.Data.MetaTree
import RandomHelp
import Dodge.Data.GenWorld
import Dodge.Room.Modify.Girder
import qualified Data.Set as S
import Data.Maybe
import Geometry
import Data.Foldable
storeRoomID :: Room -> State LayoutVars (Int, Room)
storeRoomID x = do
i <- nextLayoutInt
return (i, x & rmPmnts .:~ sps0 (PutWorldUpdate (f i)))
where
f i rid _ gw = gw & genInts . at i ?~ (gw ^?! genRooms . ix rid . rmMID . _Just)
-- unsafe! assumes that storeRoomID has been called
getRoomFromID :: Int -> GenWorld -> Room
getRoomFromID i gw = gw ^?! genRooms . ix (gw ^?! genInts . ix i)
removeLights :: Room -> Room
removeLights = rmPmnts %~ mapMaybe f
where
f x = case x ^. plType of
PutLabel "light" -> Nothing
_ -> Just x
addLightsNGon :: Room -> State LayoutVars Room
addLightsNGon rm = do
(i, rm') <- storeRoomID $ removeLights rm
return $
rm'
& rmInPmnt
.:~ (0, f i)
where
a = 2 * pi - (2 * pi / fromIntegral (rm ^?! rmType . rmngonSides))
y = rm ^?! rmType . rmngonSize
x = y * tan (0.5 * a)
f i gw = do
lshape <- takeOne [vShape, lShape, jShape, liShape]
let ps = fromMaybe (PS (V2 y 0) 0) $ rpToPS <$> find iscolorlight (grm ^. rmPos)
alight a' = mntLSCond (fmap (fmap $ colorSH black) lshape) (rotateps a' ps)
takeOne
[ spanLightY (V2 0 0) (V2 y x) (V2 (x) y) (V2 (x) (-y))
, spanLightY (V2 20 20) (V2 y 20) (V2 (-y) 20) (V2 20 (-y))
, spanLightI (V2 22 y) (V2 22 (-y))
, spanLightI (V2 x y) (V2 (-x) (-y))
, alight (0.5 * pi) <> alight (1.5 * pi)
]
where
grm = getRoomFromID i gw
rotateps a' (PS v d) = PS (rotateV a' v) (a' + d)
rotateps _ _ = error "in addLightsNGon"
rpToPS rp = (PS (_rpPos rp) (_rpDir rp))
iscolorlight rp =
(ColoredLightRP `S.member` (rp ^. rpFlags))
&& islinkroompos rp
islinkroompos rp = case rp ^. rpType of
UsedOutLink{} -> True
UsedInLink{} -> True
UnusedLink{} -> True
NotLink{} -> False
src/Dodge/Room/Ngon.hs
+1
View File
@@ -24,6 +24,7 @@ roomNgon n x = do
, _rmPmnts = [thelight]
, _rmBound = [poly]
, _rmFloor = Tiled [makeTileFromPoly poly 2]
, _rmType = RoomNgon n x
--, _rmFloor = InheritFloor
, _rmName = show n ++ "gon"
, _rmPos = poss
src/Dodge/Room/Room.hs
+4 -4
View File
@@ -154,7 +154,7 @@ roomCenterPillar = do
roomRect 240 240 2 2
)
weaponEmptyRoom :: State StdGen (Tree Room)
weaponEmptyRoom :: RandomGen g => State g (Tree Room)
weaponEmptyRoom = do
w <- state $ randomR (220, 300)
h <- state $ randomR (220, 300)
@@ -209,7 +209,7 @@ weaponBehindPillar = do
, cleatOnward $ set rmPmnts [sPS (V2 20 60) (negate $ pi / 2) randC1] corridorN
]
weaponBetweenPillars :: State StdGen (MetaTree Room String)
weaponBetweenPillars :: State LayoutVars (MetaTree Room String)
weaponBetweenPillars = do
(w, wn) <- takeOne [(240, 2), (340, 3)]
(h, hn) <- takeOne [(240, 2), (340, 3)]
@@ -271,7 +271,7 @@ deadEndRoom =
lnks = [(V2 0 30, 0)]
{- A random Either tree with a weapon and melee monster challenge. -}
weaponRoom :: State StdGen (MetaTree Room String)
weaponRoom :: State LayoutVars (MetaTree Room String)
weaponRoom =
join $
takeOne
@@ -458,7 +458,7 @@ distributerRoom atype aamount = do
)
)
return $ r & rmPmnts .:~ store
& rmInPmnt <>~ [(0,dst),(1,thepipe)]
& rmInPmnt <>~ [(0,return . dst),(1,return . thepipe)]
& rmLinks %~ setInLinksByType (OnEdge South)
& rmLinks %~ setOutLinks (not . S.member (OnEdge South) . _rlType)
src/Dodge/Room/SensorDoor.hs
+33 -18
View File
@@ -1,33 +1,37 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Room.SensorDoor (sensAboveDoor,sensorRoomRunPast) where
import Dodge.Data.MTRS
module Dodge.Room.SensorDoor (sensAboveDoor, sensorRoomRunPast) where
import Dodge.Room.Procedural
import Control.Monad
import qualified Data.Set as S
import Dodge.Cleat
import Dodge.Data.GenWorld
import Dodge.Data.MTRS
import Dodge.LevelGen.PlacementHelper
import Dodge.Placement.Instance
import Dodge.PlacementSpot
import Dodge.Room.Corridor
import Dodge.Room.Door
import Dodge.Room.Link
import Dodge.Room.Modify
import Dodge.Room.Ngon
import Dodge.Room.Procedural
import Dodge.Terminal
import Dodge.Tree
import Dodge.Wire
import Geometry
import LensHelp
import RandomHelp
import Control.Monad
-- TODO fix case where the sensor created by sensInsideDoor blocks another door
-- for roomRectAutoLinks-- make the locked door a center door?
sensorRoom :: RandomGen g => SensorType -> Int -> State g (Tree Room)
sensorRoom :: SensorType -> Int -> State LayoutVars (Tree Room)
sensorRoom senseType n = do
rm <- join $ takeOne [roomNgon 8 200, roomRectAutoLights 200 200]
rm <- join $ takeOne [addLightsNGon =<< roomNgon 8 200, roomRectAutoLights 200 200]
--rm <- join $ takeOne [addLightsNGon =<< roomNgon 8 200]
cenroom <- shuffleLinks $ sensInsideDoor senseType n rm
return $ treePost
return $
treePost
[ door
, cenroom & rmLinkEff .~ f
, triggerDoorRoom n
@@ -43,29 +47,40 @@ sensorRoom senseType n = do
p' = p +.+ rotateV d (V2 0 (negate 100))
isclose = dist (_rlPos rl) p' < 30
sensorRoomRunPast :: RandomGen g => SensorType -> Int -> State g MTRS
sensorRoomRunPast :: SensorType -> Int -> State LayoutVars MTRS
sensorRoomRunPast dt n = do
t <- sensorRoom dt n
rToOnward "sensorRoomRunPast" $ t
& applyToSubforest [0]
( ++ [ treePost [ door & rmConnectsTo .~ (\s -> S.member InLink s && not (S.member BlockedLink s)) , cleatLabel n corridor ] ])
rToOnward "sensorRoomRunPast" $
t
& applyToSubforest
[0]
(++ [treePost [door & rmConnectsTo .~ (\s -> S.member InLink s && not (S.member BlockedLink s)), cleatLabel n corridor]])
sensAboveDoor :: SensorType -> Float -> PlacementSpot -> Placement
sensAboveDoor sensetype wth ps =
extTrigLitPos
(atFstLnkOutShiftBy (\(p, a) -> ((p +.+ rotateV a (V2 18.5 (-2.5)), a), S.singleton UsedPosHigh)))
( psposAddLabel
ColoredLightRP
(atFstLnkOutShiftBy (\(p, a) -> ((p +.+ rotateV a (V2 18.5 (-2.5)), a), S.singleton UsedPosHigh)))
)
(\tp -> Just $ damageSensor sensetype wth (_plMID tp) ps)
sensInsideDoor :: SensorType -> Int -> Room -> Room
sensInsideDoor senseType i rm = rm
& rmName .++~ take 4 (show senseType)
& rmPmnts
sensInsideDoor senseType i rm =
rm
& rmName
.++~ take 4 (show senseType)
& rmPmnts
.++~ [ psPt atFstLnkOut . PutForeground $ floorWire (V2 20 0) (V2 20 (-100))
, psPt atFstLnkOut . PutForeground $ floorWire (V2 0 (-100)) (V2 20 (-100))
, psPt atFstLnkOut . PutForeground $ verticalWire (V2 20 0) 0 80
, putMessageTerminal
, putMessageTerminal
(textTerminal & tmCommands .:~ TCDamageCommand)
& plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10 <&> (, S.singleton UsedPosHigh))
, sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100) & plExternalID ?~ i
& plSpot
.~ rprBoolShift isUnusedLnk (shiftInBy 10 <&> (,S.singleton UsedPosHigh))
, sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100) & plExternalID ?~ i
]
-- & rmOutPmnt . at i ?~ sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)
src/Dodge/Room/Start.hs
+3 -2
View File
@@ -50,8 +50,9 @@ powerFakeout = do
]
-- the i is used either for a PickOnePlacement or a room id, this is not great
startRoom :: Int -> State StdGen (MetaTree Room String)
startRoom i =
startRoom :: State LayoutVars (MetaTree Room String)
startRoom = do
i <- nextLayoutInt
join $
takeOne
[ attachOnward "startThenWeaponRoom" <$> preCritStart <*> weaponRoom
src/Dodge/Room/Tutorial.hs
+3 -9
View File
@@ -2,6 +2,7 @@
module Dodge.Room.Tutorial where
import Dodge.Room.Modify
import Control.Monad
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS
@@ -119,7 +120,7 @@ tutDrop = do
return $
tToBTree "TutDrop" $
treePost
[x & rmInPmnt .:~ (0, t j), y, cleatOnward rm]
[x & rmInPmnt .:~ (0, return . t j), y, cleatOnward rm]
where
t j gw =
let x = gw ^? genInts . ix j
@@ -391,13 +392,6 @@ tutLight = do
)
_ -> Nothing
removeLights :: Room -> Room
removeLights = rmPmnts %~ mapMaybe f
where
f x = case x ^. plType of
PutLabel "light" -> Nothing
_ -> Just x
tutHub :: State LayoutVars (MetaTree Room String)
tutHub = do
(is, wbp) <- setTreeInts =<< critsRoom 1
@@ -413,7 +407,7 @@ tutHub = do
x <-
shuffleLinks
. analyserByDoor (RequireEquipment (AMMOMAG DRUMMAG)) i
. (rmInPmnt .:~ (0, a))
. (rmInPmnt .:~ (0, return . a))
. addDoorAtNthLinkToggleTerminal 1 ss j
-- . addDoorAtNthLinkToggleInterrupt 2 ds j
. addDoorAtNthLinkToggleInterrupt 2 ds j1