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

Add log when generating layout

Browse Source
This commit is contained in:
justin
2022-05-20 21:15:44 +01:00
parent 20d041fc59
commit da302aad0c
16 changed files with 155 additions and 94 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Containing.hs
+3 -2
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Room.Containing where
import Dodge.Data
import Dodge.Tree
@@ -14,13 +15,13 @@ import Geometry
import System.Random
import Control.Monad.State
roomsContaining :: RandomGen g => [Creature] -> [Item] -> State g (SubCompTree Room)
roomsContaining :: RandomGen g => [Creature] -> [Item] -> State g (LabSubCompTree Room)
roomsContaining crs its = do
endroom <- join $ takeOne
[ randomFourCornerRoomCrsIts crs its
, tanksRoom crs its
]
return $ treeFromPost [] $ UseAll endroom
(return $ treeFromPost [] $ UseAll endroom) <&> (,TreeSubLabelling "roomsContaining" Nothing)
pedestalRoom :: RandomGen g => Item -> State g Room
pedestalRoom it = do
src/Dodge/Room/Corridor.hs
+3
View File
@@ -59,6 +59,7 @@ corridorN = defaultRoom
, _rmPath = pth
, _rmPmnts = []
, _rmBound = [ rectNSWE 50 30 0 40 ]
, _rmName = "corridorN"
}
where lnks = [uncurry outLink (V2 20 70 ,0)
,uncurry inLink (V2 20 10 ,pi)
@@ -88,6 +89,7 @@ tEast = defaultRoom
, _rmPath = concatMap (doublePair . (,) (V2 0 60) . fst) lnks
, _rmPmnts = []
, _rmBound = [ rectNSWE 70 10 0 40 ]
, _rmName = "tEast"
}
where
lnks =
@@ -109,6 +111,7 @@ tWest = defaultRoom
, _rmPath = concatMap (doublePair . (V2 0 60 ,) . _rlPos) lnks
, _rmPmnts = []
, _rmBound = [ rectNSWE 70 10 0 40 ]
, _rmName = "tWest"
}
where
lnks =
src/Dodge/Room/GlassLesson.hs
+3 -2
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Room.GlassLesson where
import Dodge.RoomLink
import Dodge.Creature
@@ -54,7 +55,7 @@ glassLesson = do
, mntLS vShape (V2 180 200) (V3 160 180 50)
]
]
glassLessonRunPast :: RandomGen g => State g (SubCompTree Room)
glassLessonRunPast = f <$> glassLesson
glassLessonRunPast :: RandomGen g => State g (LabSubCompTree Room)
glassLessonRunPast = (f <$> glassLesson) <&> (,TreeSubLabelling "glassLessonRunPast" Nothing)
where
f (Node r rs) = Node r $ return (UseLabel 0 $ door & rmConnectsTo .~ S.member (OnEdge West)) : rs
src/Dodge/Room/LasTurret.hs
+14 -11
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Room.LasTurret where
import Dodge.LevelGen.Data
import Dodge.PlacementSpot
@@ -72,14 +73,14 @@ lightSensByDoor outplid rm = rm
covershape = rectNSEW 10 (-10) 20 (-20)
sensorshift (p,a) = (p +.+ rotateV a (V2 60 (-20)), a)
keyCardRoomRunPast :: RandomGen g => Int -> Int -> State g (SubCompTree Room)
keyCardRoomRunPast :: RandomGen g => Int -> Int -> State g (LabSubCompTree Room)
keyCardRoomRunPast keyid rmid = do
cenroom <- shuffleLinks $ keyCardAnalyserByDoor keyid rmid $ roomNgon 6 200
let doorroom = triggerDoorRoom rmid
return $ treeFromTrunk [PassDown door] $ Node (PassDown cenroom)
(return $ treeFromTrunk [PassDown door] $ Node (PassDown cenroom)
[ treeFromPost [PassDown doorroom] (UseAll door)
, treeFromPost [PassDown door] (UseLabel 0 corridor)
]
]) <&> (,TreeSubLabelling "keyCardRoomRunPast" Nothing)
keyCardAnalyserByDoor :: Int -> Int -> Room -> Room
keyCardAnalyserByDoor keyid = analyserByDoor
@@ -133,20 +134,22 @@ healthTest n = do
,PassDown $ corridor & rmPmnts .:~ spNoID (PS 20 0) (PutFlIt (medkit 100))
,PassDown cenroom,PassDown doorroom] (UseAll door)
lasSensorTurretTest :: RandomGen g => Int -> State g (SubCompTree Room)
lasSensorTurretTest :: RandomGen g => Int -> State g (LabSubCompTree Room)
lasSensorTurretTest n = do
cenroom <- shuffleLinks $ lightSensInsideDoor n cenLasTur
let doorroom = triggerDoorRoom n
return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
return ( treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
, TreeSubLabelling "lasSensorTurretTest" Nothing
)
lasCenSensEdge :: RandomGen g => Int -> State g (SubCompTree Room)
lasCenSensEdge :: RandomGen g => Int -> State g (LabSubCompTree Room)
lasCenSensEdge n = do
cenroom <- shuffleLinks $ lightSensByDoor n cenLasTur
let doorroom = triggerDoorRoom n
return $ treeFromTrunk [PassDown door] $ Node (PassDown cenroom)
(return $ treeFromTrunk [PassDown door] $ Node (PassDown cenroom)
[ treeFromPost [PassDown doorroom] (UseAll door)
, treeFromPost [PassDown door] (UseLabel 0 corridor)
]
]) <&> (,TreeSubLabelling "lasCenSensEdge" Nothing)
lasTunnel :: RandomGen g => Float -> State g Room
lasTunnel y = do
@@ -183,12 +186,12 @@ lasTunnel y = do
]
-- a y value of 400 is probably "unrunnable"
lasTunnelRunPast :: RandomGen g => Float -> State g (SubCompTree Room)
lasTunnelRunPast :: RandomGen g => Float -> State g (LabSubCompTree Room)
lasTunnelRunPast y = do
r <- lasTunnel y
r1 <- takeOne [door,corridor]
r2 <- takeOne [door,corridor]
return $ Node (PassDown r)
(return $ Node (PassDown r)
[ singleUseAll r1
, return (UseLabel 0 $ r2 & rmConnectsTo .~ S.member InLink)
]
]) <&> (,TreeSubLabelling "lasTunnelRunPast" Nothing)
src/Dodge/Room/LongDoor.hs
+4 -4
View File
@@ -1,4 +1,4 @@
--{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TupleSections #-}
{- | Rooms containing long doors, probably with a big reveal behind them.
-}
module Dodge.Room.LongDoor where
@@ -142,10 +142,10 @@ slowDoorRoom = do
proom <- southPillarsRoom x y h
addButtonSlowDoor x h (proom & rmPmnts %~ (++ (crits ++ barrels)))
slowDoorRoomRunPast :: RandomGen g => State g (SubCompTree Room)
slowDoorRoomRunPast :: RandomGen g => State g (LabSubCompTree Room)
slowDoorRoomRunPast = do
r <- slowDoorRoom
return $ treeFromTrunk [PassDown door] $ Node (PassDown r)
(return $ treeFromTrunk [PassDown door] $ Node (PassDown r)
[ singleUseAll door
, return (UseLabel 0 $ door & rmConnectsTo .~ S.member InLink)
]
] ) <&> (,TreeSubLabelling "slowDoorRoomRunPast" Nothing)
src/Dodge/Room/LongRoom.hs
+4 -2
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Room.LongRoom where
import Dodge.RoomLink
import Dodge.Tree
@@ -48,10 +49,10 @@ longRoom = do
| crx <- [12.5,37.5,62.5] ] ++
[sPS (V2 25 lampy ) 0 putLamp | lampy <- [20,h-10] ]
longRoomRunPast :: RandomGen g => State g (SubCompTree Room)
longRoomRunPast :: RandomGen g => State g (LabSubCompTree Room)
longRoomRunPast = do
r <- longRoom
return $ treeFromTrunk [PassDown door]
(return $ treeFromTrunk [PassDown door]
(Node (PassDown r)
[ singleUseAll door
--, return (UseLabel 0 $ door & rmConnectsTo .~ S.singleton InLink)
@@ -60,3 +61,4 @@ longRoomRunPast = do
(UseLabel 0 door)
]
)
) <&> (,TreeSubLabelling "longRoomRunPast" Nothing)
src/Dodge/Room/Room.hs
+43 -22
View File
@@ -130,14 +130,18 @@ rot90Around cen p = cen +.+ vNormal (p -.- cen)
-- So, the idea is to attach outer children to the bottommost right nodes
-- inside an inner tree
roomMiniIntro :: RandomGen g => State g (SubCompTree Room)
roomMiniIntro :: RandomGen g => State g (LabSubCompTree Room)
roomMiniIntro = do
midroom <- join $ takeOne [miniTree2] --,glassLesson]
return $ chainUses [return $ UseAll corridor,return $ UseAll corridor,return $ UseAll corridor,return $ UseAll door, midroom,return $ UseAll corridor]
(return $ chainUses
[return $ UseAll corridor,return $ UseAll corridor,return $ UseAll corridor,return $ UseAll door, midroom,return $ UseAll corridor]
) <&> (,TreeSubLabelling "roomMiniIntro" Nothing)
roomCenterPillar :: RandomGen g => State g Room
roomCenterPillar = shuffleLinks . restrictInLinks ((\p -> dist p (V2 120 0) < 10) . fst)
$ set rmPmnts plmnts $ roomRect 240 240 2 2
$ set rmPmnts plmnts
$ set rmName "roomCenterPillar"
$ roomRect 240 240 2 2
where
plmnts =
[ blockLine (V2 115 115) (V2 115 125)
@@ -196,7 +200,7 @@ weaponEmptyRoom = do
$ restrictRMInLinksPD f (roomRect w h 2 2 & rmPmnts .~ plmnts)
return $ treeFromTrunk [PassDown corridor] (singleUseAll rm )
weaponUnderCrits :: RandomGen g => Int -> State g (SubCompTree Room)
weaponUnderCrits :: RandomGen g => Int -> State g (LabSubCompTree Room)
weaponUnderCrits i = do
let plmnts =
[--sPS (V2 20 0) 0 $ RandPS randFirstWeapon
@@ -204,23 +208,36 @@ weaponUnderCrits i = do
,sPS (V2 20 20) ( pi/2) randC1
]
addwpat p = rmPmnts .:~ PickOnePlacement i (sPS p 0 $ RandPS randFirstWeapon)
let continuationRoom = treeFromTrunk
let continuationRoom = treeFromTrunk
[PassDown $ addwpat (V2 20 0) corridorN,PassDown $ addwpat (V2 20 0) corridorN]
(singleUseAll (set rmPmnts plmnts corridorN))
rcp <- roomCenterPillar
rcp <- roomCenterPillar
rmpils <- roomPillars 30 240 240 2 2
deadEndRoom' <- takeOne
[ addwpat (V2 120 20) rmpils
, addwpat (V2 120 20) rcp]
junctionRoom <- takeOne [PassDown tEast,PassDown tWest]
return $ treeFromTrunk
--[PassDown $ corridorN & rmPmnts .:~ mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isInLnk rp)
[PassDown corridorN
,PassDown corridorN]
$ Node junctionRoom
[continuationRoom
,singleUseNone deadEndRoom'
]
let thetree = treeFromTrunk
--[PassDown $ corridorN & rmPmnts .:~ mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isInLnk rp)
[PassDown corridorN
,PassDown corridorN]
$ Node junctionRoom
[continuationRoom
,singleUseNone deadEndRoom'
]
return thetree
<&> (, TreeSubLabelling ("weaponUnderCrits "++show i) (Just $ fmap composingNodeName thetree))
composingNodeName :: ComposingNode Room -> TreeSubLabelling
composingNodeName cn = case cn of
PassDown rm -> f $ _rmName rm ++ "-PassDown"
SplitDown rm -> f $ _rmName rm ++ "-SplitDown"
UseAll rm -> f $ _rmName rm ++ "-UseAll"
UseSome is rm -> f $ _rmName rm ++ "-" ++ show is ++ "-UseSome"
UseNone rm -> f $ _rmName rm ++ "-UseNone"
UseLabel i rm -> f $ _rmName rm ++ "-" ++ show i ++ "-UseLabel"
where
f str = TreeSubLabelling str Nothing
weaponBehindPillar :: RandomGen g => State g (SubCompTree Room)
weaponBehindPillar = do
@@ -285,18 +302,21 @@ deadEndRoom = defaultRoom
, _rmPath = []
, _rmPmnts = [sPS (V2 0 (-10)) 0 putLamp]
, _rmBound = [rectNSWE 20 (-20) (-30) 30]
, _rmName = "deadEndRoom"
}
where
lnks = [(V2 0 30 ,0) ]
{- A random Either tree with a weapon and melee monster challenge. -}
weaponRoom :: RandomGen g => Int -> State g (SubCompTree Room, String)
weaponRoom :: RandomGen g => Int -> State g (LabSubCompTree Room)
weaponRoom i = join $ takeOne
[ weaponEmptyRoom <&> (, "weaponEmptyRoom")
, weaponUnderCrits i<&> (, "weaponUnderCrits")
, weaponBehindPillar<&> (, "weaponBehindPillar")
, weaponBetweenPillars<&> (, "weaponBetweenPillars")
, weaponLongCorridor<&> (, "weaponLongCorridor")
[ weaponEmptyRoom <&> (,f "weaponEmptyRoom")
, weaponUnderCrits i
, weaponBehindPillar<&> (,f "weaponBehindPillar")
, weaponBetweenPillars<&> (,f "weaponBetweenPillars")
, weaponLongCorridor<&> (,f "weaponLongCorridor")
]
where
f str = TreeSubLabelling str Nothing
roomCCrits :: RandomGen g => State g Room
roomCCrits = roomC 200 200
@@ -392,7 +412,7 @@ pistolerRoom = pillarGrid
]
++)
shootingRange :: RandomGen g => State g (SubCompTree Room)
shootingRange :: RandomGen g => State g (LabSubCompTree Room)
shootingRange = do
rm1 <- shootersRoom1 >>= randomiseAllLinks . restrictInLinks (\(V2 _ y,_) -> y < 40)
. restrictOutLinks (\(V2 _ y,r) -> y > 200 && r /= 0)
@@ -402,7 +422,7 @@ shootingRange = do
rm3 <- shootersRoom >>= randomiseAllLinks
. restrictInLinks (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
. restrictOutLinks (\(_,r) -> r == 0)
return $ treeFromPost
(return $ treeFromPost
[PassDown rm1
,PassDown $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
& rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
@@ -411,6 +431,7 @@ shootingRange = do
& rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
]
(UseAll rm3)
) <&> (,TreeSubLabelling "shootingRange" Nothing)
spawnerRoom :: RandomGen g => State g (SubCompTree Room)
spawnerRoom = do
src/Dodge/Room/SensorDoor.hs
+4 -3
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Room.SensorDoor where
import Dodge.LevelGen.Data
import Dodge.PlacementSpot
@@ -41,14 +42,14 @@ sensorRoom senseType n = do
let doorroom = triggerDoorRoom n
return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
sensorRoomRunPast :: RandomGen g => DamageType -> Int -> State g (SubCompTree Room)
sensorRoomRunPast :: RandomGen g => DamageType -> Int -> State g (LabSubCompTree Room)
sensorRoomRunPast dt n = do
t <- sensorRoom dt n
return $ applyToSubforest [0] (++
(return $ applyToSubforest [0] (++
[treeFromPost [PassDown $ door & rmConnectsTo .~ S.member InLink
& rmName .~ "test"
] (UseLabel 0 corridor)]
) t
) t ) <&> (,TreeSubLabelling "sensorRoomRunPast" Nothing)
--[return $ UseLabel 0 $ door & rmConnectsTo .~ S.member InLink]
sensAboveDoor :: DamageType -> Float -> PlacementSpot -> Placement
src/Dodge/Room/Start.hs
+20 -18
View File
@@ -49,25 +49,27 @@ powerFakeout = do
,PassDown keyholeCorridor,PassDown corridor])
`treeFromPost` UseAll door
startRoom :: RandomGen g => Int -> State g (SubCompTree Room,String)
startRoom i = join $ uncurry takeOneWeighted $ unzip
startRoom :: RandomGen g => Int -> State g (LabSubCompTree Room)
startRoom i = (join $ uncurry takeOneWeighted $ unzip
[ (,) (0.5::Float) ((chainUses <$> sequence [powerFakeout,fmap fst $weaponRoom i])
<&> (,"chainUses <$> sequence [powerFakeout,weaponRoom i]"))
, (,) one (rezBoxesWp <&> (, "rezBoxesWp"))
<&> (,TreeSubLabelling "chainUses <$> sequence [powerFakeout,weaponRoom i]" Nothing))
, (,) one (rezBoxesWp <&> (,TreeSubLabelling "rezBoxesWp" Nothing))
, (,) one (rezBoxThenWeaponRoom i)
, (,) one (rezBoxesWpCrit <&> (,"rezBoxesWpCrit"))
, (,) one (runPastStart i <&> (,"runPastStart " ++ show i))
, (,) one (startCrafts >>= roomsContaining [] >>= rezBoxThenRooms <&>
(,"startCrafts >>= roomsContaining [] >>= rezBoxThenRooms"))
]
, (,) one (rezBoxesWpCrit <&> (,TreeSubLabelling "rezBoxesWpCrit" Nothing))
, (,) one (runPastStart i <&> (,TreeSubLabelling ("runPastStart " ++ show i) Nothing))
, (,) one (startCrafts >>= roomsContaining' [] >>= rezBoxThenRooms <&>
(,TreeSubLabelling "startCrafts >>= roomsContaining [] >>= rezBoxThenRooms" Nothing))
])
<&> over (_2 . topLabel) ("startRoom:"++)
where
roomsContaining' a b = fst <$> roomsContaining a b
one = 1::Float
randomChallenges :: RandomGen g => State g (SubCompTree Room)
randomChallenges = join $ takeOne
[fmap (return . UseAll) doubleCorridorBarrels
randomChallenges :: RandomGen g => State g (LabSubCompTree Room)
randomChallenges = join (takeOne
[fmap (return . UseAll) doubleCorridorBarrels <&> (,TreeSubLabelling "doubleCorridorBarrels" Nothing)
,shootingRange
,fmap (return . UseAll) twinSlowDoorChasers
]
,fmap (return . UseAll) twinSlowDoorChasers <&> (,TreeSubLabelling "twinSlowDoorChasers" Nothing)
]) <&> (over (_2 . topLabel) ("randomChallenges:"++))
runPastStart :: RandomGen g => Int -> State g (SubCompTree Room)
runPastStart i = do
@@ -83,15 +85,15 @@ rezBoxStart = do
rezBoxesThenWeaponRoom :: RandomGen g => Int -> State g (SubCompTree Room,String)
rezBoxesThenWeaponRoom i = do
rboxes <- rezBoxes
wroom <- fmap fst $ weaponRoom i
wroom <- fst <$> weaponRoom i
return (rboxes `passUntilUseAll` [wroom] , "rezBoxesThenWeaponRoom " ++ show i)
rezBoxThenWeaponRoom :: RandomGen g => Int -> State g (SubCompTree Room,String)
rezBoxThenWeaponRoom :: RandomGen g => Int -> State g (LabSubCompTree Room)
rezBoxThenWeaponRoom i = do
rcol <- rezColor
(wroom,wroomname) <- weaponRoom i
return $ (treeFromTrunk [PassDown $ rezBox rcol,PassDown door] wroom
, "rezBoxThenWeaponRoom "++ show i ++ ":" ++ wroomname)
return (treeFromTrunk [PassDown $ rezBox rcol,PassDown door] wroom
, TreeSubLabelling ("rezBoxThenWeaponRoom "++ show i) (Just $ return wroomname))
rezBoxThenRoom :: RandomGen g => Room -> State g (SubCompTree Room)
rezBoxThenRoom r = do