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-14 11:35:40 +01:00
parent 4a910566e6
commit 88e5f40f06
6 changed files with 30 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+1 -4
View File
@@ -1493,10 +1493,7 @@ data RoomLinkType
| InLink
| LabLink Int
| OnEdge CardinalPoint
| FromSouth Int
| FromNorth Int
| FromWest Int
| FromEast Int
| FromEdge CardinalPoint Int
| BlockedLink
deriving (Eq,Ord,Show)
data CardinalPoint
src/Dodge/Floor.hs
+2 -1
View File
@@ -41,10 +41,11 @@ initialAnoTree = OnwardList
$ intersperse (AnTree $ tToBTree "cori" . pure <$> shuffleLinks (cleatOnward corridor))
[ IntAnno $ AnTree . startRoom
-- , (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor])
, AnRoom $ roomCCrits 10
, AnRoom $ pistolerRoom
, AnRoom doubleCorridorBarrels
, IntAnno $ PassthroughLockKeyLists
[(sensorRoomRunPast ELECTRICAL, takeOne [STATICMODULE,SPARKGUN] )] itemRooms
, AnRoom $ roomCCrits 10
, IntAnno $ PassthroughLockKeyLists keyCardRunPastRand itemRooms
, IntAnno $ AnTree . warningRooms
, AnTree $ rToOnward "chaseCrit+armourChaseCrit rectRoom"
src/Dodge/Room/GlassLesson.hs
+1 -1
View File
@@ -30,7 +30,7 @@ glassLesson = do
, treeFromPost ( (door & rmConnectsTo .~ S.member (OnEdge East))
: corridors) $ cleatOnward door]
where
fromWest edge i s = S.member (OnEdge edge) s && S.member (FromWest i) s
fromWest edge i s = S.member (OnEdge edge) s && S.member ((FromEdge West) i) s
uppers = Node (door & rmConnectsTo .~ fromWest North 0) [pure topRoom]
botRoom = roomRect 200 200 1 1
& rmPmnts .~ botplmnts
src/Dodge/Room/Modify/Girder.hs
+14 -14
View File
@@ -34,8 +34,8 @@ addGirderNS shapef col room = do
girderPosOrder <- shuffle [1 .. nwestlnks - 2]
return $ room & rmPmnts .:~ foldr1 setFallback
(sps0 PutNothing : [ twoRoomPoss
(isUnusedLnkType (FromWest i))
(isUnusedLnkType (FromWest i))
(isUnusedLnkType (FromEdge West i))
(isUnusedLnkType (FromEdge West i))
$ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
| i <- girderPosOrder]
)
@@ -46,23 +46,23 @@ addGirderFromWest fromwesti shapef col room = do
girderPosOrder <- shuffle [0 .. nwestlnks - 1]
return $ room & rmPmnts .:~ foldr1 setFallback
(sps0 PutNothing : [ twoRoomPoss
(isUnusedLnkType (FromWest i))
(isUnusedLnkType (FromWest i))
(isUnusedLnkType (FromEdge West i))
(isUnusedLnkType (FromEdge West i))
$ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
| i <- [fromwesti]]
)
addGirderFrom :: RandomGen g => CardinalPoint -> Int
-> (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room
addGirderFrom cp fromwesti shapef col room = do
addGirderFrom cp fromi shapef col room = do
let nwestlnks = length $ filter ((OnEdge North `S.member`) . _rlType) $ _rmLinks room
girderPosOrder <- shuffle [0 .. nwestlnks - 1]
return $ room & rmPmnts .:~ foldr1 setFallback
(sps0 PutNothing : [ twoRoomPoss
(isUnusedLnkType (FromWest i))
(isUnusedLnkType (FromWest i))
(isUnusedLnkType (FromEdge cp i))
(isUnusedLnkType (FromEdge cp i))
$ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
| i <- [fromwesti]]
| i <- [fromi]]
)
-- | Allows girder to be on edge
addGirderNS' :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room
@@ -71,8 +71,8 @@ addGirderNS' shapef col room = do
girderPosOrder <- shuffle [0 .. nwestlnks - 1]
return $ room & rmPmnts .:~ foldr1 setFallback
(sps0 PutNothing : [ twoRoomPoss
(isUnusedLnkType (FromWest i))
(isUnusedLnkType (FromWest i))
(isUnusedLnkType (FromEdge West i))
(isUnusedLnkType (FromEdge West i))
$ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
| i <- girderPosOrder]
)
@@ -83,8 +83,8 @@ addGirderEW shapef col room = do
return $ room & rmPmnts .:~ foldr1 setFallback
(sps0 PutNothing :
[ twoRoomPoss
(isUnusedLnkType (FromSouth i))
(isUnusedLnkType (FromSouth i))
(isUnusedLnkType (FromEdge South i))
(isUnusedLnkType (FromEdge South i))
$ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2)
| i <- girderPosOrder]
)
@@ -94,8 +94,8 @@ addGirder :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> Stat
addGirder shapef col room = do
let nslnks = length $ filter ((OnEdge North `S.member`) . _rlType) $ _rmLinks room
ewlnks = length $ filter ((OnEdge East `S.member`) . _rlType) $ _rmLinks room
nsgirds = girdson FromEast nslnks
ewgirds = girdson FromNorth ewlnks
nsgirds = girdson (FromEdge East) nslnks
ewgirds = girdson (FromEdge North) ewlnks
girders <- shuffle $ nsgirds ++ ewgirds
return $ room & rmPmnts .:~ foldr1 setFallback
(sps0 PutNothing : girders)
src/Dodge/Room/Procedural.hs
+4 -4
View File
@@ -78,10 +78,10 @@ roomRect x y xn yn = defaultRoom
elnks = somelnks (V2 x 20) (gridPoints 0 1 yd (yn+1)) (-pi/2)
nlnks = somelnks (V2 20 y) (gridPoints xd (xn+1) 0 1 ) 0
slnks = somelnks (V2 20 0) (gridPoints xd (xn+1) 0 1 ) pi
lnks = m North FromWest FromEast nlnks
++ m East FromSouth FromNorth elnks
++ m West FromSouth FromNorth wlnks
++ m South FromWest FromEast slnks
lnks = m North (FromEdge West) (FromEdge East) nlnks
++ m East (FromEdge South) (FromEdge North) elnks
++ m West (FromEdge South) (FromEdge North) wlnks
++ m South (FromEdge West) (FromEdge East) slnks
m edge edgefrom1 edgefrom2 = zipWith (lnkBothAnd (OnEdge edge) edgefrom1 edgefrom2) [0..]
. zipCountDown
pth = linksAndPath' lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
src/Dodge/Room/Room.hs
+8 -12
View File
@@ -5,6 +5,7 @@ module Dodge.Room.Room
, roomMiniIntro
, roomCCrits
, doubleCorridorBarrels
, pistolerRoom
) where
import Dodge.UseAll
import Dodge.Data
@@ -46,7 +47,7 @@ roomC w h = do
maybeaddgird <- takeOne [return, addRandomGirderFromWest 0, addRandomGirderFrom North 0]
maybeaddgird =<< (shuffleLinks $ roomRectAutoLinks w h
& rmLinks %~
( (setInLinks (\rl -> S.fromList [FromEast 0,OnEdge South] `S.isSubsetOf` _rlType rl))
( (setInLinks (\rl -> S.fromList [(FromEdge East) 0,OnEdge South] `S.isSubsetOf` _rlType rl))
. (setOutLinks (\rl -> OnEdge West `S.member` _rlType rl))
)
& rmPmnts .++~ (wl : replicate ntanks thetank)
@@ -306,7 +307,7 @@ pillarGrid :: RandomGen g => State g Room
pillarGrid = do
let f2 x y = singleBlock (V2 x y)
f <- takeOne [f2]
h <- state $ randomR (400,800)
h <- state $ randomR (200,400)
let w = h
i <- takeOne [3,4,5]
let j = fromIntegral i
@@ -326,22 +327,17 @@ pillarGrid = do
-- cornerRestrict (V2 x y,_)
-- = (x > 40 && x < h - 40)
-- || (y > 40 && y < h - 40)
let plmnts = replicate 8 (mntLightLnkCond useUnusedLnk)
++
concat [f x y | x<-xs,y<-ys]
let plmnts = replicate 8 (mntLightLnkCond useUnusedLnk) ++ concat [f x y | x<-xs,y<-ys]
return $ roomRect w h (max i 2) (max i 2)
& rmPmnts .~ plmnts
& rmRandPSs .~ [rps]
-- TODO remove possible identical draws on random PSs
pistolerRoom :: RandomGen g => State g Room
pistolerRoom = pillarGrid
<&> rmPmnts %~ (
[spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit pistolCrit)
,spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit pistolCrit)
,spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit pistolCrit)
]
++)
pistolerRoom = pillarGrid <&> rmPmnts .++~
replicate 3
(spNoID (rprBool $ \rp _ -> _rpPlacementUse rp == 0 && RoomPosOnPath `S.member` _rpType rp)
(PutCrit pistolCrit))
shootingRange :: RandomGen g => State g (MetaTree Room String)
shootingRange = do