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

Make Placement into a product type

Browse Source
This commit is contained in:
justin
2025-09-02 12:31:55 +01:00
parent dc13c61dca
commit f278af0f30
29 changed files with 168 additions and 168 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/GenWorld.hs
+1 -1
View File
@@ -85,7 +85,7 @@ data Placement
, _plMID :: Maybe Int
, _plIDCont :: World -> Placement -> Maybe Placement
}
| RandomPlacement {_unRandomPlacement :: State StdGen Placement}
-- | RandomPlacement {_unRandomPlacement :: State StdGen Placement}
{- The '_rmPolys' lists 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;
src/Dodge/Floor.hs
+4 -4
View File
@@ -66,12 +66,12 @@ initialAnoTree =
PassthroughLockKeyLists keyCardRunPastRand itemRooms
, AnTree . intAnno $ warningRooms "INVISIBLE CREATURE AHEAD"
, AnTree $
rToOnward "chaseCrit+armourChaseCrit rectRoom" $
return . cleatOnward $
roomRectAutoLinks 400 400 & rmPmnts
rToOnward "chaseCrit+armourChaseCrit rectRoom" =<<
return . cleatOnward <$>
(roomRectAutoLinks 400 400 <&> rmPmnts
.++~ [ psPtPl anyUnusedSpot (PutCrit invisibleChaseCrit)
, psPtPl anyUnusedSpot (PutCrit armourChaseCrit)
]
])
, AnTree . intAnno $ fmap (tToBTree "healthTest") . healthTest
, AnTree . zoom lyGen $
(tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward)
src/Dodge/LevelGen/PlacementHelper.hs
+1 -1
View File
@@ -86,7 +86,7 @@ ps0PushPSw pst f = Placement 10 (PSNoShiftCont (V2 0 0) 0) pst Nothing $
addPlmnt :: Placement -> Placement -> Placement
addPlmnt pl pl2 = case pl2 of
(RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp
-- (RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp
(Placement i ps pt mi f) -> Placement i ps pt mi (fmap (fmap g) f)
where
g Nothing = Just pl
src/Dodge/Placement/Instance/LightSource.hs
+4 -4
View File
@@ -155,13 +155,13 @@ mntLSCond shp ps =
-- note that this perhaps pushes the vshape light out too far
mntLight :: Point2 -> Point2 -> Placement
mntLight a b = RandomPlacement $ do
mntLight :: RandomGen g => Point2 -> Point2 -> State g Placement
mntLight a b = do
shp <- takeOne [vShape, iShape, lShape, jShape, liShape]
return $ mntLS shp a (addZ 90 b)
mntLightLnkCond :: PlacementSpot -> Placement
mntLightLnkCond ps = RandomPlacement $ do
mntLightLnkCond :: RandomGen g => PlacementSpot -> State g Placement
mntLightLnkCond ps = do
shp <- takeOne [vShape, lShape, jShape, liShape]
return $ mntLSCond (fmap (fmap $ colorSH black) shp) ps
src/Dodge/Placement/PlaceSpot.hs
-10
View File
@@ -33,19 +33,9 @@ placeSpot (w, rm) plmnt = case plmnt of
Placement{_plSpot = PSPos extract eff fallback} ->
placeSpotUsingLink w rm plmnt extract eff fallback
Placement{} -> placePlainPSSpot w rm plmnt shift
RandomPlacement rplmnt -> placeRandomPlacement rplmnt w rm
where
shift = _rmShift rm
placeRandomPlacement ::
State StdGen Placement ->
GenWorld ->
Room ->
((GenWorld, Room), [Placement])
placeRandomPlacement rplmnt w rm = placeSpot (w & gwWorld . randGen .~ g, rm) plmnt'
where
(plmnt', g) = runState rplmnt (_randGen (_gwWorld w))
placePlainPSSpot ::
GenWorld ->
Room ->
src/Dodge/Placement/Shift.hs
+1 -1
View File
@@ -25,4 +25,4 @@ shiftPlacement shift plmnt = case plmnt of
Placement{} ->
plmnt & plSpot %~ shiftPSBy shift
& plIDCont %~ fmap (fmap (fmap $ shiftPlacement shift))
RandomPlacement rpl -> RandomPlacement $ fmap (shiftPlacement shift) rpl
-- RandomPlacement rpl -> RandomPlacement $ fmap (shiftPlacement shift) rpl
src/Dodge/Room/Airlock.hs
+48 -43
View File
@@ -3,7 +3,8 @@
{- Rooms that contain two doors and a switch alternating both. -}
module Dodge.Room.Airlock where
import Dodge.Placement.Instance.Analyser
import Control.Lens
import Control.Monad
import Dodge.Annotation.Data
import Dodge.Data.GenWorld
import Dodge.Default.Door
@@ -11,34 +12,37 @@ import Dodge.Default.Room
import Dodge.LevelGen.PlacementHelper
import Dodge.LevelGen.Switch
import Dodge.Placement.Instance
import Dodge.Placement.Instance.Analyser
import Dodge.Room.Foreground
import Dodge.RoomLink
import Geometry
import Picture
import RandomHelp
import Control.Lens
-- | A passage with a switch that opens forward access while closing backwards access.
airlock :: RandomGen g => State g Room
airlock = takeOne [airlock0, airlock90, airlockCrystal, airlockZ]
airlock =
join $
takeOne [return airlock0, return airlock90, return airlockCrystal, airlockZ]
--airlock = takeOne [airlockCrystal]
decontamRoom :: State LayoutVars Room
decontamRoom = do
return $ defaultRoom
& rmPolys .~ [rectNSWE 100 0 0 40, switchcut]
& rmLinks .~ muout lnks ++ muin [last lnks]
& rmPath .~ foldMap doublePairSet [(V2 20 95, V2 20 45), (V2 20 45, V2 20 5)]
& rmPmnts .~
[ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
\btid -> Just $
putDoubleDoorThen DoorObstacle thewall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
\_ _ -> Just $ putDoubleDoor DoorObstacle thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
, invisibleWall $ rectNSWE 60 40 (-40) (-30)
, spanLightI (V2 (-2) 30) (V2 (-2) 70)
, analyser (RequireHealth 100) (PS 50 0) (PS (V2 70 50) 0)
]
& rmBound .~ [rectNSWE 75 15 0 40, switchcut]
return $
defaultRoom
& rmPolys .~ [rectNSWE 100 0 0 40, switchcut]
& rmLinks .~ muout lnks ++ muin [last lnks]
& rmPath .~ foldMap doublePairSet [(V2 20 95, V2 20 45), (V2 20 45, V2 20 5)]
& rmPmnts
.~ [ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
\btid -> Just $
putDoubleDoorThen DoorObstacle thewall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
\_ _ -> Just $ putDoubleDoor DoorObstacle thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
, invisibleWall $ rectNSWE 60 40 (-40) (-30)
, spanLightI (V2 (-2) 30) (V2 (-2) 70)
, analyser (RequireHealth 100) (PS 50 0) (PS (V2 70 50) 0)
]
& rmBound .~ [rectNSWE 75 15 0 40, switchcut]
where
thewall = switchWallCol col
switchcut = rectNSWE 65 35 (-40) 80
@@ -115,36 +119,37 @@ airlockSimple =
outDoorps = (V2 0 0,) <$> arcStepwise 3 (negate $ pi / 2) (V2 0 0) (V2 0 55)
inDoorps = (V2 0 0,) <$> arcStepwise 3 (negate $ pi / 2) (V2 0 0) (V2 (-55) 0)
airlockZ :: Room
airlockZ =
defaultRoom
{ _rmPolys =
[rectNSWE 120 0 0 180]
, _rmLinks = muout [(V2 0 30, pi / 2)] ++ muin [(V2 180 30, 1.5 * pi)]
, _rmPath = mempty
, -- [(V2 0 40,V2 40 0)
-- ,(V2 40 0,V2 0 40)
-- ]
_rmPmnts =
[ pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
\btid -> airlockDoubleDoor (V2 0 60) (V2 180 60) col (WdBlBtOn btid) outDoorps inDoorps
, -- jspsJ (V2 0 60) 0 (airlockDoor col (cond btid) outDoorps)
-- $ sPS (V2 180 60) 0 (airlockDoor col (cond btid) inDoorps)
sps0 $ PutWall (reverse $ rectNSWE 70 50 60 120) defaultWall
, lighting
]
, _rmBound =
[rectNSWE 120 0 0 180]
}
airlockZ :: RandomGen g => State g Room
airlockZ = do
let cenlight = mntLS vShape (V2 90 60) (V3 90 40 50) `addPlmnt` mntLS vShape (V2 90 60) (V3 90 80 50)
cornlight =
mntLS vShape (V2 0 120) (V3 30 90 50) `addPlmnt` mntLS vShape (V2 180 120) (V3 150 90 50)
`addPlmnt` sps0 (putShape (thinHighBar 50 (V2 30 90) (V2 150 90)))
lighting <- takeOne [cenlight, cornlight]
return
defaultRoom
{ _rmPolys =
[rectNSWE 120 0 0 180]
, _rmLinks = muout [(V2 0 30, pi / 2)] ++ muin [(V2 180 30, 1.5 * pi)]
, _rmPath = mempty
, -- [(V2 0 40,V2 40 0)
-- ,(V2 40 0,V2 0 40)
-- ]
_rmPmnts =
[ pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
\btid -> airlockDoubleDoor (V2 0 60) (V2 180 60) col (WdBlBtOn btid) outDoorps inDoorps
, -- jspsJ (V2 0 60) 0 (airlockDoor col (cond btid) outDoorps)
-- $ sPS (V2 180 60) 0 (airlockDoor col (cond btid) inDoorps)
sps0 $ PutWall (reverse $ rectNSWE 70 50 60 120) defaultWall
, lighting
]
, _rmBound =
[rectNSWE 120 0 0 180]
}
where
col = dim $ dim $ bright red
outDoorps = (V2 0 0,) <$> arcStepwise 3 (pi / 2) (V2 0 0) (V2 0 (-61))
inDoorps = (V2 0 0,) <$> arcStepwise 3 (pi / 2) (V2 0 0) (V2 (-61) 0)
cenlight = mntLS vShape (V2 90 60) (V3 90 40 50) `addPlmnt` mntLS vShape (V2 90 60) (V3 90 80 50)
cornlight =
mntLS vShape (V2 0 120) (V3 30 90 50) `addPlmnt` mntLS vShape (V2 180 120) (V3 150 90 50)
`addPlmnt` sps0 (putShape (thinHighBar 50 (V2 30 90) (V2 150 90)))
lighting = RandomPlacement $ takeOne [cenlight, cornlight]
airlock90 :: Room
airlock90 =
src/Dodge/Room/BlinkAcross.hs
+2 -2
View File
@@ -13,8 +13,8 @@ import System.Random
blinkAcrossChallenge :: RandomGen g => State g (MetaTree Room String)
blinkAcrossChallenge = do
teleFromRoom <- shuffleLinks $ roomRectAutoLinks 200 200
teleToRoom <- shuffleLinks $ roomRectAutoLinks 200 200
teleFromRoom <- shuffleLinks =<< roomRectAutoLinks 200 200
teleToRoom <- shuffleLinks =<< roomRectAutoLinks 200 200
emptylink <- shuffleLinks emptyCorridor
rToOnward "blinkAcrossChallenge" $
treePost [teleFromRoom, emptylink, cleatOnward teleToRoom]
src/Dodge/Room/Branch.hs
+1 -1
View File
@@ -17,7 +17,7 @@ branchRectWith t = do
x <- state $ randomR (100, 200)
y <- state $ randomR (100, 200)
b <- t
rt <- shuffleLinks $ roomRectAutoLinks x y
rt <- shuffleLinks =<< roomRectAutoLinks x y
return $
Node
rt
src/Dodge/Room/Containing.hs
+2 -2
View File
@@ -55,7 +55,7 @@ pedestalRoom it = do
r <-
takeOne
[ shuffleLinks =<< (centerVaultRoom x x 50 <&> rmPmnts .:~ sps0 flit)
, shuffleLinks $ roomRectAutoLinks (2 * x) (2 * x) & rmPmnts .:~ sPS (V2 x x) 0 flit
, shuffleLinks $ roomNgon ngon x & rmPmnts .:~ sps0 flit
, shuffleLinks =<< (roomRectAutoLinks (2 * x) (2 * x) <&> rmPmnts .:~ sPS (V2 x x) 0 flit)
, shuffleLinks =<< (roomNgon ngon x <&> rmPmnts .:~ sps0 flit)
]
r <&> rmName .++~ "ped-"
src/Dodge/Room/GlassLesson.hs
+27 -27
View File
@@ -22,6 +22,33 @@ import Control.Monad
glassLesson :: RandomGen g => State g (Tree Room)
glassLesson = do
l1 <- takeOne
[ spanLightI (V2 160 (-20)) (V2 160 220)
, mntLS vShape (V2 180 200) (V3 160 180 50)
]
l2 <- takeOne
[ spanLightI (V2 160 (-20)) (V2 160 220)
, mntLS vShape (V2 180 200) (V3 160 180 50)
]
let botplmnts =
[ sPS (V2 0 0) 0 $ PutWall (rectNSWE 200 0 90 110) defaultCrystalWall
, sPS (V2 50 100) 0 $ PutCrit miniGunCrit
, l1
]
topplmnts =
[ windowLine (V2 100 200) (V2 100 0)
, sPS (V2 50 100) 0 $ PutCrit miniGunCrit
, l2
]
botRoom =
roomRect 200 200 1 1
& rmPmnts .~ botplmnts
& rmLinks %~ setInLinksByType (OnEdge West)
topRoom =
roomRect 200 200 1 1
& rmPmnts .~ topplmnts
& rmLinks %~ setInLinks (fromWest South 0 . _rlType)
uppers = Node (door & rmConnectsTo .~ fromWest North 0) [pure topRoom]
i <- takeOne [1, 2, 3]
corridors <- replicateM i $ shuffleLinks corridor
return $
@@ -37,33 +64,6 @@ glassLesson = do
]
where
fromWest edge i s = OnEdge edge `S.member` s && FromEdge West i `S.member` s
uppers = Node (door & rmConnectsTo .~ fromWest North 0) [pure topRoom]
botRoom =
roomRect 200 200 1 1
& rmPmnts .~ botplmnts
& rmLinks %~ setInLinksByType (OnEdge West)
topRoom =
roomRect 200 200 1 1
& rmPmnts .~ topplmnts
& rmLinks %~ setInLinks (fromWest South 0 . _rlType)
botplmnts =
[ sPS (V2 0 0) 0 $ PutWall (rectNSWE 200 0 90 110) defaultCrystalWall
, sPS (V2 50 100) 0 $ PutCrit miniGunCrit
, RandomPlacement $
takeOne
[ spanLightI (V2 160 (-20)) (V2 160 220)
, mntLS vShape (V2 180 200) (V3 160 180 50)
]
]
topplmnts =
[ windowLine (V2 100 200) (V2 100 0)
, sPS (V2 50 100) 0 $ PutCrit miniGunCrit
, RandomPlacement $
takeOne
[ spanLightI (V2 160 (-20)) (V2 160 220)
, mntLS vShape (V2 180 200) (V3 160 180 50)
]
]
glassLessonRunPast :: RandomGen g => State g MTRS
glassLessonRunPast = glassLesson >>= rToOnward "glassLessonRunPast" . f
src/Dodge/Room/LasTurret.hs
+9 -8
View File
@@ -21,15 +21,16 @@ import Geometry
import LensHelp
import RandomHelp
cenLasTur :: Room
cenLasTur =
roomNgon 8 200 & rmPmnts
cenLasTur :: RandomGen g => State g Room
cenLasTur = do
thelight <- mntLightLnkCond $ rprBool $ const . isInLnk
roomNgon 8 200 <&> rmPmnts
.~ [ putLasTurret 0.02
, heightWallPS
(resetPLUse $ rprBoolShift (const . isInLnk) (shiftInBy 100))
30
covershape
, mntLightLnkCond $ rprBool $ const . isInLnk
, thelight
]
where
covershape = rectNSWE 10 (-10) (-20) 20
@@ -59,7 +60,7 @@ lightSensByDoor i rm =
keyCardRoomRunPast :: RandomGen g => Int -> Int -> State g (MetaTree Room String)
keyCardRoomRunPast keyid rmid = do
cenroom <- shuffleLinks $ keyCardAnalyserByDoor keyid rmid $ roomNgon 6 200
cenroom <- shuffleLinks =<< keyCardAnalyserByDoor keyid rmid <$> roomNgon 6 200
let doorroom = triggerDoorRoom rmid
rToOnward "keyCardRoomRunPast" $
treeFromTrunk [door] $
@@ -94,7 +95,7 @@ analyserByDoor = analyserByNthLink 0
healthTest :: RandomGen g => Int -> State g (Tree Room)
healthTest n = do
cenroom <- shuffleLinks $ healthAnalyserByDoor n $ roomNgon 8 200
cenroom <- shuffleLinks =<< healthAnalyserByDoor n <$> roomNgon 8 200
return $
treePost
[ door
@@ -106,14 +107,14 @@ healthTest n = do
lasSensorTurretTest :: RandomGen g => Int -> State g (MetaTree Room String)
lasSensorTurretTest n = do
cenroom <- shuffleLinks $ lightSensInsideDoor n cenLasTur
cenroom <- shuffleLinks =<< lightSensInsideDoor n <$> cenLasTur
rToOnward "lasSensorTurretTest" $
treePost
[door, cenroom, triggerDoorRoom n, cleatOnward door]
lasCenSensEdge :: RandomGen g => Int -> State g (MetaTree Room String)
lasCenSensEdge n = do
cenroom <- shuffleLinks $ lightSensByDoor n cenLasTur
cenroom <- shuffleLinks =<< lightSensByDoor n <$> cenLasTur
let doorroom = triggerDoorRoom n
rToOnward "lasCenSensEdge" $
treeFromTrunk [door] $
src/Dodge/Room/LongDoor.hs
+1 -1
View File
@@ -84,7 +84,7 @@ twinSlowDoorChasers = do
return $ twinSlowDoorRoom 80 200 40 & rmPmnts %~ (plmnts ++)
southPillarsRoom :: RandomGen g => Float -> Float -> Float -> State g Room
southPillarsRoom x y h = addSouthPillars x h (roomRectAutoLinks x y)
southPillarsRoom x y h = addSouthPillars x h =<< (roomRectAutoLinks x y)
addSouthPillars :: RandomGen g => Float -> Float -> Room -> State g Room
addSouthPillars x h r = do
src/Dodge/Room/Ngon.hs
+6 -4
View File
@@ -1,5 +1,6 @@
module Dodge.Room.Ngon where
import RandomHelp
import Data.List
import Data.Maybe
import Data.Tile
@@ -11,13 +12,14 @@ import Dodge.RoomLink
import Geometry
import Tile
roomNgon :: Int -> Float -> Room
roomNgon n x =
defaultRoom
roomNgon :: RandomGen g => Int -> Float -> State g Room
roomNgon n x = do
thelight <-mntLightLnkCond $ resetPLUse $ rprBool $ const . isInLnk
return defaultRoom
{ _rmPolys = [poly]
, _rmLinks = map toBothLnk lnks -- muout (init lnks) ++ muin[last lnks]
, _rmPath = mempty -- TODO
, _rmPmnts = [mntLightLnkCond $ resetPLUse $ rprBool $ const . isInLnk]
, _rmPmnts = [thelight]
, _rmBound = [poly]
, _rmFloor = Tiled [makeTileFromPoly poly 2]
, _rmName = show n ++ "gon"
src/Dodge/Room/Pillar.hs
+4 -3
View File
@@ -48,9 +48,10 @@ smallPillar = PutBlock defaultBlock baseBlockPane $ reverse $ square 5
roomPillarsSquare :: RandomGen g => State g Room
roomPillarsSquare = do
let rm' = roomRectAutoLinks 300 300
nlew = _numLinkEW (_rmType rm')
rm' <- roomRectAutoLinks 300 300
let nlew = _numLinkEW (_rmType rm')
nlns = _numLinkNS (_rmType rm')
thelight <- mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp
addlights <-
takeOne
[ return
@@ -76,7 +77,7 @@ roomPillarsSquare = do
. ( rmPmnts
.++~ [ spanColLightBlackI 0.75 95 (V2 0 130) (V2 300 130)
, spanColLightBlackI 0.75 95 (V2 0 170) (V2 300 170)
, mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp
, thelight
]
)
]
src/Dodge/Room/Procedural.hs
+6 -7
View File
@@ -135,14 +135,13 @@ lnkBothAnd rlt ltcon ltcon2 i (j, (p, a)) =
{- 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)
roomRectAutoLinks :: Float -> Float -> Room
roomRectAutoLinks x y =
roomRect x y (f x) (f y)
roomRectAutoLinks :: RandomGen g => Float -> Float -> State g Room
roomRectAutoLinks x y = do
l1 <- mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isInLnk rp
l2 <- mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp
return $ roomRect x y (f x) (f y)
& rmName .~ "autoRect"
& rmPmnts
.~ [ mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isInLnk rp
, mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp
]
& rmPmnts .~ [ l1 , l2 ]
where
f z = max 1 $ (ceiling z - 40) `div` 60
src/Dodge/Room/RezBox.hs
+3 -4
View File
@@ -95,7 +95,7 @@ rezBoxesWpCrit = do
theweapon <- randBlockBreakWeapon
let bottomEdgeTest (V2 _ y, _) = y < 1
aroom = rezInvBox thecol
let centralRoom = (roomRectAutoLinks w h){_rmPmnts = []}
centralRoom <- roomRectAutoLinks w h <&> rmPmnts .~ []
onwardpassage <-
over root (rmConnectsTo .~ S.member (OnEdge West)) <$> maybeBlockedPassage
let n = length $ filter bottomEdgeTest $ map lnkPosDir $ _rmLinks centralRoom
@@ -126,9 +126,8 @@ rezBoxes = do
[door & rmConnectsTo .~ S.member (OnEdge South)]
(rezInvBox thecol)
centralRoom <-
shuffleLinks $
(roomRectAutoLinks w h){_rmPmnts = []}
& rmLinks %~ setInLinks bottomEdgeTest
shuffleLinks =<< (roomRectAutoLinks w h <&> rmPmnts .~ []
<&> rmLinks %~ setInLinks bottomEdgeTest)
let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom
return
. tToBTree "rezBoxes"
src/Dodge/Room/Room.hs
+22 -22
View File
@@ -41,13 +41,13 @@ roomC w h = do
maybeaddgird <- takeOne [return, addRandomGirderFrom West 0, addRandomGirderFrom North 0]
maybeaddgird
=<< shuffleLinks
( roomRectAutoLinks w h
& rmLinks
=<< ( roomRectAutoLinks w h
<&> rmLinks
%~ ( setInLinks (\rl -> S.fromList [FromEdge East 0, OnEdge South] `S.isSubsetOf` _rlType rl)
. setOutLinks (\rl -> OnEdge West `S.member` _rlType rl)
)
& rmPmnts .:~ wallf (V2 (w / 2) 0) (V2 (w / 2) (h -60))
& rmRandPSs .~ [farside]
<&> rmPmnts .:~ wallf (V2 (w / 2) 0) (V2 (w / 2) (h -60))
<&> rmRandPSs .~ [farside]
)
where
farside = do
@@ -118,6 +118,14 @@ roomMiniIntro = do
roomCenterPillar :: RandomGen g => State g Room
roomCenterPillar = do
l1 <- mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isInLnk rp)
l2 <- mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isOutLnk rp)
let plmnts =
[ blockLine (V2 115 115) (V2 115 125)
, blockLine (V2 125 115) (V2 125 125)
, l1
, l2
]
addHighGirder'
=<< ( shuffleLinks . restrictInLinks ((\p -> dist p (V2 120 0) < 10) . fst) $
cleatSide $
@@ -126,24 +134,18 @@ roomCenterPillar = do
roomRect 240 240 2 2
)
where
plmnts =
[ blockLine (V2 115 115) (V2 115 125)
, blockLine (V2 125 115) (V2 125 125)
, -- , mntLightLnkCond useUnusedLnk
mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isInLnk rp)
, mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isOutLnk rp)
]
weaponEmptyRoom :: State StdGen (Tree Room)
weaponEmptyRoom = do
w <- state $ randomR (220, 300)
h <- state $ randomR (220, 300)
wp <- randFirstWeapon
thelight <- mntLightLnkCond useUnusedLnk
let plmnts =
[ sPS (V2 (w / 2) (h -40)) 0 $ PutFlIt wp
, sPS (V2 20 20) (pi / 2) randC1
, sPS (V2 (w -20) 20) (pi / 2) randC1
, mntLightLnkCond useUnusedLnk
, thelight
]
f (V2 x y, a) = (a == pi && x > 25 && x < w - 25) || (a /= 0 && y > w - 30)
rm <-
@@ -153,7 +155,7 @@ weaponEmptyRoom = do
weaponUnderCrits :: RandomGen g => State g (MetaTree Room String)
weaponUnderCrits = do
let addwpat p = rmPmnts .:~(sPS p 0 $ RandPS $ fmap PutFlIt randFirstWeapon)
let addwpat p = rmPmnts .:~ (sPS p 0 $ RandPS $ fmap PutFlIt randFirstWeapon)
continuationRoom =
treePost
[ addwpat (V2 20 0) corridorN
@@ -296,21 +298,19 @@ shootersRoom' = do
, spanLightI (V2 (w / 2) 200) (V2 (w + 10) 200)
]
toPS x y = return (V2 x y, -0.5 * pi)
return $
set rmPmnts plmnts $
roomRectAutoLinks w 600
& rmPmnts .~ plmnts
& rmRandPSs .~ [toPS x1 y1, toPS x2 y2, toPS x3 y3]
roomRectAutoLinks w 600
<&> rmPmnts .~ plmnts
<&> rmRandPSs .~ [toPS x1 y1, toPS x2 y2, toPS x3 y3]
shootersRoom1 :: RandomGen g => State g Room
shootersRoom1 =
shootersRoom' <&> rmPmnts
.:~ RandomPlacement
( takeOne $
shootersRoom1 = do
pl <- ( takeOne $
map
(\i -> psPtPl (PSRoomRand i (uncurry PS)) (PutCrit autoCrit))
[0, 1, 2]
)
shootersRoom' <&> rmPmnts
.:~ pl
shootersRoom :: RandomGen g => State g Room
shootersRoom =
src/Dodge/Room/RunPast.hs
+1 -1
View File
@@ -37,7 +37,7 @@ lockedStart i = do
h <- state $ randomR (200, 400 :: Float)
thels <- roomCritLS
theweapon <- randBlockBreakWeapon
cenroom <- shuffleLinks $ roomRectAutoLinks 40 h & rmPmnts .~ []
cenroom <- shuffleLinks =<< (roomRectAutoLinks 40 h <&> rmPmnts .~ [])
theedge <- takeOne $ map OnEdge [West, East]
let linkcor = smallRoom & rmPmnts .~ [spanLS thels (V2 0 65) (V2 40 65)]
n = length $ filter (elem theedge . _rlType) (_rmLinks cenroom)
src/Dodge/Room/SensorDoor.hs
+2 -1
View File
@@ -19,12 +19,13 @@ 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 senseType n = do
rm <- takeOne [roomNgon 8 200, roomRectAutoLinks 200 200]
rm <- join $ takeOne [roomNgon 8 200, roomRectAutoLinks 200 200]
cenroom <- shuffleLinks $ sensInsideDoor senseType n rm
return $ treePost
[ door
src/Dodge/Room/Tanks.hs
+4 -3
View File
@@ -95,7 +95,7 @@ tanksPipesRoom = do
h <- state $ randomR (200, 300)
i <- state $ randomR (2, 5)
tanks <- randEdgeTanks i
return $ roomRectAutoLinks w h & rmPmnts .++~ tanks
roomRectAutoLinks w h <&> rmPmnts .++~ tanks
tanksRoom :: RandomGen g => [Creature] -> [Item] -> State g Room
tanksRoom crs its = do
@@ -103,12 +103,13 @@ tanksRoom crs its = do
h <- state $ randomR (200, 400)
ntanks <- state $ randomR (3, 6)
thetank <- randomTank <&> plSpot .~ unusedOffPathAwayFromLink 50
let room = roomRectAutoLinks w h
thelight <- mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp
room <- roomRectAutoLinks w h
let plmnts =
map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) its
++ map (\cr -> sps0 (PutCrit cr) & plSpot .~ unusedSpotAwayFromLink 50) crs
++ replicate ntanks thetank
++ [mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp]
++ [thelight]
-- , sps0 $ PutShape $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
hgshape <- takeOne [girder 96 20 10, girderZ 96 20 10, girderV 96 20 10]
addhighgirds <-
src/Dodge/Room/Teleport.hs
+1 -2
View File
@@ -19,8 +19,7 @@ telRoomLev ::
telRoomLev _ = do
w <- state $ randomR (200, 300)
h <- state $ randomR (200, 300)
return $
roomRectAutoLinks w h & rmPmnts
roomRectAutoLinks w h <&> rmPmnts
.~ [ sPS (V2 (w / 2) (h / 2)) 0 $ PutPPlate telPP
, sPS (V2 (w / 2) (h / 2 + 30)) 0 putLamp
]
src/Dodge/Room/Tutorial.hs
+11 -8
View File
@@ -55,26 +55,29 @@ tutAnoTree =
tutDrop :: State LayoutVars (MetaTree Room String)
tutDrop = do
x <- shuffleLinks $ roomNgon 6 100
x <- shuffleLinks =<< roomNgon 6 100
y <- decontamRoom
return $ tToBTree "TutDrop" $ treePost [x,y,cleatOnward $ roomRectAutoLinks 40 100]
rm <- roomRectAutoLinks 40 100
return $ tToBTree "TutDrop" $ treePost [x,y,cleatOnward rm]
tutRooms :: State LayoutVars (MetaTree Room String)
tutRooms = do
i <- nextLayoutInt
j <- nextLayoutInt
x <- shuffleLinks $ analyserByDoor (RequireEquipment (AMMOMAG DRUMMAG)) i
$ addDoorAtNthLinkToggleTerminal 1 (makeTermPara s) j
$ roomNgon 6 100
x <- shuffleLinks =<< analyserByDoor (RequireEquipment (AMMOMAG DRUMMAG)) i
<$> addDoorAtNthLinkToggleTerminal 1 (makeTermPara s) j
<$> roomNgon 6 100
bcor <- blockedCorridor
r1 <-(r burstRifle)
r2 <-(r (drumMag & itConsumables ?~ 100))
return $ tToBTree "DoorTest" $ Node x
[treeFromPost [triggerDoorRoom i] (r burstRifle)
,treeFromPost [triggerDoorRoom j] (r (drumMag & itConsumables ?~ 100))
[treeFromPost [triggerDoorRoom i] r1
,treeFromPost [triggerDoorRoom j] r2
,bcor
]
where
s = "INTERACTION TEST: USE KEYBOARD OR SCROLL TO ENTER COMMANDS."
r x = roomRectAutoLinks 100 100 & rmPmnts .:~ sps (PS 50 0) (PutFlIt x)
r x = roomRectAutoLinks 100 100 <&> rmPmnts .:~ sps (PS 50 0) (PutFlIt x)
tutRezBox :: RandomGen g => State g Room
tutRezBox = do
src/Dodge/Room/Warning.hs
+1 -2
View File
@@ -26,8 +26,7 @@ import RandomHelp
warningRooms :: String -> Int -> State StdGen (MetaTree Room String)
warningRooms str n = do
rm <- do
tr <- tanksRoom [] []
takeOne [roomNgon 8 200, roomRectAutoLinks 200 200, tr]
join $ takeOne [roomNgon 8 200, roomRectAutoLinks 200 200, tanksRoom [] []]
cenroom <- shuffleLinks $ addWarningTerminal str n rm
rToOnward "warningRooms" $ treePost [door, cenroom, triggerDoorRoom n, cleatOnward door]