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
2025-09-23 17:34:39 +01:00
parent 6984a34c19
commit 398b3a1342
12 changed files with 26 additions and 45 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/RoomCluster.hs
+1 -1
View File
@@ -6,7 +6,7 @@ module Dodge.Data.RoomCluster where
import Control.Lens
import qualified Data.Set as S
data ClusterStatus = ClusterStatus
newtype ClusterStatus = ClusterStatus
{ _csLinks :: S.Set ClusterLink
}
src/Dodge/Floor.hs
+2 -2
View File
@@ -66,8 +66,8 @@ initialAnoTree =
PassthroughLockKeyLists keyCardRunPastRand itemRooms
, AnTree . intAnno $ warningRooms "INVISIBLE CREATURE AHEAD"
, AnTree $
rToOnward "chaseCrit+armourChaseCrit rectRoom" =<<
return . cleatOnward <$>
rToOnward "chaseCrit+armourChaseCrit rectRoom" .
return . cleatOnward =<<
(roomRectAutoLinks 400 400 <&> rmPmnts
.++~ [ psPtPl anyUnusedSpot (PutCrit invisibleChaseCrit)
, psPtPl anyUnusedSpot (PutCrit armourChaseCrit)
src/Dodge/Layout.hs
+2 -17
View File
@@ -86,22 +86,7 @@ doInPlacements w =
doRoomInPlacements :: GenWorld -> Room -> (GenWorld, Room)
doRoomInPlacements w rm = foldr f (w, rm) $ _rmInPmnt rm
where
f plf (w', r') = placeSpot (w', r') (plf (w'))
--doOutPlacements :: GenWorld -> GenWorld
--doOutPlacements w =
-- let ((pmnts, gw), rms) = mapAccumR doRoomOutPlacements (IM.empty, w) (_genRooms w)
-- in gw & genRooms .~ rms & genPmnt <>~ pmnts
--doRoomOutPlacements ::
-- (IM.IntMap [Placement], GenWorld) ->
-- Room ->
-- ((IM.IntMap [Placement], GenWorld), Room)
--doRoomOutPlacements imw r = foldr f (imw, r) $ IM.toList $ _rmOutPmnt r
-- where
-- f (i, pl) ((im, w), rm) =
-- let ((neww, newrm), plmnts) = placeSpot (w, rm) pl
-- in ((IM.insert i plmnts im, neww), newrm)
f plf (w', r') = placeSpot (w', r') (plf w')
doIndividualPlacements :: GenWorld -> GenWorld
doIndividualPlacements gw =
@@ -109,7 +94,7 @@ doIndividualPlacements gw =
in gw' & genRooms .~ rms
doRoomPlacements :: GenWorld -> Room -> (GenWorld, Room)
doRoomPlacements w rm = foldl' (\wr -> placeSpot wr) (w, rm & rmPmnts .~ mempty)
doRoomPlacements w rm = foldl' placeSpot (w, rm & rmPmnts .~ mempty)
$ _rmPmnts rm
setupWorldBounds :: World -> World
src/Dodge/Placement/Instance/Terminal.hs
+1 -1
View File
@@ -39,7 +39,7 @@ putTerminalFull f col mc tm =
defaultSensorWall
Nothing
)
$ \mcpl -> Just $ pt0 (PutWorldUpdate $ const $ over gwWorld $ (setids tmpl btpl mcpl)) (\_ -> f tmpl btpl mcpl)
$ \mcpl -> Just $ pt0 (PutWorldUpdate $ const $ over gwWorld (setids tmpl btpl mcpl)) (\_ -> f tmpl btpl mcpl)
where
setids tmpl btpl mcpl w =
w
src/Dodge/Placement/PlaceSpot.hs
+4 -6
View File
@@ -42,16 +42,14 @@ placePlainPSSpot
placePlainPSSpot w rm plmnt shift =
let (i, w') = placeSpotID rm (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w
newplmnt = plmnt & plMID ?~ i
((gw,rm')) = maybe ((w', rm & rmPmnts .:~ newplmnt))
(gw,rm') = maybe (w', rm & rmPmnts .:~ newplmnt)
(recrPlace newplmnt w') (_plIDCont plmnt w' newplmnt)
in ((f newplmnt gw,rm'))
in (f newplmnt gw,rm')
where
f x gw = fromMaybe gw $ do
j <- x ^. plExternalID
return $ gw & genPmnt . at j ?~ x
recrPlace newplmnt w' pl =
let (wr) = placeSpot (w', rm & rmPmnts .:~ newplmnt) pl
in (wr)
recrPlace newplmnt w' pl = placeSpot (w', rm & rmPmnts .:~ newplmnt) pl
-- this should be tidied up
placeSpotUsingLink ::
@@ -65,7 +63,7 @@ placeSpotUsingLink ::
placeSpotUsingLink w rm plmnt extract eff fallback = case searchedPoss (_rmPos rm) of
Just (ps, rmposs) -> placeSpot (w, eff (head rmposs) $ rm & rmPos .~ rmposs) (plmnt & plSpot .~ ps)
Nothing -> case fallback of
Nothing -> ((w, rm))
Nothing -> (w, rm)
Just plmnt' -> placeSpot (w, rm) plmnt'
where
searchedPoss [] = Nothing
src/Dodge/Room/LasTurret.hs
+4 -4
View File
@@ -62,7 +62,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] $
@@ -126,7 +126,7 @@ analyserByDoorWithPrompt = analyserByNthLinkWithPrompt 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
@@ -138,14 +138,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/Room.hs
+2 -4
View File
@@ -134,7 +134,6 @@ roomCenterPillar = do
set rmName "roomCenterPillar" $
roomRect 240 240 2 2
)
where
weaponEmptyRoom :: State StdGen (Tree Room)
weaponEmptyRoom = do
@@ -156,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
@@ -305,11 +304,10 @@ shootersRoom' = do
shootersRoom1 :: RandomGen g => State g Room
shootersRoom1 = do
pl <- ( takeOne $
pl <- takeOne $
map
(\i -> psPtPl (PSRoomRand i (uncurry PS)) (PutCrit autoCrit))
[0, 1, 2]
)
shootersRoom' <&> rmPmnts
.:~ pl
src/Dodge/Room/RunPast.hs
+1 -1
View File
@@ -52,7 +52,7 @@ lockedStart i = do
smallRoom
{ --_rmOutPmnt = IM.singleton i (putLitButOnPosExtTrig red useUnusedLnk)
_rmPmnts = [plRRpt 0 (PutFlIt theweapon)
,(putLitButOnPosExtTrig red useUnusedLnk) & plExternalID ?~ i]
,putLitButOnPosExtTrig red useUnusedLnk & plExternalID ?~ i]
, _rmBound = [rectNSWE 70 30 0 40]
}
]
src/Dodge/Room/Tutorial.hs
+6 -6
View File
@@ -48,11 +48,11 @@ tutAnoTree =
-- , AnTree $ tutDrop
[ AnTree $ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
, AnTree corDoor
, AnTree $ tutRooms
, AnTree tutRooms
, AnTree corDoor
, AnTree $ tToBTree "critroom" <$> weaponBehindPillar
, AnTree corDoor
, AnTree $ tutDrop
, AnTree tutDrop
, AnTree $ return $ tToBTree "cor" $ return $ cleatOnward corridor
---- , AnTree $ pickupTut
---- , AnTree $ weaponTut
@@ -95,12 +95,12 @@ tutRooms = do
i <- nextLayoutInt
j <- nextLayoutInt
x <-
shuffleLinks =<< analyserByDoorWithPrompt sensorTut (RequireEquipment (AMMOMAG DRUMMAG)) i
<$> addDoorAtNthLinkToggleTerminal 1 ss j
shuffleLinks . analyserByDoorWithPrompt sensorTut (RequireEquipment (AMMOMAG DRUMMAG)) i
=<< addDoorAtNthLinkToggleTerminal 1 ss j
<$> roomNgon 6 100
bcor <- blockedCorridor
r1 <- (r burstRifle) <&> rmPmnts .:~ t
r2 <- (r (drumMag & itConsumables ?~ 500))
r1 <- r burstRifle <&> rmPmnts .:~ t
r2 <- r (drumMag & itConsumables ?~ 500)
return $
tToBTree "DoorTest" $
Node
src/Dodge/Update.hs
+1 -1
View File
@@ -161,7 +161,7 @@ updateUniverseMid u = case _uvScreenLayers u of
. updateUseInputInGame
$ over
uvWorld
(updateMouseInGame (u ^. uvConfig) . (updateCamera (u ^. uvConfig)))
(updateMouseInGame (u ^. uvConfig) . updateCamera (u ^. uvConfig))
u
timeFlowUpdate :: Universe -> Universe
src/Dodge/WorldEffect.hs
+1 -1
View File
@@ -110,7 +110,7 @@ resetTerminal x tm =
leaveResetQuitTerminal :: String -> Terminal -> World -> World
leaveResetQuitTerminal s tm =
(cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines
.~ (tlSetStatus (TerminalPressTo s)) <> tlDoEffect (TmWdWdLeaveTerminal s))
.~ tlSetStatus (TerminalPressTo s) <> tlDoEffect (TmWdWdLeaveTerminal s))
. exitTerminalSubInv
exitTerminalSubInv :: World -> World