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