From 0f4040807a98a5f2c9d8653f472363572c4cf784 Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 23 Nov 2021 17:27:33 +0000 Subject: [PATCH] Transition to new room datatypes, first separate out/inlinks --- src/Dodge/Debug/LinkDecoration.hs | 2 +- src/Dodge/Default/Room.hs | 3 +- src/Dodge/LevelGen/Data.hs | 3 +- src/Dodge/Room/Airlock.hs | 21 +++++----- src/Dodge/Room/Boss.hs | 15 ++++--- src/Dodge/Room/CheckConsistency.hs | 2 +- src/Dodge/Room/Corridor.hs | 15 ++++--- src/Dodge/Room/Door.hs | 6 ++- src/Dodge/Room/Link.hs | 63 +++++++++++++++++------------- src/Dodge/Room/LongDoor.hs | 7 ++-- src/Dodge/Room/NoNeedWeapon.hs | 2 +- src/Dodge/Room/Path.hs | 2 +- src/Dodge/Room/Procedural.hs | 22 +++++++---- src/Dodge/Room/RoadBlock.hs | 8 ++-- src/Dodge/Room/Room.hs | 17 +++++--- src/Dodge/Room/RunPast.hs | 2 +- src/Dodge/Room/Start.hs | 9 +++-- src/Dodge/Room/Treasure.hs | 3 +- src/Dodge/Tree/Shift.hs | 4 +- 19 files changed, 119 insertions(+), 87 deletions(-) diff --git a/src/Dodge/Debug/LinkDecoration.hs b/src/Dodge/Debug/LinkDecoration.hs index d4445f6aa..71970ec7a 100644 --- a/src/Dodge/Debug/LinkDecoration.hs +++ b/src/Dodge/Debug/LinkDecoration.hs @@ -22,7 +22,7 @@ addRoomLinkDecorations rms w = w & decorations %~ IM.insertWithNewKeys (map roomLinkDecorations rms) roomLinkDecorations :: Room -> Picture -roomLinkDecorations rm = pictures . map linkDecoration $ _rmLinks rm +roomLinkDecorations rm = pictures . map linkDecoration $ _rmOutLinks rm ++ _rmInLinks rm linkDecoration :: (Point2,Float) -> Picture linkDecoration (p,a) = setLayer 1 . onLayer DebugLayer . color red $ line [p, p +.+ 20 *.* unitVectorAtAngle (a - pi/2)] diff --git a/src/Dodge/Default/Room.hs b/src/Dodge/Default/Room.hs index 0882f5762..f5c848324 100644 --- a/src/Dodge/Default/Room.hs +++ b/src/Dodge/Default/Room.hs @@ -7,8 +7,9 @@ import qualified Data.IntMap.Strict as IM defaultRoom :: Room defaultRoom = Room { _rmPolys = [] - , _rmLinks = [] + , _rmOutLinks = [] , _rmLinkEff = [] + , _rmInLinks = [] , _rmPos = [] , _rmPath = [] , _rmPmnts = [] diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index b0fadfad0..8a4c8ec51 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -63,7 +63,8 @@ assigning no bounds will allow rooms to overlap. -} data Room = Room { _rmPolys :: [ [Point2] ] - , _rmLinks :: [(Point2,Float)] + , _rmOutLinks :: [(Point2,Float)] + , _rmInLinks :: [(Point2,Float)] -- update the room when assigning the next link to an adjacent room with the head of of this list, return the tail , _rmLinkEff :: [(Point2,Float) -> Room -> Room] , _rmPos :: [RoomPos] diff --git a/src/Dodge/Room/Airlock.hs b/src/Dodge/Room/Airlock.hs index 53b1bc2c5..b4441dfe0 100644 --- a/src/Dodge/Room/Airlock.hs +++ b/src/Dodge/Room/Airlock.hs @@ -23,7 +23,8 @@ airlock = takeOne [airlock0,airlock90,airlockCrystal,airlockZ] airlock0 :: Room airlock0 = defaultRoom { _rmPolys = [ rectNSWE 100 0 0 40 , rectNSWE 65 35 (-40) 20 ] - , _rmLinks = lnks + , _rmOutLinks = init lnks + , _rmInLinks = [last lnks] , _rmPath = [(V2 20 95,V2 20 45) ,(V2 20 45,V2 20 5) ] , _rmPmnts = [pContID (PS (V2 (-35) 50) (negate $ pi/2)) (PutButton $ makeSwitch col red id id) @@ -45,7 +46,8 @@ airlockSimple :: Room airlockSimple = defaultRoom { _rmPolys = [ rectNSWE 120 0 0 180 ] - , _rmLinks = lnks + , _rmOutLinks = init lnks + , _rmInLinks = [last lnks] , _rmPath = concatMap (doublePair. (V2 90 30,) . fst) lnks , _rmPmnts = [pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red id id) @@ -68,10 +70,8 @@ airlockZ :: Room airlockZ = defaultRoom { _rmPolys = [ rectNSWE 120 0 0 180 ] - , _rmLinks = - [(V2 0 30,pi/2) - ,(V2 180 30,1.5*pi) - ] + , _rmOutLinks = [(V2 0 30,pi/2)] + , _rmInLinks = [(V2 180 30,1.5*pi) ] , _rmPath = [] -- [(V2 0 40,V2 40 0) -- ,(V2 40 0,V2 0 40) @@ -108,10 +108,8 @@ airlock90 = defaultRoom , (100,10) ] ] - , _rmLinks = - [(V2 0 40,pi/2) - ,(V2 40 0,pi) - ] + , _rmOutLinks = [(V2 0 40,pi/2)] + , _rmInLinks = [(V2 40 0,pi) ] , _rmPath = [(V2 0 40,V2 40 0) ,(V2 40 0,V2 0 40) @@ -143,7 +141,8 @@ airlockCrystal = defaultRoom [ rectNSWE 140 0 0 40 , orderPolygon $ map toV2 [ (39,20) , (150,60) , (150,80) , (39,120) ] ] - , _rmLinks = [(V2 20 130,0) ,(V2 20 0 ,pi) ] + , _rmOutLinks = [(V2 20 130,0) ] + , _rmInLinks = [(V2 20 0 ,pi) ] , _rmPath = [ ] , _rmPmnts = [pContID (PS (V2 145 70) (pi/2)) ( PutButton $ makeSwitch col red id id) diff --git a/src/Dodge/Room/Boss.hs b/src/Dodge/Room/Boss.hs index 3c0456959..5744c5f21 100644 --- a/src/Dodge/Room/Boss.hs +++ b/src/Dodge/Room/Boss.hs @@ -29,7 +29,8 @@ roomGlassOctogon x = createPathGrid $ defaultRoom [rectNSWE x (-x) (-x) x ,rectNSWE 0 (-(x + 40)) (-20) 20 ] - , _rmLinks = lnks + , _rmOutLinks = init lnks + , _rmInLinks = [last lnks] , _rmPath = linksAndPath lnks [ ( V2 0 x , V2 0 (-(x+40))) , ( V2 0 (-(x+40)), V2 0 x) @@ -84,15 +85,15 @@ roomCross x y = defaultRoom { _rmPolys = [rectNSWE y (-y) (-x) x ,rectNSWE (-x) x y (-y) ] - , _rmLinks = + , _rmOutLinks = [(V2 x (y-20),negate $ pi/2) ,(V2 x (20-y),negate $ pi/2) ,(V2 (20-y) x ,0) ,(V2 (y-20) x ,0) ,(V2 (-x) (y-20),pi/2) ,(V2 (-x) (20-y),pi/2) - ,(V2 (20-y) (-x),pi) - ,(V2 (y-20) (-x),pi) + ,(V2 (20-y) (-x),pi) ] + , _rmInLinks = [(V2 (y-20) (-x),pi) ] , _rmPath = [] , _rmPmnts = @@ -119,7 +120,8 @@ roomShuriken x y = ] ] corner = defaultRoom { _rmPolys = ps - , _rmLinks = [(V2 (x-1) (y-20),negate $ pi/2)] + , _rmOutLinks = [(V2 (x-1) (y-20),negate $ pi/2)] + , _rmInLinks = [(V2 (x-1) (y-20),negate $ pi/2)] , _rmPath = [] , _rmPmnts = [mntLS iShape (V2 x x) (V3 (x-20) x 70)] , _rmBound = ps @@ -144,7 +146,8 @@ roomTwistCross x y z = ] corner = defaultRoom { _rmPolys = ps - , _rmLinks = [(V2 z (y-20), pi/2)] + , _rmOutLinks = [(V2 z (y-20), pi/2)] + , _rmInLinks = [(V2 z (y-20), pi/2)] , _rmPath = [] , _rmPmnts = [mntLS iShape (V2 x x) (V3 (x-20) (x-20) 70)] , _rmBound = map (expandPolyCorners 10) ps diff --git a/src/Dodge/Room/CheckConsistency.hs b/src/Dodge/Room/CheckConsistency.hs index d76fa9224..bae7f9f22 100644 --- a/src/Dodge/Room/CheckConsistency.hs +++ b/src/Dodge/Room/CheckConsistency.hs @@ -6,7 +6,7 @@ import Dodge.Graph linksOnPath :: Room -> Bool linksOnPath r = all pointOnPath linkPoints where - linkPoints = map fst $ _rmLinks r + linkPoints = map fst $ _rmOutLinks r ++ _rmInLinks r pointOnPath p = elem p $ concatMap flat2 $ _rmPath r flat2 (x,y) = [x,y] diff --git a/src/Dodge/Room/Corridor.hs b/src/Dodge/Room/Corridor.hs index b65cf0d44..a985e3c4c 100644 --- a/src/Dodge/Room/Corridor.hs +++ b/src/Dodge/Room/Corridor.hs @@ -16,7 +16,8 @@ import Data.Bifunctor corridor :: Room corridor = defaultRoom { _rmPolys = [poly] - , _rmLinks = lnks + , _rmOutLinks = init lnks + , _rmInLinks = [last lnks] , _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks , _rmPmnts = [ spanLightI (V2 0 40) (V2 40 40) ] , _rmBound = [ rectNSWE 50 30 0 40 ] @@ -47,7 +48,8 @@ corridorN :: Room corridorN = defaultRoom { _rmPolys = [rectNSWE 80 0 0 40 ] - , _rmLinks = lnks + , _rmOutLinks = init lnks + , _rmInLinks = [last lnks] , _rmPath = pth , _rmPmnts = [] , _rmBound = [ rectNSWE 50 30 0 40 ] @@ -60,7 +62,8 @@ corridorWallN :: Room corridorWallN = defaultRoom { _rmPolys = [rectNSWE 70 0 0 40 ] - , _rmLinks = lnks + , _rmOutLinks = init lnks + , _rmInLinks = [last lnks] , _rmPath = pth , _rmPmnts = [] , _rmBound = [ rectNSWE 50 30 0 40 ] @@ -75,7 +78,8 @@ tEast = defaultRoom { _rmPolys = [rectNSWE 80 0 (-20) 20 ,rectNSWE 80 40 (-40) 40 ] - , _rmLinks = lnks + , _rmOutLinks = init lnks + , _rmInLinks = [last lnks] , _rmPath = concatMap (doublePair . (,) (V2 0 60) . fst) lnks , _rmPmnts = [] , _rmBound = [ rectNSWE 70 10 0 40 ] @@ -91,7 +95,8 @@ tWest = defaultRoom { _rmPolys = [rectNSWE 80 0 (-20) 20 ,rectNSWE 80 40 (-40) 40 ] - , _rmLinks = lnks + , _rmOutLinks = init lnks + , _rmInLinks = [last lnks] , _rmPath = concatMap (doublePair . (,) (V2 0 60) . fst) lnks , _rmPmnts = [] , _rmBound = [ rectNSWE 70 10 0 40 ] diff --git a/src/Dodge/Room/Door.hs b/src/Dodge/Room/Door.hs index 4a3001aec..a64aacec2 100644 --- a/src/Dodge/Room/Door.hs +++ b/src/Dodge/Room/Door.hs @@ -15,7 +15,8 @@ import Control.Lens door :: Room door = defaultRoom { _rmPolys = [rectNSWE 40 0 0 40] - , _rmLinks = lnks + , _rmOutLinks = init lnks + , _rmInLinks = [last lnks] , _rmPath = [(V2 20 35,V2 20 5)] -- door extends into side walls (for shadows as rendered 12/03) , _rmPmnts = [putAutoDoor (V2 0 20) (V2 40 20)] @@ -29,7 +30,8 @@ door = defaultRoom switchDoorRoom :: Room switchDoorRoom = defaultRoom { _rmPolys = [rectNSWE 40 0 0 40] - , _rmLinks = lnks + , _rmOutLinks = init lnks + , _rmInLinks = [last lnks] , _rmPath = [(V2 20 35,V2 20 5)] , _rmPartPmnt = Just f -- door extends into side walls (for shadows as rendered 12/03) diff --git a/src/Dodge/Room/Link.hs b/src/Dodge/Room/Link.hs index 22991c614..187a8f875 100644 --- a/src/Dodge/Room/Link.hs +++ b/src/Dodge/Room/Link.hs @@ -33,56 +33,60 @@ import Data.List {- Shuffle the initial links of a room randomly. -} randomiseOutLinks :: RandomGen g => Room -> State g Room randomiseOutLinks r = do - newLinks <- shuffle $ init $ _rmLinks r - return $ r {_rmLinks = newLinks ++ [last $ _rmLinks r]} + newLinks <- shuffle $ _rmOutLinks r + return $ r {_rmOutLinks = newLinks } sortOutLinksOn :: Ord b => ((Point2,Float) -> b) -> Room -> Room -sortOutLinksOn f = rmLinks %~ dosort - where - dosort [] = [] - dosort xs = sortOn f (init xs) ++ [last xs] +sortOutLinksOn f = rmOutLinks %~ sortOn f filterSortOutLinksOn :: Ord b => ((Point2,Float) -> Bool) -> ((Point2,Float) -> b) -> Room -> Room -filterSortOutLinksOn test f = rmLinks %~ dosort +filterSortOutLinksOn test f = rmOutLinks %~ dosort where dosort [] = [] - dosort xs = let (ys,zs) = partition test (init xs) - in sortOn f ys ++ zs ++ [last xs] + dosort xs = let (ys,zs) = partition test xs + in sortOn f ys ++ zs {- Shuffle all links of a room randomly. -} randomiseAllLinks :: RandomGen g => Room -> State g Room randomiseAllLinks r = do - newLinks <- shuffle $ _rmLinks r - return $ r {_rmLinks = newLinks} + newLinks <- shuffle $ _rmOutLinks r ++ _rmInLinks r + return $ r {_rmOutLinks = tail newLinks + , _rmInLinks = [head newLinks] + } randomiseLinksBy :: ( [(Point2,Float)] -> State g [(Point2,Float)] ) -> Room -> State g Room randomiseLinksBy f r = do - newLinks <- f $ _rmLinks r - return $ r {_rmLinks = newLinks} + newLinks <- f $ _rmOutLinks r ++ _rmInLinks r + return $ r {_rmOutLinks = init newLinks + , _rmInLinks = [last newLinks] + } +-- TODO rename to filterOutLinks filterLinks :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room filterLinks cond r = do - newLinks <- shuffle $ filter cond $ init $ _rmLinks r - return $ r {_rmLinks = newLinks ++ [last $ _rmLinks r]} + newLinks <- shuffle $ filter cond $ _rmOutLinks r + return $ r {_rmOutLinks = newLinks} {- | Swaps the first link in the list with one that satisfies a given property. - Does not change the last link in the list -} changeLinkFrom :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room changeLinkFrom cond r = do - let (possibleLnks,otherLnks) = partition cond . init $ _rmLinks r + let (possibleLnks,otherLnks) = partition cond $ _rmOutLinks r newLnks <- shuffle possibleLnks - return $ r {_rmLinks = newLnks ++ otherLnks ++ [last $ _rmLinks r]} + return $ r {_rmOutLinks = newLnks ++ otherLnks} {- | Swaps the last link in the list with one that satisfies a given - property (it might swap with itself). Unsafe. - Be careful about calling this after changeLinkFrom. -} changeLinkTo :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room changeLinkTo cond r = do - l <- takeOne $ filter cond $ _rmLinks r - let newLinks = delete l (_rmLinks r) ++ [l] - return $ r {_rmLinks = newLinks} -{- | Move a room so that the last link in '_rmLinks' lines up to + let alllinks = _rmOutLinks r ++ _rmInLinks r + l <- takeOne $ filter cond alllinks + let newLinks = delete l alllinks + return $ r { _rmOutLinks = newLinks + ,_rmInLinks = [l]} +{- | Move a room so that the first link in '_rmInLinks' lines up to an external point and direction. This is intended to work when the external point is an outgoing link from another room. -} @@ -93,7 +97,7 @@ shiftRoomToLink l r $ shiftRoomBy (V2 0 0 -.- p , 0) r where - (p,a) = last $ _rmLinks r + (p,a) = head $ _rmInLinks r doRoomShift :: Room -> Room doRoomShift rm = shiftRoomBy (_rmShift rm) rm & rmShift .~ _rmShift rm @@ -101,7 +105,8 @@ doRoomShift rm = shiftRoomBy (_rmShift rm) rm & rmShift .~ _rmShift rm shiftRoomBy :: (Point2,Float) -> Room -> Room shiftRoomBy shift r = r & rmPolys %~ fmap (map (shiftPointBy shift)) - & rmLinks %~ fmap (shiftLinkBy shift) + & rmOutLinks %~ fmap (shiftLinkBy shift) + & rmInLinks %~ fmap (shiftLinkBy shift) & rmPath %~ map (shiftPathBy shift) & rmBound %~ fmap (map (shiftPointBy shift)) & rmShift %~ shiftLinkBy shift @@ -118,7 +123,7 @@ shiftRoomShiftToLink l r $ shiftRoomShiftBy (V2 0 0 -.- p , 0) r where - (p,a) = last $ _rmLinks r + (p,a) = head $ _rmInLinks r -- NOTE placements, when placed, will be shifted by the value _rmShift shiftRoomShiftBy :: (Point2,Float) -> Room -> Room shiftRoomShiftBy shift r = r @@ -137,10 +142,12 @@ shiftPathBy shiftPathBy s (p1,p2) = (shiftPointBy s p1, shiftPointBy s p2) finalLinksUpdate :: Room -> Room -finalLinksUpdate rm = case _rmLinks rm of +finalLinksUpdate rm = case _rmInLinks rm of (_:_) -> rm - & rmLinks %~ init - & rmPos %~ ( (uncurry UsedInLink (last thelnks) :) . (map (uncurry UnusedLink) (init thelnks) ++) ) + & rmInLinks %~ tail + & rmPos %~ ( (uncurry UsedInLink (head inlnks) :) + . (map (uncurry UnusedLink) (outlnks ++ tail inlnks) ++) ) _ -> rm where - thelnks = _rmLinks rm + inlnks = _rmInLinks rm + outlnks = _rmOutLinks rm diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index f992ac9c3..a8529012d 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -32,11 +32,10 @@ twinSlowDoorRoom -> Room twinSlowDoorRoom w h x = defaultRoom { _rmPolys = ps - , _rmLinks = + , _rmOutLinks = [ (V2 w (h/2) , negate $ pi/2) - , (V2 (-w) (h/2) , pi/2) - , (V2 0 (-h), pi) - ] + , (V2 (-w) (h/2) , pi/2) ] + , _rmInLinks = [ (V2 0 (-h), pi) ] , _rmPath = [] , _rmPmnts = [ pContID (PS (V2 0 (h-5)) pi) ( PutButton $ makeButton col id) diff --git a/src/Dodge/Room/NoNeedWeapon.hs b/src/Dodge/Room/NoNeedWeapon.hs index 7d05b1754..f1f40b3ef 100644 --- a/src/Dodge/Room/NoNeedWeapon.hs +++ b/src/Dodge/Room/NoNeedWeapon.hs @@ -34,4 +34,4 @@ centerVaultExplosiveExit = do ,sPS (V2 0 0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll) ] r <- centerVaultRoom 120 120 50 <&> rmPmnts %~ (extraPS ++) - randomiseLinksBy shuffleTail r <&> rmLinks %~ take 2 + randomiseLinksBy shuffleTail r <&> rmOutLinks %~ take 2 diff --git a/src/Dodge/Room/Path.hs b/src/Dodge/Room/Path.hs index 029f575bd..2232d8675 100644 --- a/src/Dodge/Room/Path.hs +++ b/src/Dodge/Room/Path.hs @@ -18,7 +18,7 @@ import qualified Control.Foldl as L createPathGrid :: Room -> Room createPathGrid rm = rm - { _rmPath = linksAndPath (_rmLinks rm) filterGrid } + { _rmPath = linksAndPath (_rmOutLinks rm ++ _rmInLinks rm) filterGrid } where filterGrid = filter (\p -> pairInPolys (_rmPolys rm) p && testCrossWalls outerWalls p) grid grid = fromMaybe [] $ shiftedGrid <$> minx <*> maxx <*> miny <*> maxy diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index 3dd8305cb..3e5639513 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -46,7 +46,8 @@ roomRect -> Room roomRect x y xn yn = defaultRoom { _rmPolys = [rectNSWE y 0 0 x ] - , _rmLinks = lnks + , _rmOutLinks = init lnks + , _rmInLinks = [last lnks] , _rmPath = concatMap doublePair pth , _rmPmnts = [] , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)] @@ -78,11 +79,13 @@ roomRectAutoLinks x y = (roomRect x y xn yn) yn = max 1 $ (ceiling y - 40) `div` 60 plmnts = [mntLightLnkCond unusedLnkToPS ] {- Combines two rooms into one room. + - will have to work out exactly what to do with combining links Mostly involves concatenation. -} combineRooms :: Room -> Room -> Room combineRooms r r' = defaultRoom { _rmPolys = _rmPolys r ++ _rmPolys r' - , _rmLinks = _rmLinks r ++ _rmLinks r' + , _rmOutLinks = _rmOutLinks r ++ _rmOutLinks r' + , _rmInLinks = _rmInLinks r ++ _rmInLinks r' , _rmPath = map clampPath $ _rmPath r ++ _rmPath r' , _rmPmnts = map (shiftPlacement $ _rmShift r) (_rmPmnts r) @@ -119,7 +122,8 @@ quarterRoomFlat w = do ] pure $ defaultRoom { _rmPolys = [ [V2 0 0,V2 w w,V2 (-w) w] ] - , _rmLinks = [(V2 0 w, 0)] + , _rmOutLinks = [(V2 0 w, 0)] + , _rmInLinks = [(V2 0 w, 0)] , _rmPath = concatMap doublePair [(V2 0 w,V2 0 (w-20)) ,(V2 0 (w-20),V2 (w-20) (w-20)) @@ -153,7 +157,11 @@ fourthCornerWall w = do ] pure $ defaultRoom { _rmPolys = [ map toV2 [(0,0),(w,w),(0,2*w),(-w,w)] ] - , _rmLinks = + , _rmOutLinks = + [(V2 (w/2) (3*w/2), negate $ pi/4) + ,(V2 (negate $ w/2) (3*w/2), pi/4) + ] + , _rmInLinks = [(V2 (w/2) (3*w/2), negate $ pi/4) ,(V2 (negate $ w/2) (3*w/2), pi/4) ] @@ -216,11 +224,11 @@ centerVaultRoom centerVaultRoom w h d = do return $ defaultRoom { _rmPolys = [rectNSWE h (-h) (-w) w] - , _rmLinks = + , _rmOutLinks = [(V2 0 h , 0 ) ,(V2 w 0 ,-pi/2) - ,(V2 (-w) 0 , pi/2) - ,(V2 0 (-h), pi ) + ,(V2 (-w) 0 , pi/2) ] + , _rmInLinks = [(V2 0 (-h), pi ) ] , _rmPath = [] , _rmPmnts = diff --git a/src/Dodge/Room/RoadBlock.hs b/src/Dodge/Room/RoadBlock.hs index 23ae17b28..9f18c7430 100644 --- a/src/Dodge/Room/RoadBlock.hs +++ b/src/Dodge/Room/RoadBlock.hs @@ -31,9 +31,8 @@ litCorridor90 = do poly2 = rectNSWE (h-60) (h-100) (-60) 5 pure $ defaultRoom { _rmPolys = [poly,poly2] - , _rmLinks = [ (V2 40 (h - 80), -pi/2) - , (V2 20 0 , pi ) - ] + , _rmOutLinks = [ (V2 40 (h - 80), -pi/2)] + , _rmInLinks = [ (V2 20 0 , pi ) ] , _rmPath = concatMap doublePair [( V2 20 0 , V2 20 (h-40) ) ,( V2 0 (h-40) , V2 20 (h-40) ) @@ -95,7 +94,8 @@ lasTunnel :: Room lasTunnel = defaultRoom { _rmPolys = polys , _rmBound = polys - , _rmLinks = [(V2 20 190,1.5* pi),(V2 0 20,0.5* pi)] + , _rmOutLinks = [(V2 20 190,1.5* pi)] + , _rmInLinks = [(V2 0 20,0.5* pi)] , _rmPmnts = [putLasTurret 0.005 & plSpot .~ PS (V2 10 240) (1.5*pi) , midWall (rectNSEW 65 40 0 25) , mntLS vShape (V2 50 10) (V3 40 20 50) diff --git a/src/Dodge/Room/Room.hs b/src/Dodge/Room/Room.hs index 7326e764b..e119394ac 100644 --- a/src/Dodge/Room/Room.hs +++ b/src/Dodge/Room/Room.hs @@ -48,11 +48,13 @@ roomC w h = do roomPadCut :: [Point2] -> Point2 -> Room roomPadCut ps p = defaultRoom { _rmPolys = [ps] - , _rmLinks = [(p,0),(V2 0 0,pi)] + , _rmOutLinks = [(p,0)] + , _rmInLinks = [(V2 0 0,pi)] , _rmPath = [(V2 0 0,p)] } roomPillars :: Room -roomPillars = over rmLinks init $ set rmPmnts plmnts $ roomRect 240 240 2 2 +roomPillars = --over rmLinks init $ -- it is unclear to me the purpose of this: perhaps to get the in link in the center? + set rmPmnts plmnts $ roomRect 240 240 2 2 where plmnts = spanLightI (V2 120 24) (V2 120 216) : mntLS vShape (V2 12 12) (V3 25 25 70) @@ -199,7 +201,8 @@ roomCenterPillar = changeLinkTo ((\p -> dist p (V2 120 0) < 10) . fst) roomOctogon :: Room roomOctogon = defaultRoom { _rmPolys = [poly ] - , _rmLinks = lnks + , _rmOutLinks = init lnks + , _rmInLinks = [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)] ] @@ -221,7 +224,8 @@ roomOctogon = defaultRoom roomNgon :: Int -> Float -> Room roomNgon n x = defaultRoom { _rmPolys = [poly] - , _rmLinks = lnks + , _rmOutLinks = init lnks + , _rmInLinks = [last lnks] , _rmPath = [] -- TODO , _rmPmnts = [] , _rmBound = [poly] @@ -301,7 +305,7 @@ weaponBehindPillar = do rcp <- roomCenterPillar return $ treeFromTrunk [PassDown corridor - ,PassDown $ over rmLinks tail $ over rmPmnts (++ plmnts1) rcp + ,PassDown $ over rmOutLinks tail $ over rmPmnts (++ plmnts1) rcp ] (singleUseAll $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN) @@ -343,7 +347,8 @@ deadEndRoom :: Room deadEndRoom = defaultRoom { _rmPolys = [rectNSWE 40 (-20) (-20) 20 ] - , _rmLinks = lnks + , _rmOutLinks = init lnks + , _rmInLinks = [last lnks] , _rmPath = [] , _rmPmnts = [sPS (V2 0 (-10)) 0 putLamp] , _rmBound = [rectNSWE 20 (-20) (-30) 30] diff --git a/src/Dodge/Room/RunPast.hs b/src/Dodge/Room/RunPast.hs index aa611e3a3..67eadaed8 100644 --- a/src/Dodge/Room/RunPast.hs +++ b/src/Dodge/Room/RunPast.hs @@ -70,7 +70,7 @@ runPastRoom i = do ,_rmPmnts = [] } switchdoor = switchDoorRoom & rmTakeFrom ?~ i - n = length $ filter theedgetest $ _rmLinks cenroom + n = length $ filter theedgetest $ _rmOutLinks cenroom controom = treeFromPost [PassDown switchdoor,PassDown linkcor] (UseAll door) critrooms :: [SubCompTree Room] critrooms = treeFromPost [PassDown switchdoor] (PassDown critroom) : diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index 09b363621..59299b2bf 100644 --- a/src/Dodge/Room/Start.hs +++ b/src/Dodge/Room/Start.hs @@ -5,6 +5,7 @@ import Dodge.Room.RunPast import Dodge.Room.LasTurret import Dodge.Data import Dodge.Default +import Dodge.RoomLink import Dodge.Tree import Dodge.RandomHelp import Dodge.Room.Door @@ -98,7 +99,7 @@ rezColor = do } rezInvBox :: LightSource -> Room -rezInvBox = (rmLinks %~ reverse) . rezBox +rezInvBox = swapInOutLinks . rezBox crAdd :: Room -> Room crAdd = rmPmnts %~ (sPS (V2 20 10) (0.5*pi) randC1 :) @@ -134,7 +135,7 @@ rezBoxesWpCrit = do centralRoom <- filterSortOutLinksOn bottomEdgeTest ((\(V2 a b) -> (b,a)) . fst) <$> (randomiseOutLinks =<< changeLinkTo bottomPassDownTest ((roomRectAutoLinks w h) {_rmPmnts = []})) - let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom + let n = length $ filter bottomEdgeTest $ _rmOutLinks centralRoom i <- state $ randomR (0,n-3) j <- state $ randomR (i,n-2) blcor <- blockedCorridor' @@ -161,7 +162,7 @@ rezBoxesWp = do centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest ((roomRectAutoLinks w h) {_rmPmnts = []}) blcor <- blockedCorridor' - let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom + let n = length $ filter bottomEdgeTest $ _rmOutLinks centralRoom let rezrooms = map adddoor $ wpAdd theweapon aroom : replicate (n-2) aroom centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom @@ -182,7 +183,7 @@ rezBoxes = do dbox = treeFromPost [PassDown door] (PassDown $ rezInvBox thecol) centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest ((roomRectAutoLinks w h) {_rmPmnts = []}) - let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom + let n = length $ filter bottomEdgeTest $ _rmOutLinks centralRoom centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom return $ treeFromTrunk [PassDown $ rezBox thecol , PassDown door diff --git a/src/Dodge/Room/Treasure.hs b/src/Dodge/Room/Treasure.hs index 0a1e5afe5..a84b15c87 100644 --- a/src/Dodge/Room/Treasure.hs +++ b/src/Dodge/Room/Treasure.hs @@ -25,7 +25,8 @@ triLootRoom w h = pure $ defaultRoom { _rmPolys = [ tri , base ] - , _rmLinks = [(V2 0 (-80) , pi)] + , _rmOutLinks = [] + , _rmInLinks = [(V2 0 (-80) , pi)] , _rmPath = doublePair (V2 0 (-80) , V2 0 (h/2)) , _rmPmnts = [sPS (V2 (15-w) 15 ) 0 $ PutID 0 diff --git a/src/Dodge/Tree/Shift.hs b/src/Dodge/Tree/Shift.hs index 36a96ee8f..659b65267 100644 --- a/src/Dodge/Tree/Shift.hs +++ b/src/Dodge/Tree/Shift.hs @@ -34,7 +34,7 @@ posRms bounds (parent,_) _ [] st = case st of -> fmap (finalLinksUpdate parent:) <$> posRms bounds childi 0 ts tseq posRms bounds parenti numChild (t@(Node childi _):ts) tseq = do printInfo parenti numChild childi - tryLinks (0::Int) (init $ _rmLinks parent) + tryLinks (0::Int) (_rmOutLinks parent) where parent = fst parenti tryLinks _ [] = putStrLn "all links tried" >> return Nothing @@ -53,7 +53,7 @@ posRms bounds parenti numChild (t@(Node childi _):ts) tseq = do where convexBounds = map pointsToPoly $ _rmBound r' clipping = or (convexPolysOverlap <$> convexBounds <*> bounds) - upr rm = doLnkEff l $ rm & rmLinks %~ delete l & rmPos %~ (uncurry (UsedOutLink numChild) l :) + upr rm = doLnkEff l $ rm & rmOutLinks %~ delete l & rmPos %~ (uncurry (UsedOutLink numChild) l :) l' = shiftLinkBy (_rmShift parent) l r' = doRoomShift . fst $ rootLabel shiftedt shiftedt = applyToRoot (first $ shiftRoomShiftToLink l') t