diff --git a/src/Dodge/Default/Room.hs b/src/Dodge/Default/Room.hs index e54f52208..1b77c37f9 100644 --- a/src/Dodge/Default/Room.hs +++ b/src/Dodge/Default/Room.hs @@ -3,13 +3,16 @@ module Dodge.Default.Room import Geometry.Data import Dodge.Room.Data +import qualified Data.IntMap.Strict as IM defaultRoom :: Room defaultRoom = Room { _rmPolys = [] , _rmLinks = [] , _rmUsedLinks = [] , _rmPath = [] - , _rmPS = [] + , _rmPmnts = [] + , _rmPartialPmnts = IM.empty + , _rmLabelledPmnts = IM.empty , _rmBound = [] , _rmFloor = [] , _rmName = "defaultRoom" diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 91d1de763..5ff654c70 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -15,6 +15,7 @@ import Dodge.Room.Branch import Dodge.Room.Boss import Dodge.Room.LongDoor import Dodge.Room.NoNeedWeapon +import Dodge.Room.Link import Dodge.Layout.Tree.Polymorphic import Dodge.Layout.Tree.Either import Dodge.Layout.Tree.Annotate @@ -31,16 +32,13 @@ import Control.Monad.Loops import System.Random import Data.Sequence hiding (zipWith) import Data.Maybe + initialAnoTree :: RandomGen g => Tree [Annotation g] initialAnoTree = let struct = treeFromPost [[Corridor,SpecificRoom $ fmap (pure . Right) randomFourCornerRoom]] [EndRoom] t' = padWithCorridors struct in treeFromTrunk [[StartRoom] - ,[SpecificRoom spawnerRoom] - ,[Corridor] - ,[Corridor] - ,[Corridor] ,[Corridor] ,[SpecificRoom $ return $ connectRoom lasTunnel ] ,[Corridor] @@ -122,12 +120,12 @@ layoutLevelFromSeed i seed = do putStr $ "Level generation with seed " ++ show seed ++ " failed: " let (seed',_) = random g layoutLevelFromSeed i' seed' - where - setLastLinkToUsed rm = case _rmLinks rm of - (_:_) -> rm - & rmLinks %~ init - & rmUsedLinks %~ (last (_rmLinks rm) :) - _ -> rm + -- where + -- setLastLinkToUsed rm = case _rmLinks rm of + -- (_:_) -> rm + -- & rmLinks %~ init + -- & rmUsedLinks %~ (last (_rmLinks rm) :) + -- _ -> rm compactDrawTree :: Tree String -> String compactDrawTree = unlines . compactDraw diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 47bef2223..4615cd75f 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -55,7 +55,7 @@ generateLevelFromRoomList gr w zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w doRoomPlacements :: World -> Room -> World -doRoomPlacements w rm = fst $ foldl' placeSpot (w,rm) $ _rmPS rm +doRoomPlacements w rm = fst $ foldl' placeSpot (w,rm) $ _rmPmnts rm updatePSLnkUsing :: (Point2,Float) -> PlacementSpot -> PlacementSpot updatePSLnkUsing pf PSLnk{_psLinkShift=f} = uncurry PS $ f pf @@ -117,13 +117,19 @@ gameRoomsFromRooms = map f f rm = GameRoom { _grViewpoints = _rmViewpoints rm ++ (map fst . foldl' (flip cutWalls) [] $ _rmPolys rm) ++ map fst (_rmLinks rm) - , _grViewpointsEx = map fst (_rmUsedLinks rm) + , _grViewpointsEx = mapMaybe unpos (_rmUsedLinks rm) , _grBound = expandPolyByFixed 100 . convexHullSafe . nubBy closePoints . concat $ _rmBound rm ++ _rmPolys rm - , _grDir = snd . head $ _rmUsedLinks rm + , _grDir = getDir $ _rmUsedLinks rm , _grName = _rmName rm } closePoints x y = roundPoint2 x == roundPoint2 y + unpos (OutLink _ p _) = Just p + unpos (InLink p _) = Just p + unpos _ = Nothing + getDir (InLink _ a:_) = a + getDir (_:xs) = getDir xs + getDir _ = 0 -- fallback floorsFromRooms :: [Room] -> [(Point3,Point3)] floorsFromRooms = concatMap (concatMap tToRender . _rmFloor) diff --git a/src/Dodge/Layout/Tree/Annotate.hs b/src/Dodge/Layout/Tree/Annotate.hs index fcac2c7a4..d595e8681 100644 --- a/src/Dodge/Layout/Tree/Annotate.hs +++ b/src/Dodge/Layout/Tree/Annotate.hs @@ -61,26 +61,26 @@ roomThenCorridor theRoom = fmap (\r -> Node (Left theRoom) [(pure . Right) r]) (randomiseOutLinks corridor) {- | Create a random room tree structure from a list of annotations. -} annoToRoomTree :: RandomGen g => [Annotation g] -> State g (Tree (Either Room Room)) -annoToRoomTree [OrAno as] = do - a <- takeOne as - annoToRoomTree a -annoToRoomTree [Corridor] = pure . Right <$> randomiseOutLinks corridor -annoToRoomTree [CorridorDebug] = pure . Right <$> randomiseOutLinks corridorDebug -annoToRoomTree [DoorAno] = roomThenCorridor door -annoToRoomTree [AirlockAno] = airlock >>= roomThenCorridor -annoToRoomTree [FirstWeapon] = do - branchWP <- branchRectWith weaponRoom - blockedC <- longBlockedCorridor - join $ takeOne $ return (appendEitherTree branchWP [blockedC]) : replicate 5 weaponRoom -annoToRoomTree [EndRoom] = fmap (pure . Right) (telRoomLev 1) -annoToRoomTree [StartRoom] = startRoom -annoToRoomTree (SpecificRoom rt:_) = rt -annoToRoomTree (BossAno cr : _) = do - br <- bossRoom cr - branchRectWith . pure . fmap Left $ treeFromPost [corridor,corridor] br -annoToRoomTree (TreasureAno crs loot : _) = - branchRectWith . fmap (pure . Left) $ lootRoom crs loot -annoToRoomTree _ = do - w <- state $ randomR (100,400) - h <- state $ randomR (200,400) - fmap (pure . Right) . randomiseOutLinks $ roomRectAutoLinks w h +annoToRoomTree anos = case anos of + [OrAno as] -> do + a <- takeOne as + annoToRoomTree a + [Corridor] -> pure . Right <$> randomiseOutLinks corridor + [CorridorDebug] -> pure . Right <$> randomiseOutLinks corridorDebug + [DoorAno] -> roomThenCorridor door + [AirlockAno] -> airlock >>= roomThenCorridor + [FirstWeapon] -> do + branchWP <- branchRectWith weaponRoom + blockedC <- longBlockedCorridor + join $ takeOne $ return (appendEitherTree branchWP [blockedC]) : replicate 5 weaponRoom + [EndRoom] -> fmap (pure . Right) (telRoomLev 1) + [StartRoom] -> startRoom + (SpecificRoom rt:_) -> rt + (BossAno cr : _) -> do + br <- bossRoom cr + branchRectWith . pure . fmap Left $ treeFromPost [corridor,corridor] br + (TreasureAno crs loot : _) -> branchRectWith . fmap (pure . Left) $ lootRoom crs loot + _ -> do + w <- state $ randomR (100,400) + h <- state $ randomR (200,400) + fmap (pure . Right) . randomiseOutLinks $ roomRectAutoLinks w h diff --git a/src/Dodge/Layout/Tree/Shift.hs b/src/Dodge/Layout/Tree/Shift.hs index 78d0ab9a0..0169b3a0a 100644 --- a/src/Dodge/Layout/Tree/Shift.hs +++ b/src/Dodge/Layout/Tree/Shift.hs @@ -1,11 +1,8 @@ -{- | -Given a tree of rooms, tries to shift them into place in such a way that their +{- | Given a tree of rooms, tries to shift them into place in such a way that their links connect and that none of them clip. -Returns a list; after this step the structure is determined by the actual positions of rooms. - -} +Creates a list of rooms; after this step the structure is determined by the actual positions of rooms. -} module Dodge.Layout.Tree.Shift - ( shiftRoomTreeSearchAll - , positionRooms + ( positionRooms ) where import Dodge.Room.Data import Dodge.Room.Link @@ -15,34 +12,9 @@ import Geometry.ConvexPoly import Data.Tree import Data.Sequence hiding (zipWith) import Data.List (delete) ---import Data.Maybe (listToMaybe) import Data.Bifunctor import Control.Lens hiding (Empty, (<|) , (|>)) -{- | All: Depth first search of trees of rooms, produces a list of lists of rooms that are not clipping. -} -shiftRoomTreeSearchAll - :: [ConvexPoly] -- ^ Clipping bounds - -> Seq (Tree Room) -- ^ Rooms to be added - -> [[Room]] -shiftRoomTreeSearchAll _ Empty = [[]] -shiftRoomTreeSearchAll bs (Node r ts :<| tseq) --- | roomIsClipping = [] -- this is called too often--might get memoized? --- | otherwise = case ts of --- [] -> (r :) <$> shiftRoomTreeSearchAll newBounds tseq --- (s:ss) -> concatMap (\l -> shiftRoomTreeSearchAll bs (Node (useLink l) ss <| (tseq |> f l s))) ls - = case ts of - [] | roomIsClipping -> [] - [] -> (r :) <$> shiftRoomTreeSearchAll newBounds tseq - (s:ss) -> concatMap (\l -> shiftRoomTreeSearchAll bs (Node (useLink l) ss <| (tseq |> f l s))) ls - where - convexBounds = map pointsToPoly $ _rmBound r - ls = init $ _rmLinks r - newBounds = convexBounds ++ bs - roomIsClipping = or (convexPolysOverlap <$> convexBounds <*> bs) - useLink l = r & rmLinks %~ delete l - & rmUsedLinks %~ (l :) - f l = applyToRoot (shiftRoomToLink l) - positionRooms :: Tree RoomInt -> IO (Maybe [Room]) positionRooms (Node (r,i) ts) = posRms (map pointsToPoly $ _rmBound r) (r,i) ts Empty @@ -59,30 +31,22 @@ posRms bounds (rtoadd,_) [] (Node (r,i) ts :<| tseq) = fmap (setLastLinkToUsed rtoadd:) <$> posRms bounds (r,i) ts tseq posRms bounds (r,i) (t@(Node (_,i') _):ts) tseq = do putStr $ "Trying to place room " ++ show i' ++ ": " - tryLinks' (0::Int) (_rmLinks r) + tryLinks (0::Int) (_rmLinks r) where - tryLinks' _ [] = do + tryLinks _ [] = do putStrLn "all links tried" return Nothing - tryLinks' j (l:ls) - | clipping = tryLinks' (j+1) ls + tryLinks j (l:ls) + | clipping = tryLinks (j+1) ls | otherwise = do putStrLn $ "placing at link " ++ show j mayrs <- posRms (convexBounds ++ bounds) useLink ts (tseq |> shiftedt) case mayrs of - Nothing -> do putStr ("Backtracking to room " ++ show i' ++ ": ") >> tryLinks' (j+1) ls + Nothing -> do putStr ("Backtracking to room " ++ show i' ++ ": ") >> tryLinks (j+1) ls Just rs -> return (Just rs) where convexBounds = map pointsToPoly $ _rmBound r' clipping = or (convexPolysOverlap <$> convexBounds <*> bounds) - useLink = (r & rmLinks %~ delete l & rmUsedLinks %~ (l :) + useLink = (r & rmLinks %~ delete l & rmUsedLinks %~ (uncurry (OutLink (Prelude.length ts)) l :) , i) shiftedt@(Node (r',_) _) = applyToRoot (first $ shiftRoomToLink l) t - - -setLastLinkToUsed :: Room -> Room -setLastLinkToUsed rm = case _rmLinks rm of - (_:_) -> rm - & rmLinks %~ init - & rmUsedLinks %~ (last (_rmLinks rm) :) - _ -> rm diff --git a/src/Dodge/Placements/Wall.hs b/src/Dodge/Placements/Wall.hs index 95ebeef2c..dc76d267f 100644 --- a/src/Dodge/Placements/Wall.hs +++ b/src/Dodge/Placements/Wall.hs @@ -89,7 +89,7 @@ replacePutID -> Room -> Room replacePutID i psts r = - r & rmPS %~ flip (subZipWith (isPutID i) (\ps pt -> ps & plType .~ pt)) psts + r & rmPmnts %~ flip (subZipWith (isPutID i) (\ps pt -> ps & plType .~ pt)) psts {- Partition a list by a predicate, apply a zip to those elements that satisfy the predicate, concatenate the new zipped list and the other (unchanged) half. -} diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index 5a6601be8..84fca57b3 100644 --- a/src/Dodge/Room.hs +++ b/src/Dodge/Room.hs @@ -41,7 +41,7 @@ roomC w h = do , windowLine (V2 (w/2) 0) (V2 (w/2) (h-60)) ] changeLinkFrom fromCond $ roomRectAutoLinks w h - & rmPS %~ (wl : ) + & rmPmnts %~ (wl : ) & rmRandPSs .~ [farside] where fromCond (V2 x _,_) = x < w / 2 - 10 @@ -56,11 +56,9 @@ roomPadCut ps p = defaultRoom { _rmPolys = [ps] , _rmLinks = [(p,0),(V2 0 0,pi)] , _rmPath = [(V2 0 0,p)] - , _rmPS = [] - , _rmBound = [] } roomPillars :: Room -roomPillars = over rmLinks init $ set rmPS plmnts $ roomRect 240 240 2 2 +roomPillars = over rmLinks init $ set rmPmnts plmnts $ roomRect 240 240 2 2 where plmnts = spanLightI (V2 120 24) (V2 120 216) : mountLightV (V2 12 12) (V3 25 25 70) @@ -86,8 +84,8 @@ glassLesson = do return $ Node (Left botRoom) [deadRoom door,uppers, treeFromPost (Left door : corridors) $ Right door] where uppers = Node (Left door) [deadRoom topRoom] - botRoom = set rmPS botplmnts $ roomRect 200 200 1 1 - topRoom = set rmPS topplmnts $ roomRect 200 200 1 1 + botRoom = set rmPmnts botplmnts $ roomRect 200 200 1 1 + topRoom = set rmPmnts topplmnts $ roomRect 200 200 1 1 botplmnts = [sPS (V2 0 0) 0 $ PutWall (rectNSWE 200 0 90 110) defaultCrystalWall ,sPS (V2 50 100) 0 $ PutCrit miniGunCrit @@ -134,12 +132,12 @@ glassSwitchBack = do return (V2 crx cry,1.5*pi) midPS = return (V2 (wth-20) (hgt/2+40), pi) return $ roomRect wth hgt 2 4 - & rmPS .~ plmnts + & rmPmnts .~ plmnts & rmRandPSs .~ [northPSs,midPS] glassSwitchBackCrits :: RandomGen g => State g Room glassSwitchBackCrits = glassSwitchBack - <&> rmPS %~ ([Placement (PSRoomRand 0) (PutCrit miniGunCrit) (const Nothing) + <&> rmPmnts %~ ([Placement (PSRoomRand 0) (PutCrit miniGunCrit) (const Nothing) , Placement (PSRoomRand 1) randC1 (const Nothing) ] ++) @@ -178,7 +176,7 @@ miniRoom3 = do ,sPS cp (pi/8+7*pi/4) b ,sPS (V2 (w/2) (h/2)) 0 putLamp ] - fmap connectRoom $ randomiseOutLinks $ set rmPS plmnts $ roomRectAutoLinks w h + fmap connectRoom $ randomiseOutLinks $ set rmPmnts plmnts $ roomRectAutoLinks w h rot90Around :: Point2 -> Point2 -> Point2 rot90Around cen p = cen +.+ vNormal (p -.- cen) @@ -200,7 +198,7 @@ roomMiniIntro = fmap (g . expandTreeBy f) $ sequence $ treeFromPost roomCenterPillar :: RandomGen g => State g Room roomCenterPillar = changeLinkTo ((\p -> dist p (V2 120 0) < 10) . fst) - $ set rmPS plmnts $ roomRect 240 240 2 2 + $ set rmPmnts plmnts $ roomRect 240 240 2 2 where plmnts = [ blockLine (V2 115 115) (V2 115 125) @@ -216,7 +214,7 @@ roomOctogon = defaultRoom { _rmPolys = [poly ] , _rmLinks = lnks , _rmPath = allPairs $ map fst lnks -- this is too much - , _rmPS = [] + , _rmPmnts = [] , _rmBound = [map toV2 [(-20,30),(20,30),(60,70),(60,110),(20,150),(-20,150),(-60,110),(-60,70)] ] , _rmFloor = [makeTileFromPoly poly 7] } @@ -260,7 +258,7 @@ weaponEmptyRoom = do ,mntLightLnkCond (const True) ] (fmap connectRoom . randomiseOutLinks) =<< - changeLinkTo ((\p -> dist p (V2 (w/2) 0) < 10) . fst) (set rmPS plmnts $ roomRect w h 2 2) + changeLinkTo ((\p -> dist p (V2 (w/2) 0) < 10) . fst) (set rmPmnts plmnts $ roomRect w h 2 2) weaponUnderCrits :: RandomGen g => State g (Tree (Either Room Room)) weaponUnderCrits = do @@ -271,7 +269,7 @@ weaponUnderCrits = do ] let continuationRoom = treeFromTrunk [Left corridorN,Left corridorN] - (connectRoom (set rmPS plmnts corridorN)) + (connectRoom (set rmPmnts plmnts corridorN)) rcp <- roomCenterPillar deadEndRoom' <- takeOne [roomPillars,rcp] junctionRoom <- takeOne [Left tEast,Left tWest] @@ -292,9 +290,9 @@ weaponBehindPillar = do rcp <- roomCenterPillar return $ treeFromTrunk [Left door - ,Left $ over rmLinks tail $ over rmPS (++ plmnts1) rcp + ,Left $ over rmLinks tail $ over rmPmnts (++ plmnts1) rcp ] - (connectRoom $ set rmPS [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN) + (connectRoom $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN) weaponBetweenPillars :: RandomGen g => State g (Tree (Either Room Room)) weaponBetweenPillars = do @@ -307,7 +305,7 @@ weaponBetweenPillars = do ,sPS crPos1 (d crPos1) randC1 ,sPS crPos2 (d crPos2) randC1 ] - theRoom = roomPillars & rmPS %~ (++ plmnts) + theRoom = roomPillars & rmPmnts %~ (++ plmnts) (fmap connectRoom . randomiseOutLinks) =<< filterLinks f theRoom where f (_,a) = a == 0 @@ -316,7 +314,7 @@ weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room)) weaponLongCorridor = do root <- takeOne [tEast, tWest] connectingRoom <- takeOne - [tEast & rmPS .~ [spanLightI (V2 (-40) 40) (V2 (-40) 80)] + [tEast & rmPmnts .~ [spanLightI (V2 (-40) 40) (V2 (-40) 80)] ] i1 <- state $ randomR (2,5) i2 <- state $ randomR (2,5) @@ -324,11 +322,11 @@ weaponLongCorridor = do let branch2 = treeFromTrunk (replicate i2 $ Left corridorN) (deadRoom $ putWp corridor) return $ Node (Left root) [branch1,branch2] where - putCrs = over rmPS (++ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) 40) (-pi/2) randC1 ]) - putWp = set rmPS [sPS (V2 20 60) 0 $ RandPS randFirstWeapon ,spanLightI (V2 0 40) (V2 40 40)] + putCrs = over rmPmnts (++ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) 40) (-pi/2) randC1 ]) + putWp = set rmPmnts [sPS (V2 20 60) 0 $ RandPS randFirstWeapon ,spanLightI (V2 0 40) (V2 40 40)] critInDeadEnd :: Room -critInDeadEnd = set rmPS [sPS (V2 0 0) 0 randC1] deadEndRoom +critInDeadEnd = set rmPmnts [sPS (V2 0 0) 0 randC1] deadEndRoom deadEndRoom :: Room deadEndRoom = defaultRoom @@ -336,7 +334,7 @@ deadEndRoom = defaultRoom ] , _rmLinks = lnks , _rmPath = [] - , _rmPS = [sPS (V2 0 (-10)) 0 putLamp] + , _rmPmnts = [sPS (V2 0 (-10)) 0 putLamp] , _rmBound = [rectNSWE 20 (-20) (-30) 30] } where @@ -353,7 +351,7 @@ weaponRoom = join $ takeOne roomCCrits :: RandomGen g => State g Room roomCCrits = roomC 200 200 - <&> rmPS %~ (replicate 20 (Placement (PSRoomRand 0) randC1 (const Nothing)) ++ ) + <&> rmPmnts %~ (replicate 20 (Placement (PSRoomRand 0) randC1 (const Nothing)) ++ ) longRoom :: RandomGen g => State g Room longRoom = do @@ -373,7 +371,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 & rmPS .~ ws ++ brls ++ wsDefense ++ + changeLinkTo 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 @@ -385,7 +383,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 & rmPS .~ + changeLinkTo 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 @@ -413,19 +411,19 @@ shootersRoom' = do ,spanLightI (V2 (w/2) 200) (V2 (w+10) 200) ] toPS x y = return (V2 x y,-0.5*pi) - return $ set rmPS plmnts $ roomRectAutoLinks w 600 - & rmPS .~ plmnts + return $ set rmPmnts plmnts $ roomRectAutoLinks w 600 + & rmPmnts .~ plmnts & rmRandPSs .~ [toPS x1 y1,toPS x2 y2,toPS x3 y3] shootersRoom1 :: RandomGen g => State g Room -shootersRoom1 = shootersRoom' <&> rmPS %~ +shootersRoom1 = shootersRoom' <&> rmPmnts %~ ( ( RandomPlacement $ takeOne $ map (\i -> Placement (PSRoomRand i) (PutCrit autoCrit) (const Nothing)) [0,1,2] ) :) shootersRoom :: RandomGen g => State g Room -shootersRoom = shootersRoom' <&> rmPS %~ +shootersRoom = shootersRoom' <&> rmPmnts %~ ( map (\i -> Placement (PSRoomRand i) (PutCrit autoCrit) (const Nothing)) [0,1,2] ++ ) @@ -456,13 +454,13 @@ pillarGrid = do ++ concat [f x y | x<-xs,y<-ys] return $ roomRect w h (max i 2) (max i 2) - & rmPS .~ plmnts + & rmPmnts .~ plmnts & rmRandPSs .~ [rps] -- TODO remove possible identical draws on random PSs pistolerRoom :: RandomGen g => State g Room pistolerRoom = pillarGrid - <&> rmPS %~ ( + <&> rmPmnts %~ ( [Placement (PSRoomRand 0) (PutCrit pistolCrit) (const Nothing) ,Placement (PSRoomRand 0) (PutCrit pistolCrit) (const Nothing) ,Placement (PSRoomRand 0) (PutCrit pistolCrit) (const Nothing) @@ -480,10 +478,10 @@ shootingRange = do return $ treeFromPost [Left rm1 ,Left $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20) - & rmPS %~ (spanLightI (V2 (-80) 10) (V2 80 10) :) + & rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :) ,Left rm2 ,Left $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20) - & rmPS %~ (spanLightI (V2 (-80) 10) (V2 80 10) :) + & rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :) ] (Right rm3) @@ -492,6 +490,6 @@ spawnerRoom = do x <- state $ randomR (250,300) y <- state $ randomR (300,400) roomWithSpawner <- roomC x y <&> - rmPS %~ (Placement (PSRoomRand 0) (PutCrit spawnerCrit) (const Nothing) :) + rmPmnts %~ (Placement (PSRoomRand 0) (PutCrit spawnerCrit) (const Nothing) :) aRoom <- airlock return $ treeFromTrunk [Left aRoom,Left corridor] $ connectRoom roomWithSpawner diff --git a/src/Dodge/Room/Airlock.hs b/src/Dodge/Room/Airlock.hs index 95bf4370e..8f09047ac 100644 --- a/src/Dodge/Room/Airlock.hs +++ b/src/Dodge/Room/Airlock.hs @@ -26,7 +26,7 @@ airlock0 = defaultRoom { _rmPolys = [ rectNSWE 100 0 0 40 , rectNSWE 65 35 (-40) 20 ] , _rmLinks = lnks , _rmPath = [(V2 20 95,V2 20 45) ,(V2 20 45,V2 20 5) ] - , _rmPS = + , _rmPmnts = [Placement (PS (V2 (-35) 50) (negate $ pi/2)) (PutButton $ makeSwitch col red id id) $ \btid -> Just $ putDoubleDoorThen False col (not . cond' btid) (V2 (-1) 20) (V2 41 20) 2 $ Just $ putDoubleDoorThen False col (cond' btid) (V2 (-1) 80) (V2 41 80) 2 Nothing @@ -48,7 +48,7 @@ airlockSimple = defaultRoom [ rectNSWE 120 0 0 180 ] , _rmLinks = lnks , _rmPath = concatMap (doublePair. (V2 90 30,) . fst) lnks - , _rmPS = + , _rmPmnts = [ Placement (PS (V2 90 115) pi) (PutButton $ makeSwitch col red id id) $ \btid -> jspsJ (V2 0 0) 0 (PutDoor col (cond btid) outDoorps) $ sPS (V2 180 0) 0 (PutDoor col (cond btid) inDoorps) @@ -77,7 +77,7 @@ airlockZ = defaultRoom -- [(V2 0 40,V2 40 0) -- ,(V2 40 0,V2 0 40) -- ] - , _rmPS = + , _rmPmnts = [ Placement (PS (V2 90 115) pi) (PutButton $ makeSwitch col red id id) $ \btid -> jspsJ (V2 0 60) 0 (PutDoor col (cond btid) outDoorps) $ sPS (V2 180 60) 0 (PutDoor col (cond btid) inDoorps) @@ -117,7 +117,7 @@ airlock90 = defaultRoom [(V2 0 40,V2 40 0) ,(V2 40 0,V2 0 40) ] - , _rmPS = + , _rmPmnts = [ Placement (PS (V2 120 120) (3 * pi/4)) (PutButton $ makeSwitch col red id id) $ \btid -> jsps (V2 5 5) 0 $ PutDoor col (cond btid) pss ,mountLightV (V2 20 20) (V3 70 70 50) @@ -145,7 +145,7 @@ airlockCrystal = defaultRoom ] , _rmLinks = [(V2 20 130,0) ,(V2 20 0 ,pi) ] , _rmPath = [ ] - , _rmPS = + , _rmPmnts = [ Placement (PS (V2 145 70) (pi/2)) ( PutButton $ makeSwitch col red id id) $ \btid -> jsps0 $ PutDoor col (cond btid) pss , crystalLine (V2 0 70) (V2 40 70) diff --git a/src/Dodge/Room/Boss.hs b/src/Dodge/Room/Boss.hs index d0c1166ad..bd9cd550b 100644 --- a/src/Dodge/Room/Boss.hs +++ b/src/Dodge/Room/Boss.hs @@ -34,7 +34,7 @@ roomGlassOctogon x = createPathGrid $ defaultRoom [ ( V2 0 x , V2 0 (-(x+40))) , ( V2 0 (-(x+40)), V2 0 x) ] - , _rmPS = + , _rmPmnts = [sPS (V2 fx fx) 0 putLamp ,sPS (V2 (-fx) fx) 0 putLamp ,sPS (V2 fx (-fx)) 0 putLamp @@ -55,14 +55,14 @@ roomGlassOctogon x = createPathGrid $ defaultRoom ] bossRoom :: RandomGen g => Creature -> State g Room -bossRoom cr = randomMediumRoom <&> rmPS %~ ( sPS (V2 0 100) (negate $ pi/2) (PutCrit cr) :) +bossRoom cr = randomMediumRoom <&> rmPmnts %~ ( sPS (V2 0 100) (negate $ pi/2) (PutCrit cr) :) armouredChasers :: RandomGen g => State g (Tree Room) armouredChasers = do ps <- takeN 5 [V2 x y | x <- [-100,-80 .. 100] ,y <- [-100,-80 .. 100] ] as <- replicateM 5 . state $ randomR (0,2*pi) let theCrits = zipWith3 (\p a c -> sPS p a (PutCrit c)) ps as cs - treeFromPost [corridor,corridor] <$> (randomMediumRoom <&> rmPS %~ (++ theCrits)) + treeFromPost [corridor,corridor] <$> (randomMediumRoom <&> rmPmnts %~ (++ theCrits)) where cs = (armourChaseCrit & crState . crDropsOnDeath .~ DropSpecific [0]) : replicate 4 chaseCrit @@ -94,7 +94,7 @@ roomCross x y = defaultRoom ,(V2 (y-20) (-x),pi) ] , _rmPath = [] - , _rmPS = + , _rmPmnts = [ spanLightI (V2 (x+5) x) (V2 (x+5) (-x)) , spanLightI (V2 (-x-5) x) (V2 (-x-5) (-x)) ] @@ -119,7 +119,7 @@ roomShuriken x y = { _rmPolys = ps , _rmLinks = [(V2 (x-1) (y-20),negate $ pi/2)] , _rmPath = [] - , _rmPS = [mountLight (V2 x x) (V3 (x-20) x 70)] + , _rmPmnts = [mountLight (V2 x x) (V3 (x-20) x 70)] , _rmBound = ps } in foldr1 combineRooms $ map (\r -> shiftRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2] @@ -143,7 +143,7 @@ roomTwistCross x y z = { _rmPolys = ps , _rmLinks = [(V2 z (y-20), pi/2)] , _rmPath = [] - , _rmPS = [mountLight (V2 x x) (V3 (x-20) (x-20) 70)] + , _rmPmnts = [mountLight (V2 x x) (V3 (x-20) (x-20) 70)] , _rmBound = ps } in foldr1 combineRooms $ map (\r -> shiftRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2] diff --git a/src/Dodge/Room/Corridor.hs b/src/Dodge/Room/Corridor.hs index 990098715..22bd3339f 100644 --- a/src/Dodge/Room/Corridor.hs +++ b/src/Dodge/Room/Corridor.hs @@ -17,7 +17,7 @@ corridor = defaultRoom { _rmPolys = [poly] , _rmLinks = lnks , _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks - , _rmPS = [ spanLightI (V2 0 40) (V2 40 40) ] + , _rmPmnts = [ spanLightI (V2 0 40) (V2 40 40) ] , _rmBound = [ rectNSWE 50 30 0 40 ] , _rmFloor = [makeTileFromPoly poly 2] } @@ -39,7 +39,7 @@ corridorDebug = defaultRoom ] , _rmLinks = lnks , _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks - , _rmPS = [] + , _rmPmnts = [] , _rmBound = [ rectNSWE 50 30 0 40 ] } where @@ -55,7 +55,7 @@ corridorN = defaultRoom ] , _rmLinks = lnks , _rmPath = pth - , _rmPS = [] + , _rmPmnts = [] , _rmBound = [ rectNSWE 50 30 0 40 ] } where lnks = [(V2 20 70 ,0) @@ -70,7 +70,7 @@ tEast = defaultRoom ] , _rmLinks = lnks , _rmPath = concatMap (doublePair . (,) (V2 0 60) . fst) lnks - , _rmPS = [] + , _rmPmnts = [] , _rmBound = [ rectNSWE 70 10 0 40 ] } where @@ -86,7 +86,7 @@ tWest = defaultRoom ] , _rmLinks = lnks , _rmPath = concatMap (doublePair . (,) (V2 0 60) . fst) lnks - , _rmPS = [] + , _rmPmnts = [] , _rmBound = [ rectNSWE 70 10 0 40 ] } where diff --git a/src/Dodge/Room/Data.hs b/src/Dodge/Room/Data.hs index bd867f5b1..b04a90b7b 100644 --- a/src/Dodge/Room/Data.hs +++ b/src/Dodge/Room/Data.hs @@ -9,6 +9,7 @@ import Data.Tile import Control.Monad.State import System.Random import Control.Lens +import qualified Data.IntMap.Strict as IM {- The '_rmPolys' list states which polygons should be cut out to form the indestructible walls of the room. Link pairs contain a position and rotation to attach to another room; @@ -21,9 +22,11 @@ assigning no bounds will allow rooms to overlap. data Room = Room { _rmPolys :: [ [Point2] ] , _rmLinks :: [(Point2,Float)] - , _rmUsedLinks :: [(Point2,Float)] + , _rmUsedLinks :: [RoomPos] , _rmPath :: [(Point2, Point2)] - , _rmPS :: [Placement] + , _rmPmnts :: [Placement] + , _rmLabelledPmnts :: IM.IntMap Placement + , _rmPartialPmnts :: IM.IntMap (Int -> Placement) , _rmBound :: [ [Point2] ] , _rmFloor :: [Tile] , _rmName :: String @@ -32,7 +35,9 @@ data Room = Room , _rmRandPSs :: [State StdGen (Point2,Float)] } data RoomPos - = Link (Point2,Float) - | UsedLink (Point2,Float) - | LinkInt Int (Point2,Float) + = OutLink Int Point2 Float + | InLink Point2 Float + | PosInt Int Point2 Float + | PosPl Point2 Float + deriving (Eq,Ord,Show) makeLenses ''Room diff --git a/src/Dodge/Room/Door.hs b/src/Dodge/Room/Door.hs index b7eec9302..1ae965f2a 100644 --- a/src/Dodge/Room/Door.hs +++ b/src/Dodge/Room/Door.hs @@ -14,8 +14,8 @@ door = defaultRoom , _rmLinks = lnks , _rmPath = [(V2 20 35,V2 20 5)] -- door extends into side walls (for shadows as rendered 12/03) - , _rmPS = [putAutoDoor (V2 0 20) (V2 40 20)] - , _rmBound = [] + , _rmPmnts = [putAutoDoor (V2 0 20) (V2 40 20)] +-- note no bounds } where lnks = [(V2 20 35,0) ,(V2 20 5,pi) diff --git a/src/Dodge/Room/Link.hs b/src/Dodge/Room/Link.hs index d0bc47b47..e9eed36f6 100644 --- a/src/Dodge/Room/Link.hs +++ b/src/Dodge/Room/Link.hs @@ -15,6 +15,7 @@ module Dodge.Room.Link , randomiseOutLinks , randomiseLinksBy , invShiftLinkBy + , setLastLinkToUsed ) where import Dodge.LevelGen import Dodge.Room.Data @@ -105,3 +106,10 @@ shiftPathBy -> (Point2,Point2) -> (Point2,Point2) shiftPathBy s (p1,p2) = (shiftPointBy s p1, shiftPointBy s p2) + +setLastLinkToUsed :: Room -> Room +setLastLinkToUsed rm = case _rmLinks rm of + (_:_) -> rm + & rmLinks %~ init + & rmUsedLinks %~ (uncurry InLink (last (_rmLinks rm)) :) + _ -> rm diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index f99119b7d..23b6c0401 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -38,7 +38,7 @@ twinSlowDoorRoom w h x = defaultRoom , (V2 0 (-h), pi) ] , _rmPath = [] - , _rmPS = + , _rmPmnts = [ Placement (PS (V2 0 (h-5)) pi) ( PutButton $ makeButton col id) $ \btid -> jsps0J (PutSlideDoor False col (cond' btid) (V2 x 1) (V2 x h) wlSpeed) $ ps0 (PutSlideDoor False col (cond' btid) (V2 (-x) 1) (V2 (-x) h) wlSpeed) @@ -73,7 +73,7 @@ twinSlowDoorChasers = do rps = V2 65 <$> [20,40 .. 180] ps <- takeN 4 $ lps ++ rps let plmnts = map (\p -> sPS p 0 $ PutCrit chaseCrit) ps - return $ twinSlowDoorRoom 80 200 40 & rmPS %~ (plmnts ++) + return $ twinSlowDoorRoom 80 200 40 & rmPmnts %~ (plmnts ++) southPillarsRoom :: RandomGen g => Float -> Float -> Float -> State g Room southPillarsRoom x y h = do @@ -85,7 +85,7 @@ southPillarsRoom x y h = do pillarsc = putBlockRect (x/3-20) (x/3+20) (h/2-20) (h/2+20) ++ putBlockRect (2*x/3-20) (2*x/3+20) (h/2-20) (h/2+20) pillars <- takeOne [pillarsa, pillarsb, pillarsc] - return $ roomRectAutoLinks x y & rmPS .~ pillars + return $ roomRectAutoLinks x y & rmPmnts .~ pillars addSouthPillars :: RandomGen g => Float -> Float -> Room -> State g Room addSouthPillars x h r = do @@ -97,7 +97,7 @@ addSouthPillars x h r = do pillarsc = putBlockRect (x/3-20) (x/3+20) (h/2-20) (h/2+20) ++ putBlockRect (2*x/3-20) (2*x/3+20) (h/2-20) (h/2+20) pillars <- takeOne [pillarsa, pillarsb, pillarsc] - return $ r & rmPS %~ (++ pillars) + return $ r & rmPmnts %~ (++ pillars) addButtonSlowDoor :: RandomGen g => Float -> Float -> Room -> State g Room addButtonSlowDoor x h rm = do @@ -107,7 +107,7 @@ addButtonSlowDoor x h rm = do ] thePlacement <- takeOne [butDoor butPos butRot ] changeLinkFrom aboveH =<< changeLinkTo belowH (rm - & rmPS %~ (thePlacement :) + & rmPmnts %~ (thePlacement :) & rmBound %~ (openDoorBound :) ) where @@ -138,7 +138,7 @@ slowDoorRoom = do lsources = [sPS (V2 (x/2) 30) 0 putLamp, sPS (V2 (x/2) (y-30)) 0 putLamp] barrels = zipWith (\x' y' -> sPS (V2 x' y') 0 $ PutCrit explosiveBarrel) xs' ys' proom <- southPillarsRoom x y h - addButtonSlowDoor x h (proom & rmPS %~ (++ (crits ++ barrels ++ lsources))) + addButtonSlowDoor x h (proom & rmPmnts %~ (++ (crits ++ barrels ++ lsources))) randC1 :: PSType randC1 = RandPS $ takeOne $ map PutCrit $ armourChaseCrit : replicate 50 chaseCrit diff --git a/src/Dodge/Room/NoNeedWeapon.hs b/src/Dodge/Room/NoNeedWeapon.hs index b17efbc68..6e4e770e2 100644 --- a/src/Dodge/Room/NoNeedWeapon.hs +++ b/src/Dodge/Room/NoNeedWeapon.hs @@ -34,5 +34,5 @@ centerVaultExplosiveExit = do ,sPS (V2 0 120) 0 $ PutCrit explosiveBarrel ,sPS (V2 0 0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll) ] - r <- centerVaultRoom 120 120 50 <&> rmPS %~ (extraPS ++) + r <- centerVaultRoom 120 120 50 <&> rmPmnts %~ (extraPS ++) randomiseLinksBy shuffleTail r <&> rmLinks %~ take 2 diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index f1fed2208..633659b05 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -48,7 +48,7 @@ roomRect x y xn yn = defaultRoom { _rmPolys = [rectNSWE y 0 0 x ] , _rmLinks = lnks , _rmPath = concatMap doublePair pth - , _rmPS = [] + , _rmPmnts = [] , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)] , _rmFloor = [Tile { _tilePoly = rectNSWE y 0 0 x @@ -69,7 +69,7 @@ roomRect x y xn yn = defaultRoom {- Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size. -} roomRectAutoLinks :: Float -> Float -> Room roomRectAutoLinks x y = (roomRect x y ((ceiling x - 40) `div` 60) ((ceiling y - 40) `div` 60)) - {_rmPS = plmnts} + {_rmPmnts = plmnts} where plmnts = [mntLightLnkCond (const True) @@ -83,8 +83,8 @@ combineRooms r r' = defaultRoom , _rmLinks = _rmLinks r ++ _rmLinks r' , _rmPath = map clampPath $ _rmPath r ++ _rmPath r' - , _rmPS = map (shiftPlacement $ _rmShift r) (_rmPS r) - ++ map (shiftPlacement $ _rmShift r') (_rmPS r') + , _rmPmnts = map (shiftPlacement $ _rmShift r) (_rmPmnts r) + ++ map (shiftPlacement $ _rmShift r') (_rmPmnts r') , _rmBound = _rmBound r ++ _rmBound r' , _rmFloor = _rmFloor r ++ _rmFloor r' , _rmShift = (V2 0 0 , 0) @@ -126,7 +126,7 @@ quarterRoomFlat w = do ,(V2 0 (w-20),V2 0 0) ,(V2 (55-w) (w-20),V2 0 0) ] - , _rmPS = b + , _rmPmnts = b , _rmBound = [[V2 0 0,V2 w w,V2 (-w) w]] } @@ -167,13 +167,13 @@ fourthCornerWall w = do ,(V2 0 0,V2 0 (w-40)) -- ,(V2 (20-w) (w-20),V2 (40-w) (w)) ] - , _rmPS = b + , _rmPmnts = b , _rmBound = [map toV2 [(w,w),(0,2*w),(-w,w)]] } {- | Replace the first 'PutNothing' with a given 'PSType'. -} fillNothingPlacement :: PSType -> Room -> Room fillNothingPlacement pst r = - r & rmPS %~ replaceNothingWith pst + r & rmPmnts %~ replaceNothingWith pst where replaceNothingWith x (Placement (PS p rot) PutNothing _: pss) = sPS p rot x : pss replaceNothingWith x (ps:pss) = ps : replaceNothingWith x pss @@ -186,8 +186,8 @@ fillNothingPlacements pst r = foldr fillNothingPlacement r pst Useful for randomising the position of generic placements such as 'PutNothing'. -} shufflePlacements :: RandomGen g => Room -> State g Room shufflePlacements r = do - newPSs <- shuffle $ _rmPS r - return $ r & rmPS .~ newPSs + newPSs <- shuffle $ _rmPmnts r + return $ r & rmPmnts .~ newPSs {- | A randomly generate room based on four randomly generated corners. Tight corridors, random placements. -} randomFourCornerRoom :: RandomGen g => State g Room @@ -201,7 +201,7 @@ randomFourCornerRoom = do ++ replicate 20 chaseCrit randomiseAllLinks . fillNothingPlacements (crits ++ itms) =<< ( shufflePlacements - . over rmPS ( sps0 putLamp :) + . over rmPmnts ( sps0 putLamp :) . foldr1 combineRooms $ zipWith (\r a -> shiftRoomBy (V2 0 0,a) r) corners [0,pi/2,pi,3*pi/2] ) @@ -221,7 +221,7 @@ centerVaultRoom w h d = do ,(V2 0 (-h), pi ) ] , _rmPath = [] - , _rmPS = + , _rmPmnts = [sps0 $ PutWall (rectNSEW d (d - 30) d (d - 30)) defaultWall ,sps0 $ PutWall (rectNSEW d (d - 30) (-d) (30 - d)) defaultWall ,sps0 $ PutWall (rectNSEW (-d) (30 - d) d (d - 30)) defaultWall diff --git a/src/Dodge/Room/RoadBlock.hs b/src/Dodge/Room/RoadBlock.hs index 37cb291a0..cfc10e234 100644 --- a/src/Dodge/Room/RoadBlock.hs +++ b/src/Dodge/Room/RoadBlock.hs @@ -41,7 +41,7 @@ litCorridor90 = do ,( V2 0 (h-40) , V2 20 (h-40) ) ,( V2 40 (h-40) , V2 20 (h-40) ) ] - , _rmPS = + , _rmPmnts = [ sPS (V2 20 (h-5)) 0 putLamp , spanLightI (V2 0 (0.4*h)) (V2 40 (0.4*h)) , windowLine (V2 0 (h-20)) (V2 40 (h-20)) @@ -63,7 +63,7 @@ longBlockedCorridor = do ,sPS (V2 20 15) 0 putLamp ] sequence $ treeFromPost (replicate n $ Left <$> randomiseOutLinks corridor) - $ return $ Right $ set rmPS plmnts corridor + $ return $ Right $ set rmPmnts plmnts corridor -- | A single corridor with a destructible block blocking it. blockedCorridor :: RandomGen g => State g (Tree (Either Room Room)) @@ -74,14 +74,14 @@ blockedCorridor = do $ reverse $ rectNSWE 10 (-10) (-10) 10 ,spanLightI (V2 0 15) (V2 40 15) ] - sequence $ treeFromPost [] $ return $ Right $ set rmPS plmnts corridor + sequence $ treeFromPost [] $ return $ Right $ set rmPmnts plmnts corridor lasTunnel :: Room lasTunnel = defaultRoom { _rmPolys = polys , _rmBound = polys , _rmLinks = [(V2 20 190,1.5* pi),(V2 0 20,0.5* pi)] - , _rmPS = [putLasTurret & plSpot .~ PS (V2 10 240) (1.5*pi) + , _rmPmnts = [putLasTurret & plSpot .~ PS (V2 10 240) (1.5*pi) , lowWall (rectNSEW 65 40 0 25) , mountLightV (V2 50 10) (V3 40 20 50) ] diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index 7f7129f37..82a6063b9 100644 --- a/src/Dodge/Room/Start.hs +++ b/src/Dodge/Room/Start.hs @@ -20,7 +20,7 @@ import System.Random rezBox :: Room rezBox = shiftRoomBy (V2 (-20) (-10),0) $ roomRect 40 20 1 1 - & rmPS .~ [ spanColLightI (V3 0 0.7 0.2) 70 (V2 0 10) (V2 40 10) ] + & rmPmnts .~ [ spanColLightI (V3 0 0.7 0.2) 70 (V2 0 10) (V2 40 10) ] startRoom :: RandomGen g => State g (Tree (Either Room Room)) startRoom = do @@ -30,7 +30,7 @@ startRoom = do girderV 40 20 10 (V2 0 (h/2)) (V2 w (h/2)) treeFromPost [Left rezBox, Left door] . Right <$> randomiseOutLinks (shiftRoomBy (V2 (-20) (-20),0) - $ roomRectAutoLinks w h & rmPS %~ + $ roomRectAutoLinks w h & rmPmnts %~ ( [ fground , mountLightJ (V2 0 (h/3)) (V3 40 (h/3) 70) diff --git a/src/Dodge/Room/Teleport.hs b/src/Dodge/Room/Teleport.hs index 21adabfb1..f72c43b6d 100644 --- a/src/Dodge/Room/Teleport.hs +++ b/src/Dodge/Room/Teleport.hs @@ -22,7 +22,7 @@ telRoomLev telRoomLev _ = do w <- state $ randomR (200,300) h <- state $ randomR (200,300) - return $ roomRectAutoLinks w h & rmPS .~ + return $ roomRectAutoLinks w h & rmPmnts .~ [ sPS (V2 (w/2) (h/2)) 0 $ PutPressPlate telPP , sPS (V2 (w/2) (h/2+ 30)) 0 putLamp ] diff --git a/src/Dodge/Room/Treasure.hs b/src/Dodge/Room/Treasure.hs index 12027edf4..eb7faf165 100644 --- a/src/Dodge/Room/Treasure.hs +++ b/src/Dodge/Room/Treasure.hs @@ -28,7 +28,7 @@ triLootRoom w h = pure $ defaultRoom ] , _rmLinks = [(V2 0 (-80) , pi)] , _rmPath = doublePair (V2 0 (-80) , V2 0 (h/2)) - , _rmPS = + , _rmPmnts = [sPS (V2 (15-w) 15 ) 0 $ PutID 0 ,sPS (V2 (w-15) 15 ) pi $ PutID 0 ,sPS (V2 0 (h-35)) 0 $ PutID 2