diff --git a/src/Dodge/Annotation.hs b/src/Dodge/Annotation.hs index 1e0715eb4..267b6e0ed 100644 --- a/src/Dodge/Annotation.hs +++ b/src/Dodge/Annotation.hs @@ -7,7 +7,7 @@ module Dodge.Annotation import Dodge.UseAll import RandomHelp import Dodge.Tree ---import Dodge.Data +import Dodge.Data import Dodge.Annotation.Data import LensHelp @@ -16,7 +16,8 @@ import Data.Maybe annoToRoomTree :: Annotation -> State (StdGen,Int) MTRS annoToRoomTree an = case an of - SpecificRoom r -> zoom _1 r + AnTree t -> zoom _1 t + AnRoom r -> MTree "SingleRoom" . NodeTree . pure . (rmClusterStatus . csLinks . at OnwardCluster ?~ ()) <$> zoom _1 r <*> return [] OnwardList ans -> do mts <- mapM annoToRoomTree ans return $ foldr1 attachOnward mts diff --git a/src/Dodge/Annotation/Data.hs b/src/Dodge/Annotation/Data.hs index 4b5477a56..53b2a71c4 100644 --- a/src/Dodge/Annotation/Data.hs +++ b/src/Dodge/Annotation/Data.hs @@ -16,7 +16,8 @@ data Annotation = ModifyTree (MetaTree Room String -> MetaTree Room String) Annotation | OnwardList [Annotation] | IntAnno (Int -> Annotation) - | SpecificRoom (State StdGen (MetaTree Room String)) + | AnRoom (State StdGen Room) + | AnTree (State StdGen (MetaTree Room String)) | PassthroughLockKeyLists [(Int -> State StdGen (MetaTree Room String), State StdGen ItemBaseType)] [(ItemBaseType, State StdGen (MetaTree Room String))] diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 32a0cb3ad..102a7c907 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -38,65 +38,67 @@ import Data.List (intersperse) initialAnoTree :: Annotation initialAnoTree = OnwardList - $ intersperse (SpecificRoom $ tToBTree "cori" . pure <$> shuffleLinks (cleatOnward corridor)) - [ IntAnno $ SpecificRoom . startRoom + $ intersperse (AnTree $ tToBTree "cori" . pure <$> shuffleLinks (cleatOnward corridor)) + [ IntAnno $ AnTree . startRoom -- , (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor]) + , AnRoom $ roomCCrits 10 + , AnRoom doubleCorridorBarrels , IntAnno $ PassthroughLockKeyLists [(sensorRoomRunPast ELECTRICAL, takeOne [STATICMODULE,SPARKGUN] )] itemRooms , IntAnno $ PassthroughLockKeyLists keyCardRunPastRand itemRooms - , IntAnno $ SpecificRoom . warningRooms - , SpecificRoom $ rToOnward "chaseCrit+armourChaseCrit rectRoom" + , IntAnno $ AnTree . warningRooms + , AnTree $ rToOnward "chaseCrit+armourChaseCrit rectRoom" $ return . cleatOnward $ roomRectAutoLinks 400 400 & rmPmnts .++~ [ spNoID anyUnusedSpot (PutCrit invisibleChaseCrit) , spNoID anyUnusedSpot (PutCrit armourChaseCrit) ] - , IntAnno $ SpecificRoom . fmap (tToBTree "healthTest") . healthTest - , SpecificRoom (tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward) + , IntAnno $ AnTree . fmap (tToBTree "healthTest") . healthTest + , AnTree (tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward) , IntAnno $ PassthroughLockKeyLists lockRoomKeyItems itemRooms - , SpecificRoom randomChallenges - , IntAnno $ SpecificRoom . lasSensorTurretTest --- ,[SpecificRoom $ fmap pure roomCCrits] + , AnTree randomChallenges + , IntAnno $ AnTree . lasSensorTurretTest +-- ,[AnTree $ fmap pure roomCCrits] -- ,[AirlockAno] -- ,[Corridor] ------- ,[SpecificRoom roomCCrits] +------ ,[AnTree roomCCrits] ------ ,[Corridor] ------- ,[SpecificRoom . pure . pure . useAll $ roomGlassOctogon 400 +------ ,[AnTree . pure . pure . useAll $ roomGlassOctogon 400 ------ & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit armourChaseCrit ------ ,sPS (V2 50 25) 0 $ PutCrit armourChaseCrit ------ ,sPS (V2 50 0) 0 $ PutCrit armourChaseCrit ------ ]++) ------ ] ------- --,[SpecificRoom . pure . pure . useAll $ roomGlassOctogon 400 +------ --,[AnTree . pure . pure . useAll $ roomGlassOctogon 400 ------ -- & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,202] ]++) ------ -- ] ------- ,[SpecificRoom . pure . pure . useAll $ roomGlassOctogon 400 +------ ,[AnTree . pure . pure . useAll $ roomGlassOctogon 400 ------ & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit pistolCrit ]++) ------ ] ------ ,[Corridor] ----- --,[SpecificRoom $ pure . useAll <$> twinSlowDoorChasers] ------ ,[SpecificRoom $ pure $ (pure . useAll) (twinSlowDoorRoom 80 200 40)] +---- --,[AnTree $ pure . useAll <$> twinSlowDoorChasers] +----- ,[AnTree $ pure $ (pure . useAll) (twinSlowDoorRoom 80 200 40)] ----- ,[DoorAno] ------ ,[SpecificRoom $ pure . useAll <$> centerVaultExplosiveExit] ------ ,[SpecificRoom blockedCorridor] +----- ,[AnTree $ pure . useAll <$> centerVaultExplosiveExit] +----- ,[AnTree blockedCorridor] ----- ,[OrAno [[DoorAno] ----- ,[Corridor] ----- ,[DoorNumAno 0,AirlockAno]] ----- ] ----- ,[FirstWeapon] ----- ,[CorridorDebug] ------ ,[SpecificRoom $ fmap (pure . useAll) randomFourCornerRoom] +----- ,[AnTree $ fmap (pure . useAll) randomFourCornerRoom] -- ,[OrAno --- [[SpecificRoom $ branchRectWith $ fmap (fmap ) armouredChasers] +-- [[AnTree $ branchRectWith $ fmap (fmap ) armouredChasers] -- ,[BossAno $ addArmour launcherCrit & crHP +~ 800 -- & crState . crDropsOnDeath .~ DropSpecific [0] ] -- ] -- ] ----- ,[SpecificRoom $ fmap (pure . useAll) armouredCorridor] +---- ,[AnTree $ fmap (pure . useAll) armouredCorridor] -- ,[Corridor] -- ,[TreasureAno [addArmour autoCrit,addArmour autoCrit] [launcher]] -- ,[Corridor] - ,SpecificRoom $ randomFourCornerRoom [] >>= rToOnward "randomFourCornerRoom" . pure . cleatOnward - ,SpecificRoom $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward + ,AnTree $ randomFourCornerRoom [] >>= rToOnward "randomFourCornerRoom" . pure . cleatOnward + ,AnTree $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward ] {- | A test level tree. -} diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index b71a714aa..bcb45932c 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -53,7 +53,6 @@ layoutLevelFromSeed i seed = do putStrLnAppend "log/attemptedSeeds" $ "After " ++ show i' ++ " attempt(s), Successful generation of level with seed " ++ show seed - --return (fmap setLastLinkToUsed rs) putStrLnAppend "log/attemptedSeeds" $ show (Prelude.length rs) ++ " rooms in total" return (IM.fromList $ map reversePair rs , bounds) Nothing -> do diff --git a/src/Dodge/PlacementSpot.hs b/src/Dodge/PlacementSpot.hs index b2830a7a2..00af90099 100644 --- a/src/Dodge/PlacementSpot.hs +++ b/src/Dodge/PlacementSpot.hs @@ -105,8 +105,8 @@ setFallback fallback ) unusedOffPathAwayFromLink :: Float -> PlacementSpot -unusedOffPathAwayFromLink x = rprBool $ \rp r -> _rpLinkStatus rp == NotLink - && _rpPlacementUse rp == 0 +--unusedOffPathAwayFromLink x = rprBool $ \rp r -> _rpLinkStatus rp == NotLink +unusedOffPathAwayFromLink x = rprBool $ \rp r -> _rpPlacementUse rp == 0 && all ( (>x) . dist (_rpPos rp) ) (usedRoomLinkPoss r) && RoomPosOffPath `S.member` _rpType rp diff --git a/src/Dodge/Room/Girder.hs b/src/Dodge/Room/Girder.hs index 0fa0de931..e7af96315 100644 --- a/src/Dodge/Room/Girder.hs +++ b/src/Dodge/Room/Girder.hs @@ -1,2 +1,28 @@ module Dodge.Room.Girder where +import Dodge.Data +import RandomHelp +import Dodge.Room.Foreground +import Dodge.Room.Modify.Girder +import Color +addRandomGirderEW :: RandomGen g => Room -> State g Room +addRandomGirderEW rm = do + hgshape <- takeOne [girder 96 20 10, girderZ 96 20 10, girderV 96 20 10] + lgshape <- takeOne [girder 60 20 10, girderZ 60 20 10, girderV 60 20 10] + addgird <- takeOne $ + [ addGirderNS' hgshape black + , addGirderNS' lgshape red + ] + addgird rm + +addRandomGirderFromWest :: RandomGen g => Int -> Room -> State g Room +addRandomGirderFromWest i rm = do + (h,col) <- takeOne [(96,black),(60,red)] + gtype <- takeOne [girder,girderZ,girderV] + addGirderFromWest i (gtype h 20 10) col rm + +addRandomGirderFrom :: RandomGen g => CardinalPoint -> Int -> Room -> State g Room +addRandomGirderFrom cp i rm = do + (h,col) <- takeOne [(96,black),(60,red)] + gtype <- takeOne [girder,girderZ,girderV] + addGirderFrom cp i (gtype h 20 10) col rm diff --git a/src/Dodge/Room/Modify/Girder.hs b/src/Dodge/Room/Modify/Girder.hs index b3f097ffb..e8df46455 100644 --- a/src/Dodge/Room/Modify/Girder.hs +++ b/src/Dodge/Room/Modify/Girder.hs @@ -1,8 +1,11 @@ module Dodge.Room.Modify.Girder ( addGirderLights + , addGirderFrom , addHighGirder , addGirderEW , addGirderNS + , addGirderNS' + , addGirderFromWest ) where --import Dodge.Data import Dodge.LevelGen.Data @@ -36,6 +39,43 @@ addGirderNS shapef col room = do $ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) | i <- girderPosOrder] ) +-- this can be cleaned up +addGirderFromWest :: RandomGen g => Int -> (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room +addGirderFromWest fromwesti 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)) + $ \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 + 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)) + $ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) + | i <- [fromwesti]] + ) +-- | Allows girder to be on edge +addGirderNS' :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room +addGirderNS' 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)) + $ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) + | i <- girderPosOrder] + ) addGirderEW :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room addGirderEW shapef col room = do let nwestlnks = length $ filter ((OnEdge West `S.member`) . _rlType) $ _rmLinks room diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index f1e6650ce..c055fdf7f 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -74,8 +74,8 @@ roomRect x y xn yn = defaultRoom yd = (y - 40) / fromIntegral yn xd = (x - 40) / fromIntegral xn somelnks poffset ps a = zip (map (+.+ poffset) ps) (repeat a) - elnks = somelnks (V2 0 20) (gridPoints 0 1 yd (yn+1)) ( pi/2) - wlnks = somelnks (V2 x 20) (gridPoints 0 1 yd (yn+1)) (-pi/2) + wlnks = somelnks (V2 0 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 slnks = somelnks (V2 20 0) (gridPoints xd (xn+1) 0 1 ) pi lnks = m North FromWest FromEast nlnks diff --git a/src/Dodge/Room/Room.hs b/src/Dodge/Room/Room.hs index 54f689aa2..e3782d8ea 100644 --- a/src/Dodge/Room/Room.hs +++ b/src/Dodge/Room/Room.hs @@ -1,6 +1,11 @@ --{-# LANGUAGE TupleSections #-} -module Dodge.Room.Room where -import Data.Tile +module Dodge.Room.Room + ( shootingRange + , weaponRoom + , roomMiniIntro + , roomCCrits + , doubleCorridorBarrels + ) where import Dodge.UseAll import Dodge.Data import Dodge.PlacementSpot @@ -9,6 +14,7 @@ import Dodge.Default.Room import Dodge.Item.Weapon.BulletGuns import Dodge.Creature import Dodge.Room.Pillar +import Dodge.Room.Girder import Dodge.Room.Modify.Girder import Dodge.LevelGen.Data import RandomHelp @@ -18,18 +24,16 @@ import Dodge.Placement.Instance --import Dodge.LevelGen.Data import Dodge.Room.Procedural import Dodge.Room.Corridor +import Dodge.Room.Tanks import Dodge.Room.Link import Dodge.Room.Door import Dodge.Room.Airlock import Geometry -import Tile import MonadHelp import LensHelp --import Color import qualified Data.Set as S ---import Control.Monad.Loops -import Data.Bifunctor roomC :: RandomGen g => Float -> Float -> State g Room roomC w h = do @@ -37,12 +41,18 @@ roomC w h = do [ sPS (V2 0 0) 0 $ PutWall (rectNSWE (h-60) 0 (w/2-10) (w/2+10)) defaultCrystalWall , windowLine (V2 (w/2) 0) (V2 (w/2) (h-60)) ] - shuffleLinks $ roomRectAutoLinks w h - & restrictOutLinks fromCond - & rmPmnts .:~ wl + ntanks <- takeOne [0,0,0,0,0,1,1,1,1,2,3,4] + thetank <- randomTank <&> plSpot .~ unusedOffPathAwayFromLink 50 + 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)) + . (setOutLinks (\rl -> OnEdge West `S.member` _rlType rl)) + ) + & rmPmnts .++~ (wl : replicate ntanks thetank) & rmRandPSs .~ [farside] + ) where - fromCond (V2 x _,_) = x < w / 2 - 10 farside = do x <- state $ randomR (5, w/2 - 20) y <- state $ randomR (5, h - 70) @@ -59,10 +69,6 @@ roomPadCut ps p = defaultRoom branchWith :: Room -> [Tree Room] -> Tree Room branchWith r ts = Node r $ return (cleatOnward door) : ts - -manyDoors :: Int -> Tree Room -manyDoors i = treeFromPost (replicate i door) $ cleatOnward door - glassSwitchBack :: RandomGen g => State g Room glassSwitchBack = do wth <- state $ randomR (200,400) @@ -103,23 +109,6 @@ miniTree2 = do rm <- glassSwitchBackCrits >>= shuffleLinks . restrictInLinks (\p -> (sndV2 . fst) p < 70) return $ branchWith rm (replicate 3 $ treePost [door,corridor,critInDeadEnd]) -miniRoom3 :: RandomGen g => State g (Tree Room) -miniRoom3 = do - w <- state $ randomR (300,400) - h <- state $ randomR (300,400) - let cp = V2 0 (h/2+40) - let b = PutBlock StoneBlock 5 [20,20] baseBlockPane $ rectNSEW 10 (-10) (-60) (-80) - -- baseBlockPlane might need a reverse... - let plmnts = concatMap - (\i -> [ sPS cp (fromIntegral i*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80)) - , sPS cp (pi/8+fromIntegral i*pi/4) b] - ) [0..7::Int] - ++ [ sPS cp 0 $ PutCrit miniGunCrit , sPS (V2 (w/2) (h/2)) 0 putLamp ] - pure <$> shuffleLinks (cleatOnward $ set rmPmnts plmnts $ roomRectAutoLinks w h) - -rot90Around :: Point2 -> Point2 -> Point2 -rot90Around cen p = cen +.+ vNormal (p -.- cen) - -- So, the idea is to attach outer children to the bottommost right nodes -- inside an inner tree -- no idea what was going on here... @@ -142,31 +131,6 @@ roomCenterPillar = shuffleLinks . restrictInLinks ((\p -> dist p (V2 120 0) < 10 , mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isInLnk rp) ] -roomOctogon :: Room -roomOctogon = defaultRoom - { _rmPolys = [poly ] - , _rmLinks = muout (init lnks) ++ muin [last lnks] - , _rmPath = allPairs $ map fst lnks -- this is too much - , _rmPmnts = [] - , _rmBound = [map toV2 [(-20,30),(20,30),(60,70),(60,110),(20,150),(-20,150),(-60,110),(-60,70)] ] - , _rmFloor = Tiled [makeTileFromPoly poly 7] - } - where - poly = map toV2 [(-20,40),(20,40),(50,70),(50,110),(20,140),(-20,140),(-50,110),(-50,70)] - lnks = map (first toV2) - [((0,140),0) - ,((35,125),negate $ pi/4) - ,((-35,125),pi/4) - ,( (50,90),negate $ pi/2) - ,( (-50,90),pi/2) - ,((35,55),negate $ 3*pi/4) - ,((-35,55),3*pi/4) - ,( (0,40),pi) - ] - -allPairs :: Eq a => [a] -> [(a,a)] -allPairs xs = [(x,y) | x <- xs, y <- xs, x /= y] - {- Probabilites of the type of the first floor weapon. -} randFirstWeapon :: State StdGen PSType randFirstWeapon = do @@ -287,9 +251,9 @@ weaponRoom i = join $ takeOne , weaponLongCorridor >>= rToOnward "weaponLongCorridor" ] -roomCCrits :: RandomGen g => State g Room -roomCCrits = roomC 200 200 - <&> rmPmnts %~ (replicate 20 (spNoID (PSRoomRand 0 (uncurry PS)) randC1) ++ ) +roomCCrits :: RandomGen g => Int -> State g Room +roomCCrits i = roomC 200 200 + <&> rmPmnts .++~ replicate i (spNoID (PSRoomRand 0 (uncurry PS)) randC1) doubleCorridorBarrels :: RandomGen g => State g Room doubleCorridorBarrels = do @@ -297,13 +261,11 @@ doubleCorridorBarrels = do let cond x = (sndV2 . fst) x < h - 40 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 - ,sPS (V2 75 (h-60)) 0 $ PutCrit explosiveBarrel - ,sPS (V2 85 (h-10)) 0 $ PutCrit explosiveBarrel - ,sPS (V2 85 (h-45)) 0 $ PutCrit explosiveBarrel + ,sPS (V2 25 (h-25)) (negate pi/2) $ PutCrit $ addArmour autoCrit ,sPS (V2 75 (h-80)) 0 putLamp - ] + ] ++ + [sPS p 0 $ PutCrit explosiveBarrel + | p <- [ V2 75 (h-30) ,V2 75 (h-60) ,V2 85 (h-10) ,V2 85 (h-45) ] ] shootersRoom' :: RandomGen g => State g Room shootersRoom' = do diff --git a/src/Dodge/Room/RunPast.hs b/src/Dodge/Room/RunPast.hs index 8e3870ee4..0ea17556b 100644 --- a/src/Dodge/Room/RunPast.hs +++ b/src/Dodge/Room/RunPast.hs @@ -1,37 +1,25 @@ -module Dodge.Room.RunPast where +module Dodge.Room.RunPast + ( lockedStart + ) where import Dodge.UseAll import Geometry.Polygon import Dodge.LevelGen.Data import Dodge.LightSource ---import Dodge.RoomLink import Dodge.Data ---import Dodge.Default ---import Dodge.Layout.Tree.Either import RandomHelp import Dodge.Room.Door ---import Dodge.Room.Room import Dodge.Room.Link import Dodge.Room.Procedural import Dodge.Room.Corridor ---import Dodge.Room.Foreground ---import Dodge.Room.RoadBlock import Dodge.PlacementSpot import Dodge.Placement.Instance import Dodge.Tree import Dodge.Item.Random ---import Dodge.Item.Weapon.SprayGuns ---import Dodge.Item.Weapon.Grenade ---import Dodge.LevelGen.Data import Geometry.Data ---import Padding import Color import LensHelp import qualified Data.Set as S ---import qualified Data.IntMap.Strict as IM - -horEdgeTest :: (Float -> Bool) -> ((Point2,Float) -> Bool) -horEdgeTest t (V2 x _,_) = t x roomCritLS :: RandomGen g => State g LightSource roomCritLS = do @@ -43,27 +31,24 @@ roomCritLS = do smallRoom :: Room smallRoom = corridorWallN & rmRandPSs .~ [psRandRanges (15,25) (30,45) (pi,2*pi)] -lookedStart :: RandomGen g => Int -> State g (Tree Room) -lookedStart i = do +lockedStart :: RandomGen g => Int -> State g (Tree Room) +lockedStart i = do h <- state $ randomR (200,400::Float) thels <- roomCritLS theweapon <- randBlockBreakWeapon - cenroom <- shuffleLinks - $ roomRectAutoLinks 40 h & rmPmnts .~ [plRRpt 0 (PutFlIt theweapon)] + cenroom <- shuffleLinks $ roomRectAutoLinks 40 h & rmPmnts .~ [] theedge <- takeOne $ map OnEdge [West,East] let linkcor = smallRoom & rmPmnts .~ [ spanLS thels (V2 0 65) (V2 40 65) ] - critroom = linkcor & rmPmnts .:~ plRRpt 0 randC1 - switchdoor = triggerDoorRoom i n = length $ filter (elem theedge . _rlType) (_rmLinks cenroom) - doorrooms = map (treePost . (switchdoor:)) - $ [critroom] + doorrooms = map (treePost . (triggerDoorRoom i:)) + $ [linkcor & rmPmnts .:~ plRRpt 0 randC1] : [linkcor,corridor,corridor,cleatOnward door] : replicate (n-2) [linkcor] return $ Node cenroom $ map (over root $ rmConnectsTo .~ S.member theedge) doorrooms - ++ [return corridorWallN + ++ [return smallRoom {_rmOutPmnt = [OutPlacement (putLitButOnPosExtTrig red useUnusedLnk) i] - ,_rmPmnts = [] + ,_rmPmnts = [plRRpt 0 (PutFlIt theweapon)] ,_rmBound = [rectNSWE 70 30 0 40] } ] diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index 0349ae844..f7ce6557f 100644 --- a/src/Dodge/Room/Start.hs +++ b/src/Dodge/Room/Start.hs @@ -71,7 +71,7 @@ randomChallenges = shootingRange runPastStart :: RandomGen g => Int -> State g (Tree Room) runPastStart i = do s <- rezBoxStart - rp <- lookedStart i + rp <- lockedStart i return . shiftChildren $ attachTree toOnward rp $ fmap ([],) s diff --git a/src/Dodge/RoomLink.hs b/src/Dodge/RoomLink.hs index 0461119a5..f0b86ae2d 100644 --- a/src/Dodge/RoomLink.hs +++ b/src/Dodge/RoomLink.hs @@ -15,6 +15,7 @@ module Dodge.RoomLink , setInLinksPD , restrictOutLinks , restrictInLinks + , setOutLinks , setInLinks , setInLinksByType , setLinkType diff --git a/src/Dodge/Tree/Compose.hs b/src/Dodge/Tree/Compose.hs index 8a2fb9cef..477ee5302 100644 --- a/src/Dodge/Tree/Compose.hs +++ b/src/Dodge/Tree/Compose.hs @@ -9,16 +9,11 @@ module Dodge.Tree.Compose , numSelfTree , combineTree , decomposeSelfTree --- , composeTree' , shiftChildren , attachTree --- , composeTreeRand --- , composeAndLog , toOnward , attachOnward , showIntsString --- , cmpToMT --- , compTree , module Dodge.Tree.Compose.Data ) where import Dodge.Data diff --git a/src/Dodge/Tree/Compose/Data.hs b/src/Dodge/Tree/Compose/Data.hs index c030da7c5..26d8fbae5 100644 --- a/src/Dodge/Tree/Compose/Data.hs +++ b/src/Dodge/Tree/Compose/Data.hs @@ -5,7 +5,6 @@ import Data.Tree import Control.Lens ---data MetaTree a = MTree {_mtLabel :: String , _mtTree :: MetaNode a , _mtBranches :: [MetaBranch a] } data MetaTree a b = MTree {_mtLabel :: b , _mtTree :: MetaNode a b, _mtBranches :: [MetaBranch a b] } data MetaNode a b = NodeTree {_nodeTree :: Tree a} | NodeMTree {_nodeMetaTree :: MetaTree a b} data MetaBranch a b = MBranch {_mbAttach :: a -> Maybe a, _mbTree :: MetaTree a b}