From 86f363c2f91c74e0dd7bac5eb3b6a5a4be6fa128 Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 23 Nov 2021 21:48:01 +0000 Subject: [PATCH] Cleanup --- src/Dodge/Debug/LinkDecoration.hs | 2 +- src/Dodge/Default/Room.hs | 3 +- src/Dodge/LevelGen/Data.hs | 11 +++--- src/Dodge/Room/Airlock.hs | 15 +++----- src/Dodge/Room/Boss.hs | 16 ++++----- src/Dodge/Room/CheckConsistency.hs | 2 +- src/Dodge/Room/Corridor.hs | 28 +++++++-------- src/Dodge/Room/Door.hs | 6 ++-- src/Dodge/Room/Link.hs | 57 +++++++++++++++--------------- src/Dodge/Room/LongDoor.hs | 4 +-- src/Dodge/Room/NoNeedWeapon.hs | 4 +-- src/Dodge/Room/Path.hs | 2 +- src/Dodge/Room/Procedural.hs | 21 ++++------- src/Dodge/Room/RoadBlock.hs | 6 ++-- src/Dodge/Room/Room.hs | 15 ++++---- src/Dodge/Room/RunPast.hs | 2 +- src/Dodge/Room/Start.hs | 6 ++-- src/Dodge/Room/Treasure.hs | 3 +- src/Dodge/Tree/Shift.hs | 12 +++---- 19 files changed, 93 insertions(+), 122 deletions(-) diff --git a/src/Dodge/Debug/LinkDecoration.hs b/src/Dodge/Debug/LinkDecoration.hs index f6f4617b9..c2567a651 100644 --- a/src/Dodge/Debug/LinkDecoration.hs +++ b/src/Dodge/Debug/LinkDecoration.hs @@ -23,7 +23,7 @@ addRoomLinkDecorations rms w = w & decorations %~ IM.insertWithNewKeys (map roomLinkDecorations rms) roomLinkDecorations :: Room -> Picture -roomLinkDecorations rm = pictures . map linkDecoration $ map lnkPosDir $ _rmOutLinks rm ++ _rmInLinks rm +roomLinkDecorations rm = pictures . map linkDecoration $ map lnkPosDir $ _rmLinks 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 f5c848324..0882f5762 100644 --- a/src/Dodge/Default/Room.hs +++ b/src/Dodge/Default/Room.hs @@ -7,9 +7,8 @@ import qualified Data.IntMap.Strict as IM defaultRoom :: Room defaultRoom = Room { _rmPolys = [] - , _rmOutLinks = [] + , _rmLinks = [] , _rmLinkEff = [] - , _rmInLinks = [] , _rmPos = [] , _rmPath = [] , _rmPmnts = [] diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index a0e597f9a..2fdbcf9f5 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -53,19 +53,18 @@ data Placement = Placement | RandomPlacement {_unRandomPlacement :: State StdGen Placement} -{- -The '_rmPolys' list states which polygons should be cut out to form the indestructible walls of the room. +{- The '_rmPolys' lists 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; 0 is for links going to another room to the north, pi/2 for links going to a room to the west, etc. TODO : Explain path, does it need both directions? Placement spots allow things to be put in the room during level generation. Room bounds between a new room and previously placed rooms are checked during level generation, -assigning no bounds will allow rooms to overlap. - -} +assigning no bounds will allow rooms to overlap. -} data Room = Room { _rmPolys :: [ [Point2] ] - , _rmOutLinks :: [RoomLink] - , _rmInLinks :: [RoomLink] + , _rmLinks :: [RoomLink] + --, _rmOutLinks :: [RoomLink] + --, _rmInLinks :: [RoomLink] -- 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 a7526b02b..4deb19320 100644 --- a/src/Dodge/Room/Airlock.hs +++ b/src/Dodge/Room/Airlock.hs @@ -24,8 +24,7 @@ airlock = takeOne [airlock0,airlock90,airlockCrystal,airlockZ] airlock0 :: Room airlock0 = defaultRoom { _rmPolys = [ rectNSWE 100 0 0 40 , rectNSWE 65 35 (-40) 20 ] - , _rmOutLinks = muout lnks - , _rmInLinks = muin [last lnks] + , _rmLinks = muout lnks ++ muin [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) @@ -47,8 +46,7 @@ airlockSimple :: Room airlockSimple = defaultRoom { _rmPolys = [ rectNSWE 120 0 0 180 ] - , _rmOutLinks = map (uncurry outLink) $init lnks - , _rmInLinks = [uncurry inLink $ last lnks] + , _rmLinks = map (uncurry outLink) (init lnks) ++ [uncurry inLink $ last lnks] , _rmPath = concatMap (doublePair. (V2 90 30,) . fst) lnks , _rmPmnts = [pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red id id) @@ -71,8 +69,7 @@ airlockZ :: Room airlockZ = defaultRoom { _rmPolys = [ rectNSWE 120 0 0 180 ] - , _rmOutLinks = muout[(V2 0 30,pi/2)] - , _rmInLinks = muin[(V2 180 30,1.5*pi) ] + , _rmLinks = muout[(V2 0 30,pi/2)] ++ muin[(V2 180 30,1.5*pi) ] , _rmPath = [] -- [(V2 0 40,V2 40 0) -- ,(V2 40 0,V2 0 40) @@ -109,8 +106,7 @@ airlock90 = defaultRoom , (100,10) ] ] - , _rmOutLinks = muout[(V2 0 40,pi/2)] - , _rmInLinks = muin[(V2 40 0,pi) ] + , _rmLinks = muout[(V2 0 40,pi/2)] ++ muin[(V2 40 0,pi) ] , _rmPath = [(V2 0 40,V2 40 0) ,(V2 40 0,V2 0 40) @@ -142,8 +138,7 @@ airlockCrystal = defaultRoom [ rectNSWE 140 0 0 40 , orderPolygon $ map toV2 [ (39,20) , (150,60) , (150,80) , (39,120) ] ] - , _rmOutLinks = muout[(V2 20 130,0) ] - , _rmInLinks = muin[(V2 20 0 ,pi) ] + , _rmLinks = muout[(V2 20 130,0) ] ++ muin[(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 d4b188a6b..ab4894961 100644 --- a/src/Dodge/Room/Boss.hs +++ b/src/Dodge/Room/Boss.hs @@ -30,8 +30,7 @@ roomGlassOctogon x = createPathGrid $ defaultRoom [rectNSWE x (-x) (-x) x ,rectNSWE 0 (-(x + 40)) (-20) 20 ] - , _rmOutLinks = map (uncurry outLink) $ init lnks - , _rmInLinks = [uncurry inLink $ last lnks] + , _rmLinks = (map (uncurry outLink) $ init lnks) ++ [uncurry inLink $ last lnks] , _rmPath = linksAndPath lnks [ ( V2 0 x , V2 0 (-(x+40))) , ( V2 0 (-(x+40)), V2 0 x) @@ -86,15 +85,16 @@ roomCross x y = defaultRoom { _rmPolys = [rectNSWE y (-y) (-x) x ,rectNSWE (-x) x y (-y) ] - , _rmOutLinks = map (uncurry outLink) + , _rmLinks = map (uncurry outLink) [(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) ] - , _rmInLinks = [uncurry inLink $ (V2 (y-20) (-x),pi) + ,(V2 (20-y) (-x),pi) + ] ++ + [uncurry inLink $ (V2 (y-20) (-x),pi) ] , _rmPath = [] , _rmPmnts = @@ -121,8 +121,7 @@ roomShuriken x y = ] ] corner = defaultRoom { _rmPolys = ps - , _rmOutLinks = [uncurry outLink (V2 (x-1) (y-20),negate $ pi/2)] - , _rmInLinks = [uncurry inLink (V2 (x-1) (y-20),negate $ pi/2)] + , _rmLinks = [toBothLnk (V2 (x-1) (y-20),negate $ pi/2)] , _rmPath = [] , _rmPmnts = [mntLS iShape (V2 x x) (V3 (x-20) x 70)] , _rmBound = ps @@ -147,8 +146,7 @@ roomTwistCross x y z = ] corner = defaultRoom { _rmPolys = ps - , _rmOutLinks = [toBothLnk (V2 z (y-20), pi/2)] - , _rmInLinks = [toBothLnk (V2 z (y-20), pi/2)] + , _rmLinks = [toBothLnk (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 d73081911..aa4b4bcd4 100644 --- a/src/Dodge/Room/CheckConsistency.hs +++ b/src/Dodge/Room/CheckConsistency.hs @@ -7,7 +7,7 @@ import Dodge.RoomLink linksOnPath :: Room -> Bool linksOnPath r = all pointOnPath linkPoints where - linkPoints = map (fst . lnkPosDir) $ _rmOutLinks r ++ _rmInLinks r + linkPoints = map (fst . lnkPosDir) $ _rmLinks 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 55c230b43..4c14497d5 100644 --- a/src/Dodge/Room/Corridor.hs +++ b/src/Dodge/Room/Corridor.hs @@ -17,8 +17,7 @@ import Tile corridor :: Room corridor = defaultRoom { _rmPolys = [poly] - , _rmOutLinks = init lnks' - , _rmInLinks = [last lnks'] + , _rmLinks = lnks' , _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks , _rmPmnts = [ spanLightI (V2 0 40) (V2 40 40) ] , _rmBound = [ rectNSWE 50 30 0 40 ] @@ -55,8 +54,7 @@ corridorN :: Room corridorN = defaultRoom { _rmPolys = [rectNSWE 80 0 0 40 ] - , _rmOutLinks = init lnks - , _rmInLinks = [last lnks] + , _rmLinks = lnks , _rmPath = pth , _rmPmnts = [] , _rmBound = [ rectNSWE 50 30 0 40 ] @@ -69,24 +67,23 @@ corridorWallN :: Room corridorWallN = defaultRoom { _rmPolys = [rectNSWE 70 0 0 40 ] - , _rmOutLinks = init lnks - , _rmInLinks = [last lnks] + , _rmLinks = lnks , _rmPath = pth , _rmPmnts = [] , _rmBound = [ rectNSWE 50 30 0 40 ] } - where lnks = [uncurry outLink(V2 20 70 ,0) + where + lnks = [uncurry outLink(V2 20 70 ,0) ,uncurry inLink(V2 20 10 ,pi) ] - pth = doublePair (V2 20 70,V2 20 10) + pth = doublePair (V2 20 70,V2 20 10) tEast :: Room tEast = defaultRoom { _rmPolys = [rectNSWE 80 0 (-20) 20 ,rectNSWE 80 40 (-40) 40 ] - , _rmOutLinks = init lnks' - , _rmInLinks = [last lnks'] + , _rmLinks = lnks' , _rmPath = concatMap (doublePair . (,) (V2 0 60) . fst) lnks , _rmPmnts = [] , _rmBound = [ rectNSWE 70 10 0 40 ] @@ -107,15 +104,14 @@ tWest = defaultRoom { _rmPolys = [rectNSWE 80 0 (-20) 20 ,rectNSWE 80 40 (-40) 40 ] - , _rmOutLinks = map (uncurry outLink) $ init lnks - , _rmInLinks = [uncurry inLink $ last lnks] - , _rmPath = concatMap (doublePair . (,) (V2 0 60) . fst) lnks + , _rmLinks = lnks + , _rmPath = concatMap (doublePair . (,) (V2 0 60) . fst) $ map lnkPosDir lnks , _rmPmnts = [] , _rmBound = [ rectNSWE 70 10 0 40 ] } where lnks = - [(V2 (-30) (60),pi/2) - ,(V2 ( 30) (60),-pi/2) - ,(V2 (0) (10),pi) + [outLink (V2 (-30) (60)) (pi/2) + ,outLink (V2 ( 30) (60)) (-pi/2) + ,inLink (V2 (0) (10)) pi ] diff --git a/src/Dodge/Room/Door.hs b/src/Dodge/Room/Door.hs index d42d20d3d..2bef11880 100644 --- a/src/Dodge/Room/Door.hs +++ b/src/Dodge/Room/Door.hs @@ -16,8 +16,7 @@ import Control.Lens door :: Room door = defaultRoom { _rmPolys = [rectNSWE 40 0 0 40] - , _rmOutLinks = init lnks - , _rmInLinks = [last lnks] + , _rmLinks = init lnks ++ [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)] @@ -31,8 +30,7 @@ door = defaultRoom switchDoorRoom :: Room switchDoorRoom = defaultRoom { _rmPolys = [rectNSWE 40 0 0 40] - , _rmOutLinks = init lnks - , _rmInLinks = [last lnks] + , _rmLinks = init lnks++ [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 d4ad3433f..605e8e46c 100644 --- a/src/Dodge/Room/Link.hs +++ b/src/Dodge/Room/Link.hs @@ -19,7 +19,7 @@ module Dodge.Room.Link , randomiseOutLinks -- , randomiseLinksBy , invShiftLinkBy - , finalLinksUpdate + --, finalLinksUpdate ) where import Dodge.Placement.PlaceSpot import Dodge.LevelGen.Data @@ -32,11 +32,13 @@ import System.Random import Control.Monad.State import Control.Lens import Data.List +import qualified Data.Set as S {- Shuffle the initial links of a room randomly. -} randomiseOutLinks :: RandomGen g => Room -> State g Room randomiseOutLinks r = do - newLinks <- shuffle $ _rmOutLinks r - return $ r {_rmOutLinks = newLinks } + let (outs,xs) = partition (S.member OutLink . _rlType) $ _rmLinks r + newLinks <- shuffle outs + return $ r {_rmLinks = newLinks ++ xs } sortOutLinksOn :: Ord b => ((Point2,Float) -> b) -> Room -> Room sortOutLinksOn f = overLnkType OutLink $ sortOn (f . lnkPosDir) @@ -48,13 +50,12 @@ filterSortOutLinksOn test f = overLnkType OutLink dosort dosort xs = let (ys,zs) = partition (test . lnkPosDir) xs in sortOn (f . lnkPosDir) ys ++ zs -{- Shuffle all links of a room randomly. -} +{- Shuffle the order of all links of a room randomly. + - Note this does not change their types. -} randomiseAllLinks :: RandomGen g => Room -> State g Room randomiseAllLinks r = do - newLinks <- shuffle $ _rmOutLinks r ++ _rmInLinks r - return $ r {_rmOutLinks = tail newLinks - , _rmInLinks = [head newLinks] - } + newLinks <- shuffle $ _rmLinks r + return $ r {_rmLinks = newLinks } --randomiseLinksBy -- :: ( [(Point2,Float)] -> State g [(Point2,Float)] ) @@ -66,28 +67,29 @@ randomiseAllLinks r = do -- , _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 . lnkPosDir) $ _rmOutLinks r - return $ r {_rmOutLinks = newLinks} + newLinks <- shuffle $ filter (cond . lnkPosDir) $ _rmLinks r + return $ r {_rmLinks = newLinks} {- | Swaps the first link in the list with one that satisfies a given property. - Does not change the last link in the list -} +-- TODO replace all instances of this with something more sensible changeLinkFrom :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room changeLinkFrom cond r = do - let (possibleLnks,otherLnks) = partition (cond . lnkPosDir) $ _rmOutLinks r + let (possibleLnks,otherLnks) = partition (cond . lnkPosDir) $ _rmLinks r newLnks <- shuffle possibleLnks - return $ r {_rmOutLinks = newLnks ++ otherLnks} + return $ r {_rmLinks = 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. -} +-- TODO replace with something more sensible changeLinkTo :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room changeLinkTo cond r = do - let alllinks = _rmOutLinks r ++ _rmInLinks r + let alllinks = _rmLinks r l <- takeOne $ filter (cond . lnkPosDir) alllinks + let l' = l & rlType .~ S.singleton InLink let newLinks = delete l alllinks - return $ r { _rmOutLinks = newLinks - ,_rmInLinks = [l]} + return $ r & rmLinks .~ (l':newLinks) {- | 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. @@ -108,8 +110,7 @@ doRoomShift rm = shiftRoomBy (_rmShift rm) rm & rmShift .~ _rmShift rm shiftRoomBy :: (Point2,Float) -> Room -> Room shiftRoomBy shift r = r & rmPolys %~ fmap (map (shiftPointBy shift)) - & rmOutLinks %~ fmap (shiftLinkBy shift) - & rmInLinks %~ fmap (shiftLinkBy shift) + & rmLinks %~ fmap (shiftLinkBy shift) & rmPath %~ map (shiftPathBy shift) & rmBound %~ fmap (map (shiftPointBy shift)) & rmShift %~ shiftPosDirBy shift @@ -158,13 +159,13 @@ shiftPathBy -> (Point2,Point2) shiftPathBy s (p1,p2) = (shiftPointBy s p1, shiftPointBy s p2) -finalLinksUpdate :: Room -> Room -finalLinksUpdate rm = case _rmInLinks rm of - (_:_) -> rm - & rmInLinks %~ tail - & rmPos %~ ( (uncurry (UsedInLink 0) (lnkPosDir $ head inlnks) :) - . (map (uncurry UnusedLink . lnkPosDir) (outlnks ++ tail inlnks) ++) ) - _ -> rm - where - inlnks = _rmInLinks rm - outlnks = _rmOutLinks rm +--finalLinksUpdate :: Room -> Room +--finalLinksUpdate rm = case _rmInLinks rm of +-- (_:_) -> rm +-- & rmInLinks %~ tail +-- & rmPos %~ ( (uncurry (UsedInLink 0) (lnkPosDir $ head inlnks) :) +-- . (map (uncurry UnusedLink . lnkPosDir) (outlnks ++ tail inlnks) ++) ) +-- _ -> rm +-- where +-- inlnks = _rmInLinks rm +-- outlnks = _rmOutLinks rm diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index f087847ff..7ea33d894 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -33,10 +33,10 @@ twinSlowDoorRoom -> Room twinSlowDoorRoom w h x = defaultRoom { _rmPolys = ps - , _rmOutLinks = map (uncurry outLink) + , _rmLinks = map (uncurry outLink) [ (V2 w (h/2) , negate $ pi/2) , (V2 (-w) (h/2) , pi/2) ] - , _rmInLinks = [uncurry inLink (V2 0 (-h), pi) ] + ++ [uncurry inLink (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 1e86b3fc5..93cfb9717 100644 --- a/src/Dodge/Room/NoNeedWeapon.hs +++ b/src/Dodge/Room/NoNeedWeapon.hs @@ -33,6 +33,6 @@ centerVaultExplosiveExit = do ,sPS (V2 0 120) 0 $ PutCrit explosiveBarrel ,sPS (V2 0 0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll) ] - r <- centerVaultRoom 120 120 50 <&> rmPmnts %~ (extraPS ++) + centerVaultRoom 120 120 50 <&> rmPmnts %~ (extraPS ++) + --r <- centerVaultRoom 120 120 50 <&> rmPmnts %~ (extraPS ++) --randomiseLinksBy shuffleTail r <&> rmOutLinks %~ take 2 - return $ r & rmOutLinks %~ take 2 diff --git a/src/Dodge/Room/Path.hs b/src/Dodge/Room/Path.hs index 480484c9b..ef36a163d 100644 --- a/src/Dodge/Room/Path.hs +++ b/src/Dodge/Room/Path.hs @@ -20,7 +20,7 @@ import qualified Control.Foldl as L createPathGrid :: Room -> Room createPathGrid rm = rm - { _rmPath = linksAndPath (map lnkPosDir $ _rmOutLinks rm ++ _rmInLinks rm) filterGrid } + { _rmPath = linksAndPath (map lnkPosDir $ _rmLinks 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 88a98c027..19a765d24 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -47,8 +47,7 @@ roomRect -> Room roomRect x y xn yn = defaultRoom { _rmPolys = [rectNSWE y 0 0 x ] - , _rmOutLinks = init lnks - , _rmInLinks = [last lnks] + , _rmLinks = init lnks ++ [last lnks] , _rmPath = concatMap doublePair pth , _rmPmnts = [] , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)] @@ -85,8 +84,7 @@ Mostly involves concatenation. -} combineRooms :: Room -> Room -> Room combineRooms r r' = defaultRoom { _rmPolys = _rmPolys r ++ _rmPolys r' - , _rmOutLinks = _rmOutLinks r ++ _rmOutLinks r' - , _rmInLinks = _rmInLinks r ++ _rmInLinks r' + , _rmLinks = _rmLinks r ++ _rmLinks r' , _rmPath = map clampPath $ _rmPath r ++ _rmPath r' , _rmPmnts = map (shiftPlacement $ _rmShift r) (_rmPmnts r) @@ -123,8 +121,7 @@ quarterRoomFlat w = do ] pure $ defaultRoom { _rmPolys = [ [V2 0 0,V2 w w,V2 (-w) w] ] - , _rmOutLinks = [toBothLnk (V2 0 w, 0)] - , _rmInLinks = [toBothLnk (V2 0 w, 0)] + , _rmLinks = [toBothLnk (V2 0 w, 0)] , _rmPath = concatMap doublePair [(V2 0 w,V2 0 (w-20)) ,(V2 0 (w-20),V2 (w-20) (w-20)) @@ -158,11 +155,7 @@ fourthCornerWall w = do ] pure $ defaultRoom { _rmPolys = [ map toV2 [(0,0),(w,w),(0,2*w),(-w,w)] ] - , _rmOutLinks = - [toBothLnk (V2 (w/2) (3*w/2), negate $ pi/4) - ,toBothLnk (V2 (negate $ w/2) (3*w/2), pi/4) - ] - , _rmInLinks = + , _rmLinks = [toBothLnk (V2 (w/2) (3*w/2), negate $ pi/4) ,toBothLnk (V2 (negate $ w/2) (3*w/2), pi/4) ] @@ -225,11 +218,11 @@ centerVaultRoom centerVaultRoom w h d = do return $ defaultRoom { _rmPolys = [rectNSWE h (-h) (-w) w] - , _rmOutLinks = + , _rmLinks = [outLink (V2 0 h) 0 ,outLink (V2 w 0) (-pi/2) - ,outLink (V2 (-w) 0) (pi/2) ] - , _rmInLinks = [inLink (V2 0 (-h)) pi ] + ,outLink (V2 (-w) 0) (pi/2) + , inLink (V2 0 (-h)) pi ] , _rmPath = [] , _rmPmnts = [sps0 $ PutWall (rectNSEW d (d - 30) d (d - 30)) defaultWall diff --git a/src/Dodge/Room/RoadBlock.hs b/src/Dodge/Room/RoadBlock.hs index b77b6d659..ea26466e1 100644 --- a/src/Dodge/Room/RoadBlock.hs +++ b/src/Dodge/Room/RoadBlock.hs @@ -32,8 +32,7 @@ litCorridor90 = do poly2 = rectNSWE (h-60) (h-100) (-60) 5 pure $ defaultRoom { _rmPolys = [poly,poly2] - , _rmOutLinks = [uncurry outLink (V2 40 (h - 80), -pi/2)] - , _rmInLinks = [uncurry inLink (V2 20 0 , pi ) ] + , _rmLinks = [uncurry outLink (V2 40 (h - 80), -pi/2)] ++ [uncurry inLink (V2 20 0 , pi ) ] , _rmPath = concatMap doublePair [( V2 20 0 , V2 20 (h-40) ) ,( V2 0 (h-40) , V2 20 (h-40) ) @@ -95,8 +94,7 @@ lasTunnel :: Room lasTunnel = defaultRoom { _rmPolys = polys , _rmBound = polys - , _rmOutLinks = [uncurry outLink(V2 20 190,1.5* pi)] - , _rmInLinks = [uncurry inLink(V2 0 20,0.5* pi)] + , _rmLinks = [uncurry outLink(V2 20 190,1.5* pi)] ++ [uncurry inLink(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 a3f94e943..3989c0aec 100644 --- a/src/Dodge/Room/Room.hs +++ b/src/Dodge/Room/Room.hs @@ -49,8 +49,7 @@ roomC w h = do roomPadCut :: [Point2] -> Point2 -> Room roomPadCut ps p = defaultRoom { _rmPolys = [ps] - , _rmOutLinks = muout [(p,0)] - , _rmInLinks = muin [(V2 0 0,pi)] + , _rmLinks = muout [(p,0)] ++ muin [(V2 0 0,pi)] , _rmPath = [(V2 0 0,p)] } roomPillars :: Room @@ -202,8 +201,7 @@ roomCenterPillar = changeLinkTo ((\p -> dist p (V2 120 0) < 10) . fst) roomOctogon :: Room roomOctogon = defaultRoom { _rmPolys = [poly ] - , _rmOutLinks = muout $ init lnks - , _rmInLinks = muin [last lnks] + , _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)] ] @@ -225,8 +223,7 @@ roomOctogon = defaultRoom roomNgon :: Int -> Float -> Room roomNgon n x = defaultRoom { _rmPolys = [poly] - , _rmOutLinks = muout $init lnks - , _rmInLinks = muin[last lnks] + , _rmLinks = muout (init lnks) ++ muin[last lnks] , _rmPath = [] -- TODO , _rmPmnts = [] , _rmBound = [poly] @@ -306,7 +303,8 @@ weaponBehindPillar = do rcp <- roomCenterPillar return $ treeFromTrunk [PassDown corridor - ,PassDown $ over rmOutLinks tail $ over rmPmnts (++ plmnts1) rcp + --,PassDown $ over rmOutLinks tail $ over rmPmnts (++ plmnts1) rcp + ,PassDown $ over rmPmnts (++ plmnts1) rcp ] (singleUseAll $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN) @@ -348,8 +346,7 @@ deadEndRoom :: Room deadEndRoom = defaultRoom { _rmPolys = [rectNSWE 40 (-20) (-20) 20 ] - , _rmOutLinks = muout $init lnks - , _rmInLinks = muin $[last lnks] + , _rmLinks = muout (init lnks) ++ muin [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 2d4aeb5c2..6cb650a84 100644 --- a/src/Dodge/Room/RunPast.hs +++ b/src/Dodge/Room/RunPast.hs @@ -71,7 +71,7 @@ runPastRoom i = do ,_rmPmnts = [] } switchdoor = switchDoorRoom & rmTakeFrom ?~ i - n = length $ filter theedgetest $ map lnkPosDir $ _rmOutLinks cenroom + n = length $ filter theedgetest $ map lnkPosDir $ _rmLinks 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 7faa463ef..dd0dfaf31 100644 --- a/src/Dodge/Room/Start.hs +++ b/src/Dodge/Room/Start.hs @@ -136,7 +136,7 @@ rezBoxesWpCrit = do centralRoom <- filterSortOutLinksOn bottomEdgeTest ((\(V2 a b) -> (b,a)) . fst) <$> (randomiseOutLinks =<< changeLinkTo bottomPassDownTest ((roomRectAutoLinks w h) {_rmPmnts = []})) - let n = length $ filter bottomEdgeTest $ map lnkPosDir $ _rmOutLinks centralRoom + let n = length $ filter bottomEdgeTest $ map lnkPosDir $ _rmLinks centralRoom i <- state $ randomR (0,n-3) j <- state $ randomR (i,n-2) blcor <- blockedCorridor' @@ -163,7 +163,7 @@ rezBoxesWp = do centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest ((roomRectAutoLinks w h) {_rmPmnts = []}) blcor <- blockedCorridor' - let n = length $ filter bottomEdgeTest $ map lnkPosDir $_rmOutLinks centralRoom + let n = length $ filter bottomEdgeTest $ map lnkPosDir $_rmLinks centralRoom let rezrooms = map adddoor $ wpAdd theweapon aroom : replicate (n-2) aroom centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom @@ -184,7 +184,7 @@ rezBoxes = do dbox = treeFromPost [PassDown door] (PassDown $ rezInvBox thecol) centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest ((roomRectAutoLinks w h) {_rmPmnts = []}) - let n = length $ filter bottomEdgeTest $ map lnkPosDir $_rmOutLinks centralRoom + let n = length $ filter bottomEdgeTest $ map lnkPosDir $_rmLinks 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 1fe45488a..b3171c1d7 100644 --- a/src/Dodge/Room/Treasure.hs +++ b/src/Dodge/Room/Treasure.hs @@ -26,8 +26,7 @@ triLootRoom w h = pure $ defaultRoom { _rmPolys = [ tri , base ] - , _rmOutLinks = [] - , _rmInLinks = [uncurry inLink(V2 0 (-80) , pi)] + , _rmLinks = [uncurry inLink(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 c14183583..d4025b5df 100644 --- a/src/Dodge/Tree/Shift.hs +++ b/src/Dodge/Tree/Shift.hs @@ -35,11 +35,11 @@ posRms bounds (parent,_) _ [] st = case st of -> fmap (parent:) <$> posRms bounds childi 0 ts tseq posRms bounds parenti@(parent,_) numChild (t@(Node childi _):ts) tseq = do printInfoCheckNum parenti numChild childi - tryParentLinks (0::Int) (_rmOutLinks parent) + tryParentLinks (0::Int) (rmOutLinks parent) where tryParentLinks _ [] = putStrLn "no viable link pairs, backtrack" >> return Nothing tryParentLinks j (l:ls) = do - tryChildLinks (0::Int) (_rmInLinks $ fst childi) + tryChildLinks (0::Int) (rmInLinks $ fst childi) where tryChildLinks _ [] = tryParentLinks (j+1) ls tryChildLinks numinlink (il:ils) @@ -55,14 +55,12 @@ posRms bounds parenti@(parent,_) numChild (t@(Node childi _):ts) tseq = do where convexBounds = map pointsToPoly $ _rmBound r' clipping = or (convexPolysOverlap <$> convexBounds <*> bounds) - updateparent rm = doLnkEff (lnkPosDir l) $ rm & rmOutLinks %~ delete l & rmPos %~ (uncurry (UsedOutLink numChild) (lnkPosDir l) :) + updateparent rm = doLnkEff (lnkPosDir l) $ rm & rmLinks %~ delete l & rmPos %~ (uncurry (UsedOutLink numChild) (lnkPosDir l) :) l' = shiftLinkBy (_rmShift parent) l r' = doRoomShift . fst $ rootLabel shiftedt - updatechild rm = rm & rmInLinks %~ delete il + updatechild rm = rm & rmLinks %~ delete il & rmPos %~ ( (uncurry (UsedInLink 0) (lnkPosDir il):) - . (map (uncurry UnusedLink . lnkPosDir) (_rmOutLinks rm ++ newInLinks) ++) ) - where - newInLinks = delete il $ _rmInLinks rm + . (map (uncurry UnusedLink . lnkPosDir) (delete il (_rmLinks rm)) ++) ) shiftedt = applyToRoot (first $ updatechild . shiftRoomShiftToLink' (lnkPosDir l') (lnkPosDir il)) t printColumns :: [Int] -> [String] -> IO ()