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

Cleanup

Browse Source
This commit is contained in:
justin
2022-06-10 20:53:01 +01:00
parent 1b7463f287
commit 6966e76206
14 changed files with 54 additions and 75 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Branch.hs
+2 -2
View File
@@ -22,7 +22,7 @@ branchRectWith t = do
y <- state $ randomR (100,200)
b <- t
rt <- shuffleLinks $ roomRectAutoLinks x y
return $ Node ( rt)
return $ Node rt
[ Node (useAll door) []
, useSide <$> treeFromTrunk [ door] b
, treeFromTrunk [door] b
]
src/Dodge/Room/LasTurret.hs
+5 -8
View File
@@ -76,9 +76,9 @@ keyCardRoomRunPast keyid rmid = do
cenroom <- shuffleLinks $ keyCardAnalyserByDoor keyid rmid $ roomNgon 6 200
let doorroom = triggerDoorRoom rmid
return (toOnward "keyCardRoomRunPast",
treeFromTrunk [door] $ Node (cenroom)
treeFromTrunk [door] $ Node cenroom
[ treeFromPost [doorroom] (useAll door)
, treeFromPost [door] (useLabel 0 corridor)
, treeFromPost [door] (useLabel rmid corridor)
])
keyCardAnalyserByDoor :: Int -> Int -> Room -> Room
@@ -124,12 +124,11 @@ lasCenSensEdge :: RandomGen g => Int -> State g (LabTree Room)
lasCenSensEdge n = do
cenroom <- shuffleLinks $ lightSensByDoor n cenLasTur
let doorroom = triggerDoorRoom n
return (toOnward "lasCenSensEdge"
, treeFromTrunk [ door] $ Node ( cenroom)
rToOnward "lasCenSensEdge"
$ treeFromTrunk [ door] $ Node cenroom
[ treeFromPost [ doorroom] (useAll door)
, treeFromPost [ door] (useLabel 0 corridor)
]
)
lasTunnel :: RandomGen g => Float -> State g Room
lasTunnel y = do
@@ -171,9 +170,7 @@ lasTunnelRunPast y = do
r <- lasTunnel y
r1 <- takeOne [door,corridor]
r2 <- takeOne [door,corridor]
return (toOnward "lasTunnelRunPast"
, Node ( r)
rToOnward "lasTunnelRunPast" $ Node r
[ pure $ useAll r1
, return (useLabel 0 $ r2 & rmConnectsTo .~ S.member InLink)
]
)
src/Dodge/Room/LongDoor.hs
+1 -3
View File
@@ -143,9 +143,7 @@ slowDoorRoom = do
slowDoorRoomRunPast :: RandomGen g => State g (LabTree Room)
slowDoorRoomRunPast = do
r <- slowDoorRoom
return ( toOnward "slowDoorRoomRunPast"
, treeFromTrunk [ door] $ Node ( r)
rToOnward "slowDoorRoomRunPast" $ treeFromTrunk [ door] $ Node r
[ pure $ useAll door
, return (useLabel 0 $ door & rmConnectsTo .~ S.member InLink)
]
)
src/Dodge/Room/LongRoom.hs
+3 -6
View File
@@ -50,12 +50,9 @@ longRoom = do
longRoomRunPast :: RandomGen g => State g (LabTree Room)
longRoomRunPast = do
r <- longRoom
return (toOnward "longRoomRunPast"
, treeFromTrunk [ door]
(Node ( r)
[ pure door
rToOnward "longRoomRunPast"
$ treeFromTrunk [ door] $ Node r
[ pure $ useAll door
, treeFromPost [ corridor & rmConnectsTo .~ S.member InLink]
(useLabel 0 door)
]
)
)
src/Dodge/Room/RezBox.hs
+8 -14
View File
@@ -54,12 +54,10 @@ rezBoxesWp = do
let n = length $ getLinksOfType (OnEdge North) $ _rmLinks centralRoom
let rezrooms = map adddoor
$ wpAdd theweapon aroom : replicate (n-2) aroom
return $ treeFromTrunk [ rezBox thecol
, door
]
(Node ( centralRoom) (rezrooms ++ [onwardpassage]))
return $ treeFromTrunk [ rezBox thecol , door ]
$ Node centralRoom (rezrooms ++ [onwardpassage])
where
adddoor rm = treeFromPost [ connectsToNorth door ] ( rm)
adddoor rm = treeFromPost [ connectsToNorth door ] rm
connectsToNorth = rmConnectsTo .~ S.member (OnEdge North)
maybeBlockedPassage :: RandomGen g => State g (Tree Room)
maybeBlockedPassage = fmap (pure . useAll)
@@ -82,12 +80,10 @@ rezBoxesWpCrit = do
$ insertAt i (wpAdd theweapon aroom)
$ insertAt j (crAdd aroom)
$ replicate (n-3) aroom
return $ treeFromTrunk [ rezBox thecol
, door
]
(Node ( centralRoom) (rezrooms ++ [onwardpassage]))
return $ treeFromTrunk [rezBox thecol , door]
$ Node centralRoom (rezrooms ++ [onwardpassage])
where
adddoor rm = treeFromPost [ door & rmConnectsTo .~ S.member (OnEdge North)] ( rm)
adddoor rm = treeFromPost [ door & rmConnectsTo .~ S.member (OnEdge North)] rm
crAdd :: Room -> Room
crAdd = rmPmnts .:~ sPS (V2 20 10) (0.5*pi) randC1
@@ -103,10 +99,8 @@ rezBoxes = do
centralRoom <- shuffleLinks $ (roomRectAutoLinks w h) {_rmPmnts = []}
& rmLinks %~ setInLinks bottomEdgeTest
let n = length $ filter bottomEdgeTest $_rmLinks centralRoom
return $ treeFromTrunk [ rezBox thecol
, door
]
(Node ( centralRoom) (replicate (n-1) dbox ++ [Node (useAll door) []]))
return $ treeFromTrunk [rezBox thecol, door]
$ Node centralRoom (replicate (n-1) dbox ++ [Node (useAll door) []])
rezColor :: RandomGen g => State g LightSource
rezColor = do
src/Dodge/Room/Room.hs
+8 -8
View File
@@ -60,7 +60,7 @@ branchWith r ts = Node r $ return (useAll door) : ts
manyDoors :: Int -> Tree Room
manyDoors i = treeFromPost (replicate i ( door)) $ useAll door
manyDoors i = treeFromPost (replicate i door) $ useAll door
glassSwitchBack :: RandomGen g => State g Room
glassSwitchBack = do
@@ -282,9 +282,9 @@ weaponLongCorridor = do
]
i1 <- state $ randomR (2,5)
i2 <- state $ randomR (2,5)
let branch1 = treeFromTrunk (replicate i1 $ corridorN) (pure . useAll $ putCrs connectingRoom)
let branch2 = treeFromTrunk (replicate i2 $ corridorN) (pure . useSide $ putWp corridor)
return $ Node ( rt) [branch1,branch2]
let branch1 = treeFromTrunk (replicate i1 corridorN) (pure . useAll $ putCrs connectingRoom)
let branch2 = treeFromTrunk (replicate i2 corridorN) (pure . useSide $ putWp corridor)
return $ Node rt [branch1,branch2]
where
putCrs = over rmPmnts (++ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) 40) (-pi/2) randC1 ])
putWp = set rmPmnts [sPS (V2 20 60) 0 $ RandPS randFirstWeapon ,spanLightI (V2 0 40) (V2 40 40)]
@@ -307,11 +307,11 @@ deadEndRoom = defaultRoom
{- A random Either tree with a weapon and melee monster challenge. -}
weaponRoom :: RandomGen g => Int -> State g (LabTree Room)
weaponRoom i = join $ takeOne
[ weaponEmptyRoom <&> (f "weaponEmptyRoom")
[ weaponEmptyRoom <&> f "weaponEmptyRoom"
, weaponUnderCrits i
, weaponBehindPillar<&> (f "weaponBehindPillar")
, weaponBetweenPillars<&> (f "weaponBetweenPillars")
, weaponLongCorridor<&> (f "weaponLongCorridor")
, weaponBehindPillar <&> f "weaponBehindPillar"
, weaponBetweenPillars <&> f "weaponBetweenPillars"
, weaponLongCorridor <&> f "weaponLongCorridor"
]
where
f str = ( toOnward str ,)
src/Dodge/Room/RunPast.hs
+5 -5
View File
@@ -60,10 +60,10 @@ runPastRoom i = do
}
switchdoor = triggerDoorRoom i
n = length $ filter theedgetest $ map lnkPosDir $ _rmLinks cenroom
controom = treeFromPost [ switchdoor, linkcor] (useAll door)
controom = treeFromPost [ switchdoor, linkcor,corridor,corridor] (useAll door)
critrooms :: [Tree Room]
critrooms = treeFromPost [ switchdoor] ( critroom) :
replicate (n-2) (treeFromPost [ switchdoor] ( linkcor))
return $ Node ( cenroom) $
critrooms = treeFromPost [ switchdoor] critroom
: replicate (n-2) (treeFromPost [ switchdoor] linkcor)
return $ Node cenroom $
map (over root $ rmConnectsTo .~ S.member (OnEdge theedge)) (controom : critrooms)
++ [return $ aswitchroom]
++ [return aswitchroom]
src/Dodge/Room/Start.hs
+9 -12
View File
@@ -1,4 +1,4 @@
{-# LANGUAGE TupleSections #-}
--{-# LANGUAGE TupleSections #-}
module Dodge.Room.Start where
import Dodge.UseAll
import Dodge.Data
@@ -6,7 +6,7 @@ import Dodge.LevelGen.Data
--import Dodge.PlacementSpot
import Dodge.Room.RunPast
import Dodge.Room.Containing
import Dodge.Room.LongDoor
--import Dodge.Room.LongDoor
--import Dodge.RoomLink
--import Dodge.Data
--import Dodge.Default
@@ -49,20 +49,17 @@ powerFakeout = do
`treeFromPost` useAll door
startRoom :: RandomGen g => Int -> State g (LabTree Room)
startRoom i = join (takeOne $
startRoom i = join (takeOne
[-- (,) (0.5::Float) ((chainUses <$> sequence [powerFakeout,fmap fst $weaponRoom i])
-- <&> (,TreeSubLabelling "chainUses <$> sequence [powerFakeout,weaponRoom i]" Nothing))
-- wat
(rezBoxesWp <&> (toOnward "rezBoxesWp",))
, (rezBoxThenWeaponRoom i)
, (rezBoxesWpCrit <&> (toOnward "rezBoxesWpCrit",))
, (runPastStart i <&> (toOnward ("runPastStart " ++ show i),))
-- , ((startCrafts >>= roomsContaining' [] >>= rezBoxThenRooms) <&>
-- (toOnward "startCrafts >>= roomsContaining [] >>= rezBoxThenRooms",))
rezBoxesWp >>= rToOnward "rezBoxesWp"
, rezBoxThenWeaponRoom i
, rezBoxesWpCrit >>= rToOnward "rezBoxesWpCrit"
, runPastStart i >>= rToOnward ("runPastStart " ++ show i)
, startCrafts >>= roomsContaining' [] >>= rezBoxThenRooms
>>= rToOnward "startCrafts >>= roomsContaining [] >>= rezBoxThenRooms"
])
where
roomsContaining' a b = fst <$> roomsContaining a b
one = 1::Float
randomChallenges :: RandomGen g => State g (LabTree Room)
randomChallenges = shootingRange
-- join (takeOne