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