justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup

Browse Source
This commit is contained in:
justin
2021-11-23 21:48:01 +00:00
parent b7d6eeaa84
commit 86f363c2f9
19 changed files with 93 additions and 122 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Debug/LinkDecoration.hs
+1 -1
View File
@@ -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)]
src/Dodge/Default/Room.hs
+1 -2
View File
@@ -7,9 +7,8 @@ import qualified Data.IntMap.Strict as IM
defaultRoom :: Room
defaultRoom = Room
{ _rmPolys = []
, _rmOutLinks = []
, _rmLinks = []
, _rmLinkEff = []
, _rmInLinks = []
, _rmPos = []
, _rmPath = []
, _rmPmnts = []
src/Dodge/LevelGen/Data.hs
+5 -6
View File
@@ -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]
src/Dodge/Room/Airlock.hs
+5 -10
View File
@@ -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)
src/Dodge/Room/Boss.hs
+7 -9
View File
@@ -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
src/Dodge/Room/CheckConsistency.hs
+1 -1
View File
@@ -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]
src/Dodge/Room/Corridor.hs
+12 -16
View File
@@ -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
]
src/Dodge/Room/Door.hs
+2 -4
View File
@@ -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)
src/Dodge/Room/Link.hs
+29 -28
View File
@@ -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
src/Dodge/Room/LongDoor.hs
+2 -2
View File
@@ -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)
src/Dodge/Room/NoNeedWeapon.hs
+2 -2
View File
@@ -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
src/Dodge/Room/Path.hs
+1 -1
View File
@@ -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
src/Dodge/Room/Procedural.hs
+7 -14
View File
@@ -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
src/Dodge/Room/RoadBlock.hs
+2 -4
View File
@@ -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)
src/Dodge/Room/Room.hs
+6 -9
View File
@@ -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]
src/Dodge/Room/RunPast.hs
+1 -1
View File
@@ -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) :
src/Dodge/Room/Start.hs
+3 -3
View File
@@ -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
src/Dodge/Room/Treasure.hs
+1 -2
View File
@@ -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
src/Dodge/Tree/Shift.hs
+5 -7
View File
@@ -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 ()