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

Add support for group placements

Browse Source
This commit is contained in:
justin
2021-05-14 19:46:52 +02:00
parent 0b26761be5
commit 2b09bf2072
18 changed files with 307 additions and 266 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room.hs
+89 -89
View File
@@ -77,9 +77,9 @@ roomPadCut ps p = Room
roomPillars :: Room
roomPillars = over rmLinks init $ set rmPS plmnts $ roomRect 240 240 2 2
where
plmnts = PS (120,120) 0 putLamp
: PS (12,12) 0 putLamp
: PS (228,228) 0 putLamp
plmnts = sPS (120,120) 0 putLamp
: sPS (12,12) 0 putLamp
: sPS (228,228) 0 putLamp
: g 180 150 90 60
f a x b y = putBlockRect a x b y
g a b c d = f a b a b ++ f a b c d ++ f c d a b ++ f c d c d
@@ -103,7 +103,7 @@ glassSwitchBack = do
,blockLine (wth-wllen, 2*hf) ( wth,2*hf)
,blockLine ( 0, 3*hf) (wllen,3*hf)
,blockLine (wth-wllen, 4*hf) ( wth,4*hf)
, PS (wth/2,hgt/2) 0 $ putLamp
, sPS (wth/2,hgt/2) 0 $ putLamp
]
return $ set rmPS plmnts $ roomRect wth hgt 2 6
@@ -119,14 +119,14 @@ glassLesson = do
$ roomRect 200 200 1 1
topRoom = set rmPS topplmnts
$ roomRect 200 200 1 1
botplmnts = [PS (0,0) 0 $ PutWall (rectNSWE (200) 0 (90) (110))
botplmnts = [sPS (0,0) 0 $ PutWall (rectNSWE (200) 0 (90) (110))
$ defaultCrystalWall
,PS (50,100) 0 $ PutCrit miniGunCrit
,PS (50,50) 0 putLamp
,sPS (50,100) 0 $ PutCrit miniGunCrit
,sPS (50,50) 0 putLamp
]
topplmnts = [windowLine (100,200) (100,0)
,PS (50,100) 0 $ PutCrit miniGunCrit
,PS (50,50) 0 putLamp
,sPS (50,100) 0 $ PutCrit miniGunCrit
,sPS (50,50) 0 putLamp
]
miniRoom1 :: RandomGen g => State g Room
@@ -144,9 +144,9 @@ miniRoom1 = do
,windowLine (wth-wllen,40+2*hf) (60,40+2*hf)
,windowLine (wth-60, 40+3*hf) (wllen,40+3*hf)
,windowLine (wth-wllen,40+4*hf) (60,40+4*hf)
,PS (crx,cry) 0 $ PutCrit miniGunCrit
,PS (wth-20,hgt/2+40) 0 $ randC
,PS (wth/2,hgt/2) 0 putLamp
,sPS (crx,cry) 0 $ PutCrit miniGunCrit
,sPS (wth-20,hgt/2+40) 0 $ randC
,sPS (wth/2,hgt/2) 0 putLamp
,blockLine ( 0, 40+1*hf) (wllen,40+1*hf)
,blockLine (wth-wllen, 40+2*hf) ( wth,40+2*hf)
,blockLine ( 0, 40+3*hf) (wllen,40+3*hf)
@@ -169,24 +169,24 @@ miniRoom3 = do
,( 10,-80)
,(-10,-80)
]
let plmnts = [PS cp 0 $ PutCrit miniGunCrit
,PS cp 0 $ windowLineType (0,-40) (0,-80)
,PS cp (1*pi/4) $ windowLineType (0,-40) (0,-80)
,PS cp (2*pi/4) $ windowLineType (0,-40) (0,-80)
,PS cp (3*pi/4) $ windowLineType (0,-40) (0,-80)
,PS cp (4*pi/4) $ windowLineType (0,-40) (0,-80)
,PS cp (5*pi/4) $ windowLineType (0,-40) (0,-80)
,PS cp (6*pi/4) $ windowLineType (0,-40) (0,-80)
,PS cp (7*pi/4) $ windowLineType (0,-40) (0,-80)
,PS cp (pi/8) b
,PS cp (pi/8+1*pi/4) b
,PS cp (pi/8+2*pi/4) b
,PS cp (pi/8+3*pi/4) b
,PS cp (pi/8+4*pi/4) b
,PS cp (pi/8+5*pi/4) b
,PS cp (pi/8+6*pi/4) b
,PS cp (pi/8+7*pi/4) b
,PS (w/2,h/2) 0 putLamp
let plmnts = [sPS cp 0 $ PutCrit miniGunCrit
,sPS cp 0 $ windowLineType (0,-40) (0,-80)
,sPS cp (1*pi/4) $ windowLineType (0,-40) (0,-80)
,sPS cp (2*pi/4) $ windowLineType (0,-40) (0,-80)
,sPS cp (3*pi/4) $ windowLineType (0,-40) (0,-80)
,sPS cp (4*pi/4) $ windowLineType (0,-40) (0,-80)
,sPS cp (5*pi/4) $ windowLineType (0,-40) (0,-80)
,sPS cp (6*pi/4) $ windowLineType (0,-40) (0,-80)
,sPS cp (7*pi/4) $ windowLineType (0,-40) (0,-80)
,sPS cp (pi/8) b
,sPS cp (pi/8+1*pi/4) b
,sPS cp (pi/8+2*pi/4) b
,sPS cp (pi/8+3*pi/4) b
,sPS cp (pi/8+4*pi/4) b
,sPS cp (pi/8+5*pi/4) b
,sPS cp (pi/8+6*pi/4) b
,sPS cp (pi/8+7*pi/4) b
,sPS (w/2,h/2) 0 putLamp
]
fmap connectRoom $ randomiseOutLinks $ set rmPS plmnts $ roomRectAutoLinks w h
@@ -215,8 +215,8 @@ roomCenterPillar = changeLinkTo ((\p -> dist p (120,0) < 10) . fst)
plmnts =
[ blockLine (115,115) (115,125)
, blockLine (125,115) (125,125)
, PS (40,120) 0 putLamp
, PS (200,120) 0 putLamp
, sPS (40,120) 0 putLamp
, sPS (200,120) 0 putLamp
]
roomOctogon :: Room
@@ -264,10 +264,10 @@ weaponEmptyRoom :: RandomGen g => State g (Tree (Either Room Room))
weaponEmptyRoom = do
w <- state $ randomR (220,300)
h <- state $ randomR (220,300)
let plmnts = [PS (w/2,h-40) 0 $ RandPS randFirstWeapon
,PS (20,20) (pi/2) $ randC1
,PS (w-20,20) (pi/2) $ randC1
,PS (w/2,h/2) 0 $ putLamp
let plmnts = [sPS (w/2,h-40) 0 $ RandPS randFirstWeapon
,sPS (20,20) (pi/2) $ randC1
,sPS (w-20,20) (pi/2) $ randC1
,sPS (w/2,h/2) 0 $ putLamp
]
(fmap connectRoom . randomiseOutLinks) =<< (changeLinkTo ((\p -> dist p (w/2,0) < 10) . fst)
$ set rmPS plmnts $ roomRect w h 2 2)
@@ -275,14 +275,14 @@ weaponEmptyRoom = do
weaponUnderCrits :: RandomGen g => State g (Tree (Either Room Room))
weaponUnderCrits = do
let plmnts =
[PS (20,0) 0 $ RandPS randFirstWeapon
,PS (20,0) (0-pi/2) $ randC1
,PS (20,20) (0-pi/2) $ randC1
[sPS (20,0) 0 $ RandPS randFirstWeapon
,sPS (20,0) (0-pi/2) $ randC1
,sPS (20,20) (0-pi/2) $ randC1
]
let continuationRoom = treeFromTrunk [Left corridorN,Left corridorN]
(connectRoom (set rmPS plmnts $ corridorN))
rcp' <- roomCenterPillar
let rcp = over rmPS ( PS (120,80) 0 putLamp : ) rcp'
let rcp = over rmPS ( sPS (120,80) 0 putLamp : ) rcp'
deadEndRoom <- takeOne [roomPillars,rcp]
junctionRoom <- takeOne [Left tEast,Left tWest]
return $ treeFromTrunk [Left corridorN,Left corridorN]
@@ -295,13 +295,13 @@ weaponBehindPillar :: RandomGen g => State g (Tree (Either Room Room))
weaponBehindPillar = do
crPos <- takeOne $ [(x,y) | x <- [20,220], y <- [20,220]] ++ [(120,160),(120,200)]
let d p = argV $ (120,80) -.- p
let plmnts1 = [PS (120,160) 0 $ RandPS randFirstWeapon
,PS crPos (d crPos) $ randC1
let plmnts1 = [sPS (120,160) 0 $ RandPS randFirstWeapon
,sPS crPos (d crPos) $ randC1
]
rcp <- roomCenterPillar
return $ treeFromTrunk [Left door
,Left $ over rmLinks tail $ over rmPS (++ plmnts1) rcp]
(connectRoom $ set rmPS [PS (20,60) (0-pi/2) $ randC1]
(connectRoom $ set rmPS [sPS (20,60) (0-pi/2) $ randC1]
$ corridorN)
weaponBetweenPillars :: RandomGen g => State g (Tree (Either Room Room))
@@ -312,9 +312,9 @@ weaponBetweenPillars = do
crPos2 = ps !! 1
d p = argV $ (120,120) -.- p
plmnts =
[PS wpPos 0 $ RandPS randFirstWeapon
,PS crPos1 (d crPos1) $ randC1
,PS crPos2 (d crPos2) $ randC1
[sPS wpPos 0 $ RandPS randFirstWeapon
,sPS crPos1 (d crPos1) $ randC1
,sPS crPos2 (d crPos2) $ randC1
]
(fmap connectRoom . randomiseOutLinks) =<< (filterLinks f $ over rmPS (++plmnts) $ roomPillars)
where
@@ -324,23 +324,23 @@ weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room))
weaponLongCorridor = do
root <- takeOne $ [tEast, tWest]
connectingRoom <- takeOne
[tEast & rmPS .~ [PS (-40,60) 0 $ putLamp]
,tWest & rmPS .~ [PS ( 40,60) 0 $ putLamp]
[tEast & rmPS .~ [sPS (-40,60) 0 $ putLamp]
,tWest & rmPS .~ [sPS ( 40,60) 0 $ putLamp]
]
i1 <- state $ randomR (2,5)
i2 <- state $ randomR (2,5)
let branch1 = treeFromTrunk (replicate i1 $ Left corridorN) (connectRoom $ putCrs connectingRoom)
let branch2 = treeFromTrunk (replicate i2 $ Left corridorN) (deadRoom $ putWp corridor)
return $ Node (Left root) [branch1,branch2]
where putCrs = over rmPS (++ [PS (10,40) (-pi/2) $ randC
,PS (-10,40) (-pi/2) $ randC
where putCrs = over rmPS (++ [sPS (10,40) (-pi/2) $ randC
,sPS (-10,40) (-pi/2) $ randC
])
putWp = set rmPS [PS (20,40) 0 $ RandPS randFirstWeapon
,PS (20,60) 0 $ putLamp
putWp = set rmPS [sPS (20,40) 0 $ RandPS randFirstWeapon
,sPS (20,60) 0 $ putLamp
]
critInDeadEnd :: Room
critInDeadEnd = set rmPS [PS (0,0) 0 $ randC] deadEndRoom
critInDeadEnd = set rmPS [sPS (0,0) 0 $ randC] deadEndRoom
deadEndRoom :: Room
deadEndRoom = Room
@@ -348,7 +348,7 @@ deadEndRoom = Room
]
, _rmLinks = lnks
, _rmPath = []
, _rmPS = [PS (0,-10) 0 putLamp]
, _rmPS = [sPS (0,-10) 0 putLamp]
, _rmBound = [rectNSWE 20 (-20) (-30) 30]
}
where
@@ -366,9 +366,9 @@ weaponRoom = join $ takeOne
roomCCrits :: RandomGen g => State g (Tree (Either Room Room))
roomCCrits = do
ps <- sequence $ replicate 20 $ randInCirc 9
let plmnts = map (\p -> PS p 0 $ randC)
let plmnts = map (\p -> sPS p 0 $ randC)
$ zipWith (+.+) [(x,y) | x<-[110,130,150,170,190], y<- [70,90,110,130,150]] ps
lamps = [PS (50,100) 0 putLamp , PS (175,100) 0 putLamp]
lamps = [sPS (50,100) 0 putLamp , sPS (175,100) 0 putLamp]
return $ connectRoom $ over rmPS ((lamps ++) . (plmnts ++)) $ roomC 200 200
@@ -377,25 +377,25 @@ longRoom = do
h <- state $ randomR (1500,1500)
let w = 75
let cond x = (snd . fst) x < h - 40
let ws = map (\ps -> PS (0,0) 0 $ PutWall ps defaultCrystalWall)
let ws = map (\ps -> sPS (0,0) 0 $ PutWall ps defaultCrystalWall)
[rectNSWE (h-35) (h-135) (-10) 10
,rectNSWE (h-35) (h-135) 15 35
,rectNSWE (h-35) (h-135) 40 60
,rectNSWE (h-35) (h-135) 65 85
]
let wsDefense = map (\ps -> PS (0,0) 0 $ PutWall ps defaultCrystalWall)
let wsDefense = map (\ps -> sPS (0,0) 0 $ PutWall ps defaultCrystalWall)
[rectNSWE (95) (70) 0 25
,rectNSWE (95) (70) 50 75
]
brls <- fmap (map (\p -> PS (p +.+ (10,200)) 0 $ PutCrit explosiveBarrel) )
brls <- fmap (map (\p -> sPS (p +.+ (10,200)) 0 $ PutCrit explosiveBarrel) )
$ sequence $ replicate 5 $ randInRect (w-20) 900
let rm = roomRect w (h+70) 1 1 & rmPolys %~ ([rectNSWE h (h-165) (-45) (w+45)] ++)
changeLinkTo cond $ set rmPS (ws ++ brls ++ wsDefense ++
[PS ( 12.5,h-25) 0 $ PutCrit longCrit
,PS ( 37.5,h-25) 0 $ PutCrit longCrit
,PS ( 62.5,h-25) 0 $ PutCrit longCrit
,PS ( 25, 20) 0 $ putLamp
,PS ( 25, h-10) 0 $ putLamp
[sPS ( 12.5,h-25) 0 $ PutCrit longCrit
,sPS ( 37.5,h-25) 0 $ PutCrit longCrit
,sPS ( 62.5,h-25) 0 $ PutCrit longCrit
,sPS ( 25, 20) 0 $ putLamp
,sPS ( 25, h-10) 0 $ putLamp
]
)
$ rm
@@ -406,12 +406,12 @@ shooterRoom = do
h <- state $ randomR (200,300)
let cond x = (snd . fst) x < h - 40
changeLinkTo cond $ set rmPS ( [blockLine (50,50) (50,h)
,PS ( 25,h-25) 0 $ PutCrit $ addArmour autoCrit
,PS ( 75,h-30) 0 $ PutCrit explosiveBarrel
,PS ( 75,h-60) 0 $ PutCrit explosiveBarrel
,PS ( 85,h-10) 0 $ PutCrit explosiveBarrel
,PS ( 85,h-45) 0 $ PutCrit explosiveBarrel
,PS ( 75,h-80) 0 putLamp
,sPS ( 25,h-25) 0 $ PutCrit $ addArmour autoCrit
,sPS ( 75,h-30) 0 $ PutCrit explosiveBarrel
,sPS ( 75,h-60) 0 $ PutCrit explosiveBarrel
,sPS ( 85,h-10) 0 $ PutCrit explosiveBarrel
,sPS ( 85,h-45) 0 $ PutCrit explosiveBarrel
,sPS ( 75,h-80) 0 putLamp
]
)
$ roomRect 100 h 1 1
@@ -432,8 +432,8 @@ shootersRoom1 = do
let bln x y = putBlockN (x+25) (x-25) (y+10) y
let blv x y = putBlockV (x+25) (x-25) (y+10) y
let plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4
++ [PS p (-pi/2) $ PutCrit autoCrit
,PS (w/2,200) 0 putLamp
++ [sPS p (-pi/2) $ PutCrit autoCrit
,sPS (w/2,200) 0 putLamp
]
return $ set rmPS plmnts $ roomRectAutoLinks w 600
@@ -451,10 +451,10 @@ shootersRoom = do
let bln x y = putBlockN (x+25) (x-25) (y+10) y
let blv x y = putBlockV (x+25) (x-25) (y+10) y
let plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4
++ [PS (x1,y1-10) (-pi/2) $ PutCrit autoCrit
,PS (x2,y2-10) (-pi/2) $ PutCrit autoCrit
,PS (x3,y3-10) (-pi/2) $ PutCrit autoCrit
,PS (w/2,200) 0 putLamp
++ [sPS (x1,y1-10) (-pi/2) $ PutCrit autoCrit
,sPS (x2,y2-10) (-pi/2) $ PutCrit autoCrit
,sPS (x3,y3-10) (-pi/2) $ PutCrit autoCrit
,sPS (w/2,200) 0 putLamp
]
return $ set rmPS plmnts $ roomRectAutoLinks w 600
@@ -480,16 +480,16 @@ pistolerRoom = do
aa <- state $ randomR (0,2*pi)
ab <- state $ randomR (0,2*pi)
ac <- state $ randomR (0,2*pi)
let plmnts = [PS (ps !! 0) aa $ PutCrit pistolCrit
,PS (ps !! 1) ab $ PutCrit pistolCrit
,PS (ps !! 2) ac $ PutCrit pistolCrit
,PS (w/2,h-50) 0 putLamp
,PS (w/2,50) 0 putLamp
,PS (w-5,h-5) 0 putLamp
,PS (5,h-5) 0 putLamp
,PS (w-5,5) 0 putLamp
,PS (5,5) 0 putLamp
,PS (w/2,h/2) 0 putLamp
let plmnts = [sPS (ps !! 0) aa $ PutCrit pistolCrit
,sPS (ps !! 1) ab $ PutCrit pistolCrit
,sPS (ps !! 2) ac $ PutCrit pistolCrit
,sPS (w/2,h-50) 0 putLamp
,sPS (w/2,50) 0 putLamp
,sPS (w-5,h-5) 0 putLamp
,sPS (5,h-5) 0 putLamp
,sPS (w-5,5) 0 putLamp
,sPS (5,5) 0 putLamp
,sPS (w/2,h/2) 0 putLamp
]
++
concat [f x y | x<-xs,y<-ys]
@@ -515,13 +515,13 @@ spawnerRoom :: RandomGen g => State g (Tree (Either Room Room))
spawnerRoom = do
x <- state $ randomR (250,300)
y <- state $ randomR (300,400)
wl <- takeOne [PS (0,0) 0 $ PutWall (rectNSWE (y-60) 0 (x/2-10) (x/2+10))
wl <- takeOne [sPS (0,0) 0 $ PutWall (rectNSWE (y-60) 0 (x/2-10) (x/2+10))
defaultCrystalWall
,windowLine (x/2,0) (x/2,y-60)
]
let plmnts = [PS (x/4, y/4) (pi/2) $ PutCrit spawnerCrit
let plmnts = [sPS (x/4, y/4) (pi/2) $ PutCrit spawnerCrit
,wl
,PS (x/2, y-10) 0 putLamp
,sPS (x/2, y-10) 0 putLamp
]
let f ((lx,_),_) = lx < x/2-5
roomWithSpawner <- (fmap connectRoom . randomiseOutLinks) =<< filterLinks f (set rmPS plmnts $ roomRect x y 2 2)