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

Start cleanup of room in-links

Browse Source
This commit is contained in:
justin
2022-03-05 01:09:19 +00:00
parent 8fa6bbfe29
commit 0c580e63a4
11 changed files with 67 additions and 90 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/ChaseCrit.hs
+1 -1
View File
@@ -44,7 +44,7 @@ chaseCrit = defaultCreature
, Left targetYouWhenCognizant
, Right (crMeleeCooldown %~ max 0 . subtract 1)
]
, _crHP = 300
, _crHP = 150
, _crPict = basicCrPict green
, _crInv = IM.fromList [(0,medkit 200)]
, _crMeleeCooldown = 0
src/Dodge/Floor.hs
+1
View File
@@ -34,6 +34,7 @@ import System.Random
initialAnoTree :: RandomGen g => Tree [Annotation g]
initialAnoTree = padSucWithCorridors $ treeFromTrunk
[[AnoApplyInt 0 startRoom]
, [SpecificRoom $ fmap (return . UseAll) doubleCorridorBarrels]
, [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms]
, [AnoApplyInt 1 lasSensorTurretTest]
-- ,[ChainAnos
src/Dodge/LevelGen/Data.hs
-1
View File
@@ -206,7 +206,6 @@ psj ps pst plmnt = Placement ps pst Nothing (const $ Just plmnt)
ps0jPushPS :: PSType -> Placement -> Placement
ps0jPushPS pst plmnt = Placement (PS (V2 0 0) 0) pst Nothing (\p -> Just $ plmnt & plSpot .~ _plSpot p)
--ps0jPushPS pst plmnt = Placement (PS (V2 0 0) 0) pst Nothing (\p -> Just $ plmnt)
addPlmnt :: Placement -> Placement -> Placement
addPlmnt pl pl2 = case pl2 of
src/Dodge/LockAndKey.hs
+7 -4
View File
@@ -11,13 +11,11 @@ import Dodge.Item.Craftable
import System.Random
import Control.Monad.State
-- (const $ return $ chainUses $ map singleUseAll [door,lasTunnel,door] , return FlatShield )
-- ,
lockRoomKeyItems :: RandomGen g => [ (Int -> State g (SubCompTree Room) , State g CombineType ) ]
lockRoomKeyItems =
[(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN] )
[(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] )
,(const slowDoorRoomRunPast, return MINIGUN)
-- ,(longRoom or something, [sniper])
]
itemRooms :: RandomGen g => [(CombineType, State g (SubCompTree Room))]
@@ -36,6 +34,11 @@ itemRooms =
[roomsContaining $ map makeTypeCraft [TRANSFORMER,CAN,CAN]
]
)
, (FLATSHIELD , join $ takeOne
[roomsContaining $ map makeTypeCraft [PLATE,PLATE]
,roomsContaining $ map makeTypeCraft [DRUM,DRUM,PLATE]
]
)
]
roomsContaining :: RandomGen g => [Item] -> State g (SubCompTree Room)
src/Dodge/Placement/Instance/LightSource.hs
-1
View File
@@ -28,7 +28,6 @@ mntLSOn shapeF mcol ls wallp lsp@(V3 lx ly _)
V2 x y = rotateV 1 . (0.1 *.*) . normalizeV $ wallp -.- V2 lx ly
setCol = maybe id colorSH mcol
iShape :: Point2 -> Point3 -> Shape
iShape wp (V3 x y z) = thinHighBar z wp (V2 x y)
src/Dodge/Placement/PlaceSpot.hs
+9 -9
View File
@@ -87,20 +87,20 @@ placeSpotRoomRand rm i f plmnt w =
-- the Int here is some id that is assigned when the placement is placed
placeSpotID :: PlacementSpot -> PSType -> GenWorld -> (Int, GenWorld)
placeSpotID ps pt w = case pt of
PutTrigger cnd -> placeNewInto triggers cnd w
PutTrigger cnd -> plNewID triggers cnd w
PutMod mdi -> plNewUpID modifications mdID mdi w
PutProp prp -> plNewUpID props pjID (mvProp p rot prp) w
PutButton bt -> plNewUpID buttons btID (mvButton p rot bt) w
PutFlIt itm -> plNewUpID floorItems flItID (createFlIt p rot itm) w
PutCrit cr -> plNewUpID creatures crID (mvCr p rot cr) w
PutMachine col pps mc -> placeMachine col (map doShift pps) mc p rot w
PutMachine col pps mc -> plMachine col (map doShift pps) mc p rot w
PutLS ls -> plNewUpID lightSources lsID (mvLS p' rot ls) w
PutPPlate pp -> plNewUpID pressPlates ppID (mvPP p rot pp) w
RandPS rgn -> evaluateRandPS rgn ps w
PutDoor col f pss -> placeDoor col f (map (bimap doShift doShift) pss) w
PutCoord cp -> placeNewInto coordinates (doShift cp) w
PutDoor col f pss -> plDoor col f (map (bimap doShift doShift) pss) w
PutCoord cp -> plNewID coordinates (doShift cp) w
PutSlideDr pth col f a b spd
-> placeSlideDoor pth col f (doShift a) (doShift b) spd w
-> plSlideDoor pth col f (doShift a) (doShift b) spd w
PutBlock bm hp hps wl ps'
-> placeBlock (map doShift ps') hp wl hps bm w
PutLineBlock wl bm wdth dpth a b -> placeLineBlock wl bm wdth dpth (doShift a) (doShift b) w
@@ -142,11 +142,11 @@ addPane wl l wls = IM.insert wlid (wl { _wlLine = l, _wlID = wlid }) wls
-- | generalised way of putting a new item into a lensed intmap, returning the
-- new index as well
placeNewInto :: ALens' World (IM.IntMap a)
plNewID :: ALens' World (IM.IntMap a)
-> a
-> GenWorld
-> (Int,GenWorld)
placeNewInto l x w = (i,w & gWorld . l #%~ IM.insert i x)
plNewID l x w = (i,w & gWorld . l #%~ IM.insert i x)
where
i = IM.newKey $ _gWorld w ^# l
@@ -176,8 +176,8 @@ mvPP p rot pp = pp {_ppPos = p,_ppRot = rot}
mvCr :: Point2 -> Float -> Creature -> Creature
mvCr p rot cr = cr {_crPos = p,_crOldPos = p,_crDir = rot}
placeMachine :: Color -> [Point2] -> Machine -> Point2 -> Float -> GenWorld -> (Int,GenWorld)
placeMachine color wallpoly mc p rot gw = (mcid
plMachine :: Color -> [Point2] -> Machine -> Point2 -> Float -> GenWorld -> (Int,GenWorld)
plMachine color wallpoly mc p rot gw = (mcid
, gw & gWorld . machines %~ addMc
& gWorld . walls %~ placeMachineWalls color wallpoly mcid wlid
)
src/Dodge/Placement/PlaceSpot/TriggerDoor.hs
+21 -28
View File
@@ -1,7 +1,7 @@
--{-# LANGUAGE BangPatterns #-}
module Dodge.Placement.PlaceSpot.TriggerDoor
( placeDoor
, placeSlideDoor
( plDoor
, plSlideDoor
) where
import Dodge.Data
import Dodge.Default.Wall
@@ -17,14 +17,13 @@ import Data.List
import Control.Lens
--import Data.Graph.Inductive hiding ((&))
import qualified Data.IntSet as IS
placeDoor
:: Color
plDoor :: Color
-> (World -> Bool) -- ^ Opening condition
-> [(Point2,Point2)] -- ^ Door positions, closed to open.
-- Bumped out up and down by 9, not widened
-> GenWorld
-> (Int,GenWorld)
placeDoor col cond pss gw = (drid, gw & gWorld .~ (addWalls w & doors %~ addDoor))
plDoor col cond pss gw = (drid, gw & gWorld .~ (addWalls w & doors %~ addDoor))
where
w = _gWorld gw
drid = IM.newKey $ _doors w
@@ -38,27 +37,29 @@ placeDoor col cond pss gw = (drid, gw & gWorld .~ (addWalls w & doors %~ addDoo
nsteps = length pss - 1
wlids = take 4 [IM.newKey $ _walls w ..]
wlps' = uncurry (rectanglePairs 9) $ head pss
addWalls w' = foldl' addWall w' $ zip wlids wlps'
addWall w' (wlid, wlps) = w' & walls %~ IM.insert wlid defaultWall
{ _wlLine = wlps
, _wlID = wlid
, _wlColor = col
, _wlSeen = False
, _wlOpacity = Opaque
, _wlPathable = False
}
addWalls w' = foldl' (addDoorWall col False) w' $ zip wlids wlps'
addDoorWall :: Color -> Bool -> World -> (Int,(Point2,Point2)) -> World
addDoorWall col pathableStatus w (wlid,wlps) = w & walls %~ IM.insert wlid defaultWall
{ _wlLine = wlps
, _wlID = wlid
, _wlColor = col
, _wlSeen = False
, _wlOpacity = Opaque
, _wlPathable = pathableStatus
}
-- TODO use vector instead of list, perhaps also memoisation of rectanglePairs
-- perhaps also remove use of DoorInt in favour of DoorOpen/DoorClosed
doorMechanismStepwise :: Int -> Int -> [Int] -> [(Point2,Point2)] -> Door -> World -> World
doorMechanismStepwise nsteps drid wlids pss dr w
| toOpen = case _drStatus dr of
DoorInt x | x == nsteps -> w
DoorInt x -> setWalls (x+1)
_ -> w
DoorInt x -> setWalls (x+1)
_ -> w
| otherwise = case _drStatus dr of
DoorInt 0 -> w
DoorInt x -> setWalls (x-1)
_ -> w
_ -> w
where
playSound = soundContinue (WallSound drid) (fst $ head pss) slideDoorS (Just 1)
toOpen = _drTrigger dr w
@@ -88,9 +89,9 @@ doorMechanism drid speed wlidOpCps dr w
doClose w' (wlid,_ ,clp) = moveWallIDToward wlid speed clp w'
-- TODO cut pathing if not pathable, reset when opened
placeSlideDoor :: Bool -> Color -> (World -> Bool) -> Point2 -> Point2 -> Float -> GenWorld
plSlideDoor :: Bool -> Color -> (World -> Bool) -> Point2 -> Point2 -> Float -> GenWorld
-> (Int, GenWorld)
placeSlideDoor isPathable col cond a b speed gw = (drid, gw & gWorld .~ (addWalls w & doors %~ addDoor))
plSlideDoor isPathable col cond a b speed gw = (drid, gw & gWorld .~ (addWalls w & doors %~ addDoor))
where
w = _gWorld gw
drid = IM.newKey $ _doors w
@@ -101,15 +102,7 @@ placeSlideDoor isPathable col cond a b speed gw = (drid, gw & gWorld .~ (addWall
, _drTrigger = cond
, _drMech = doorMechanism drid speed (zip3 wlids shiftedPairs pairs)
}
addWalls w' = foldl' addWall w' $ zip wlids pairs
addWall w' (wlid, wlps) = w' & walls %~ IM.insert wlid defaultWall
{ _wlLine = wlps
, _wlID = wlid
, _wlColor = col
, _wlSeen = False
, _wlOpacity = Opaque
, _wlPathable = isPathable
}
addWalls w' = foldl' (addDoorWall col isPathable) w' $ zip wlids pairs
pairs = rectanglePairs 9 a b
shiftedPairs = map (bimap shiftLeft shiftLeft) pairs
shiftLeft = (+.+ (a -.- b +.+ normalizeV (b -.- a)))
src/Dodge/Room/Procedural.hs
+9 -11
View File
@@ -90,8 +90,7 @@ combineRooms r r' = defaultRoom
, _rmLinks = _rmLinks r ++ _rmLinks r'
, _rmPath = map clampPath $ _rmPath r
++ _rmPath r'
, _rmPmnts = (_rmPmnts r)
++ (_rmPmnts r')
, _rmPmnts = _rmPmnts r ++ _rmPmnts r'
--, _rmPmnts = map (shiftPlacement $ _rmShift r) (_rmPmnts r)
-- ++ map (shiftPlacement $ _rmShift r') (_rmPmnts r')
, _rmBound = _rmBound r ++ _rmBound r'
@@ -142,22 +141,21 @@ quarterRoomTri w = do
}
quarterRoomSquare :: RandomGen g => Float -> State g Room
quarterRoomSquare w = do
let commonPlacements =
[ blockLine (V2 (w/2) (w/2)) (V2 0 w)
, sPS (V2 20 (2*w-40)) pi PutNothing
, sPS (V2 25 (2*w-45)) pi PutNothing
]
b <- takeOne
[ [ mntLS vShape (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
, blockLine (V2 (negate $ w/2) (w/2)) (V2 0 w)
, sPS (V2 20 (2*w-40)) pi PutNothing
]
] ++ commonPlacements
, [ mntLS vShape (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
, blockLine (V2 (negate w) w ) (V2 0 w)
, sPS (V2 20 (2*w-40)) pi PutNothing
]
] ++ commonPlacements
, [ mntLS iShape (V2 (0.7*w) (1.3*w)) (V3 (0.7*w-20) (1.3*w-20) 70)
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
, blockLine (V2 0 w) (V2 0 (w*2))
, sPS (V2 20 (2*w-40)) pi PutNothing
]
] ++ commonPlacements
]
pure $ defaultRoom
{ _rmPolys = [ map toV2 [(0,0),(w,w),(0,2*w),(-w,w)] ]
src/Dodge/Room/RezBox.hs
+6 -23
View File
@@ -70,45 +70,28 @@ rezBoxesWpCrit = do
h <- state $ randomR (40,40)
thecol <- rezColor
theweapon <- randBlockBreakWeapon
--horedge <- takeOne [OnEdge North,OnEdge South]
let centralRoom = (roomRectAutoLinks w h) {_rmPmnts = []}
onwardpassage <-
applyToCompRoot (rmConnectsTo .~ S.singleton (OnEdge West)) <$> maybeBlockedPassage
let bottomEdgeTest (V2 _ y,_) = y < 1
aroom = rezInvBox thecol
let centralRoom = (roomRectAutoLinks w h) {_rmPmnts = []}
onwardpassage <-
applyToCompRoot (rmConnectsTo .~ S.singleton (OnEdge West)) <$> maybeBlockedPassage
let n = length $ filter bottomEdgeTest $ map lnkPosDir $ _rmLinks centralRoom
i <- state $ randomR (0,n-3)
j <- state $ randomR (i,n-2)
let rezrooms = map adddoor
let rezrooms = map adddoor
$ insertAt i (wpAdd theweapon aroom)
$ insertAt j (crAdd aroom)
$ replicate (n-3) aroom
return $ treeFromTrunk [PassDown $ rezBox thecol
, PassDown door
]
]
(Node (PassDown centralRoom) (rezrooms ++ [onwardpassage]))
where
adddoor rm = treeFromPost [PassDown door] (PassDown rm)
adddoor rm = treeFromPost [PassDown $ door & rmConnectsTo .~ S.singleton (OnEdge North)] (PassDown rm)
crAdd :: Room -> Room
crAdd = rmPmnts %~ (sPS (V2 20 10) (0.5*pi) randC1 :)
corridorLRbranches :: RandomGen g => State g (SubCompTree Room)
corridorLRbranches = do
w <- state $ randomR (100,400)
h <- state $ randomR (40,40)
thecol <- rezColor
let bottomEdgeTest (V2 _ y,_) = y < 1
dbox = treeFromPost [PassDown door] (PassDown $ rezInvBox thecol)
centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest
((roomRectAutoLinks w h) {_rmPmnts = []})
let n = length $ filter bottomEdgeTest $ map lnkPosDir $_rmLinks centralRoom
centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
return $ treeFromTrunk [PassDown $ rezBox thecol
, PassDown door
]
(Node (PassDown centralRoom') (replicate (n-1) dbox ++ [Node (UseAll door) []]))
rezBoxes :: RandomGen g => State g (SubCompTree Room)
rezBoxes = do
w <- state $ randomR (100,400)
src/Dodge/Room/Room.hs
+5 -6
View File
@@ -142,9 +142,8 @@ glassSwitchBackCrits = glassSwitchBack
] ++)
miniTree2 :: RandomGen g => State g (SubCompTree Room)
miniTree2 = glassSwitchBackCrits
>>= randomiseOutLinks
>>= changeLinkTo (\p -> (sndV2 . fst) p < 70)
miniTree2 = restrictInLinks (\p -> (sndV2 . fst) p < 70) <$> glassSwitchBackCrits
>>= randomiseAllLinks
<&> flip branchWith (replicate 3 $ treeFromPost [door,corridor] critInDeadEnd)
miniRoom3 :: RandomGen g => State g (SubCompTree Room)
@@ -189,7 +188,7 @@ roomMiniIntro = do
return $ chainUses [return $ UseAll door, midroom,return $ UseAll corridor]
roomCenterPillar :: RandomGen g => State g Room
roomCenterPillar = changeLinkTo ((\p -> dist p (V2 120 0) < 10) . fst)
roomCenterPillar = randomiseAllLinks . restrictInLinks ((\p -> dist p (V2 120 0) < 10) . fst)
$ set rmPmnts plmnts $ roomRect 240 240 2 2
where
plmnts =
@@ -385,7 +384,7 @@ longRoom = do
brls <- fmap (map (\p -> sPS (p +.+ V2 10 200) 0 $ PutCrit explosiveBarrel) )
$ replicateM 5 $ randInRect (w-20) 900
let rm = roomRect w (h+70) 1 1 & rmPolys %~ ([rectNSWE h (h-165) (-45) (w+45)] ++)
changeLinkTo cond $ rm & rmPmnts .~ ws ++ brls ++ wsDefense ++
return $ restrictInLinks cond $ rm & rmPmnts .~ ws ++ brls ++ wsDefense ++
[sPS (V2 12.5 (h-25)) 0 $ PutCrit longCrit
,sPS (V2 37.5 (h-25)) 0 $ PutCrit longCrit
,sPS (V2 62.5 (h-25)) 0 $ PutCrit longCrit
@@ -397,7 +396,7 @@ doubleCorridorBarrels :: RandomGen g => State g Room
doubleCorridorBarrels = do
h <- state $ randomR (200,300)
let cond x = (sndV2 . fst) x < h - 40
changeLinkTo cond $ roomRect 100 h 1 1 & rmPmnts .~
return $ restrictInLinks cond $ roomRect 100 h 1 1 & rmPmnts .~
[blockLine (V2 50 50) (V2 50 h)
,sPS (V2 25 (h-25)) 0 $ PutCrit $ addArmour autoCrit
,sPS (V2 75 (h-30)) 0 $ PutCrit explosiveBarrel
src/Dodge/Room/Start.hs
+8 -6
View File
@@ -65,14 +65,16 @@ room2 :: RandomGen g => Int -> State g (SubCompTree Room)
room2 = lasCenSensEdge
startRoom :: RandomGen g => Int -> State g (SubCompTree Room)
startRoom _ = join $ uncurry takeOneWeighted $ unzip
startRoom i = join $ uncurry takeOneWeighted $ unzip
-- [ (,) (0.5::Float) $ chainUses <$> sequence [minigunFakeout,weaponRoom]
[ (,) (1::Float) rezBoxesWp
-- , (,) 1 rezBoxesThenWeaponRoom
-- , (,) 1 rezBoxThenWeaponRoom
-- , (,) 1 rezBoxesWpCrit
-- , (,) 1 $ runPastStart i
[ (,) one rezBoxesWp
, (,) 1 rezBoxesThenWeaponRoom
, (,) 1 rezBoxThenWeaponRoom
, (,) one rezBoxesWpCrit
, (,) 1 $ runPastStart i
]
where
one = (1::Float)
runPastStart :: RandomGen g => Int -> State g (SubCompTree Room)
runPastStart i = do