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

Move main to allow for new executables

Browse Source
This commit is contained in:
justin
2021-08-11 17:54:48 +02:00
parent b74bb45a4c
commit 4bbe5d0cf1
64 changed files with 521 additions and 345 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room.hs
+52 -52
View File
@@ -51,7 +51,7 @@ roomC x y = defaultRoom
{ _rmPolys = [rectNSWE y 0 0 x]
, _rmLinks = lnks
, _rmPath = []
, _rmPS = [windowLine (V2 (x/2) (0)) (V2 (x/2) (y-60))
, _rmPS = [windowLine (V2 (x/2) 0) (V2 (x/2) (y-60))
]
, _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
}
@@ -65,8 +65,8 @@ roomC x y = defaultRoom
roomPadCut :: [Point2] -> Point2 -> Room
roomPadCut ps p = defaultRoom
{ _rmPolys = [ps]
, _rmLinks = [(p,0),((V2 0 0),pi)]
, _rmPath = [((V2 0 0),p)]
, _rmLinks = [(p,0),(V2 0 0,pi)]
, _rmPath = [(V2 0 0,p)]
, _rmPS = []
, _rmBound = []
}
@@ -90,14 +90,14 @@ glassSwitchBack = do
wllen <- state $ randomR (60,wth/2-40)
let hf = hgt/5
let plmnts =
[windowLine (V2 (wth-60 ) ( hf)) (V2 (wllen) (hf) )
,windowLine (V2 (wth-wllen) (2*hf)) (V2 (60 ) (2*hf))
,windowLine (V2 (wth-60 ) (3*hf)) (V2 (wllen) (3*hf))
,windowLine (V2 (wth-wllen) (4*hf)) (V2 (60 ) (4*hf))
,blockLine (V2 ( 0) (1*hf)) (V2 (wllen) (1*hf))
,blockLine (V2 (wth-wllen) (2*hf)) (V2 ( wth) (2*hf))
,blockLine (V2 ( 0) (3*hf)) (V2 (wllen) (3*hf))
,blockLine (V2 (wth-wllen) (4*hf)) (V2 ( wth) (4*hf))
[windowLine (V2 (wth-60 ) hf ) (V2 wllen hf )
,windowLine (V2 (wth-wllen) (2*hf)) (V2 60 (2*hf))
,windowLine (V2 (wth-60 ) (3*hf)) (V2 wllen (3*hf))
,windowLine (V2 (wth-wllen) (4*hf)) (V2 60 (4*hf))
,blockLine (V2 0 (1*hf)) (V2 wllen (1*hf))
,blockLine (V2 (wth-wllen) (2*hf)) (V2 wth (2*hf))
,blockLine (V2 0 (3*hf)) (V2 wllen (3*hf))
,blockLine (V2 (wth-wllen) (4*hf)) (V2 wth (4*hf))
, sPS (V2 (wth/2) (hgt/2)) 0 putLamp
]
return $ set rmPS plmnts $ roomRect wth hgt 2 6
@@ -135,19 +135,19 @@ miniRoom1 = do
,50+4*hf,30+5*hf
]
crx <- state $ randomR (wllen,wth-(wllen+40))
let plmnts = [windowLine (V2 (wth-60) ( 40+hf)) (V2 (wllen) (40+hf))
,windowLine (V2 (wth-wllen) (40+2*hf)) (V2 (60) (40+2*hf))
,windowLine (V2 (wth-60) ( 40+3*hf)) (V2 (wllen) (40+3*hf))
,windowLine (V2 (wth-wllen) (40+4*hf)) (V2 (60) (40+4*hf))
let plmnts = [windowLine (V2 (wth-60) ( 40+hf)) (V2 wllen (40+hf))
,windowLine (V2 (wth-wllen) (40+2*hf)) (V2 60 (40+2*hf))
,windowLine (V2 (wth-60) ( 40+3*hf)) (V2 wllen (40+3*hf))
,windowLine (V2 (wth-wllen) (40+4*hf)) (V2 60 (40+4*hf))
,sPS (V2 crx cry) 0 $ PutCrit miniGunCrit
,sPS (V2 (wth-20) (hgt/2+40)) 0 randC1
,sPS (V2 (wth/2) (hgt/2)) 0 putLamp
,blockLine (V2 ( 0) ( 40+1*hf)) (V2 (wllen) (40+1*hf))
,blockLine (V2 (wth-wllen) ( 40+2*hf)) (V2 ( wth) (40+2*hf))
,blockLine (V2 ( 0) ( 40+3*hf)) (V2 (wllen) (40+3*hf))
,blockLine (V2 (wth-wllen) ( 40+4*hf)) (V2 ( wth) (40+4*hf))
,blockLine (V2 0 ( 40+1*hf)) (V2 wllen (40+1*hf))
,blockLine (V2 (wth-wllen) ( 40+2*hf)) (V2 wth (40+2*hf))
,blockLine (V2 0 ( 40+3*hf)) (V2 wllen (40+3*hf))
,blockLine (V2 (wth-wllen) ( 40+4*hf)) (V2 wth (40+4*hf))
]
return $ set rmPS plmnts $ shiftRoomBy ((V2 0 40),0) $ roomRect wth hgt 2 4
return $ set rmPS plmnts $ shiftRoomBy (V2 0 40,0) $ roomRect wth hgt 2 4
miniTree2 :: RandomGen g => State g (Tree (Either Room Room))
miniTree2 = miniRoom1
@@ -159,7 +159,7 @@ miniRoom3 :: RandomGen g => State g (Tree (Either Room Room))
miniRoom3 = do
w <- state $ randomR (300,400)
h <- state $ randomR (300,400)
let cp = (V2 (0) (h/2+40))
let cp = V2 0 (h/2+40)
let b = PutBlock [5,20,20] (greyN 0.5) $ map toV2 [(-10,-60)
,( 10,-60)
,( 10,-80)
@@ -263,11 +263,11 @@ weaponEmptyRoom = do
let plmnts =
[sPS (V2 (w/2) (h-40)) 0 $ RandPS randFirstWeapon
,sPS (V2 20 20) (pi/2) randC1
,sPS (V2 (w-20) (20)) (pi/2) randC1
,sPS (V2 (w-20) 20) (pi/2) randC1
,sPS (V2 (w/2) (h/2)) 0 putLamp
]
(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 rmPS plmnts $ roomRect w h 2 2)
weaponUnderCrits :: RandomGen g => State g (Tree (Either Room Room))
weaponUnderCrits = do
@@ -291,8 +291,8 @@ weaponUnderCrits = do
weaponBehindPillar :: RandomGen g => State g (Tree (Either Room Room))
weaponBehindPillar = do
cpos <- takeOne $ [(V2 x y) | x <- [20,220], y <- [20,220]] ++ [(V2 120 160),(V2 120 200)]
let d p = argV $ (V2 120 80) -.- p
cpos <- takeOne $ [V2 x y | x <- [20,220], y <- [20,220]] ++ [V2 120 160,V2 120 200]
let d p = argV $ V2 120 80 -.- p
let plmnts1 =
[sPS (V2 120 160) 0 $ RandPS randFirstWeapon
,sPS cpos (d cpos) randC1
@@ -306,11 +306,11 @@ weaponBehindPillar = do
weaponBetweenPillars :: RandomGen g => State g (Tree (Either Room Room))
weaponBetweenPillars = do
wpPos <- takeOne [(V2 x y) | x <- [20,120,220], y <- [20,120,220]]
(ps,_) <- takeNMore 2 ([], [(V2 x y) | x <- [20,220], y <- [20,120,220]])
wpPos <- takeOne [V2 x y | x <- [20,120,220], y <- [20,120,220]]
(ps,_) <- takeNMore 2 ([], [V2 x y | x <- [20,220], y <- [20,120,220]])
let crPos1 = ps !! 0
crPos2 = ps !! 1
d p = argV $ (V2 120 120) -.- p
d p = argV $ V2 120 120 -.- p
plmnts =
[sPS wpPos 0 $ RandPS randFirstWeapon
,sPS crPos1 (d crPos1) randC1
@@ -327,7 +327,7 @@ weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room))
weaponLongCorridor = do
root <- takeOne [tEast, tWest]
connectingRoom <- takeOne
[tEast & rmPS .~ [sPS (V2 (-40) (60)) 0 putLamp]
[tEast & rmPS .~ [sPS (V2 (-40) 60) 0 putLamp]
,tWest & rmPS .~ [sPS (V2 40 60) 0 putLamp]
]
i1 <- state $ randomR (2,5)
@@ -336,7 +336,7 @@ 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 ])
putCrs = over rmPS (++ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) 40) (-pi/2) randC1 ])
putWp = set rmPS [sPS (V2 20 40) 0 $ RandPS randFirstWeapon ,sPS (V2 20 60) 0 putLamp ]
critInDeadEnd :: Room
@@ -348,11 +348,11 @@ deadEndRoom = defaultRoom
]
, _rmLinks = lnks
, _rmPath = []
, _rmPS = [sPS (V2 (0) (-10)) 0 putLamp]
, _rmPS = [sPS (V2 0 (-10)) 0 putLamp]
, _rmBound = [rectNSWE 20 (-20) (-30) 30]
}
where
lnks = [((V2 0 30) ,0) ]
lnks = [(V2 0 30 ,0) ]
{- A random Either tree with a weapon and melee monster challenge. -}
weaponRoom :: RandomGen g => State g (Tree (Either Room Room))
weaponRoom = join $ takeOne
@@ -367,7 +367,7 @@ roomCCrits :: RandomGen g => State g (Tree (Either Room Room))
roomCCrits = do
ps <- replicateM 20 $ randInCirc 9
let plmnts = map (\p -> sPS p 0 randC1)
$ zipWith (+.+) [(V2 x y) | x<-[110,130,150,170,190], y<- [70,90,110,130,150]] ps
$ zipWith (+.+) [V2 x y | x<-[110,130,150,170,190], y<- [70,90,110,130,150]] ps
lamps = [sPS (V2 50 100) 0 putLamp , sPS (V2 175 100) 0 putLamp]
return $ connectRoom $ over rmPS ((lamps ++) . (plmnts ++)) $ roomC 200 200
@@ -387,14 +387,14 @@ longRoom = do
[rectNSWE 95 70 0 25
,rectNSWE 95 70 50 75
]
brls <- fmap (map (\p -> sPS (p +.+ (V2 10 200)) 0 $ PutCrit explosiveBarrel) )
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 ++
[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
,sPS (V2 25 ( 20)) 0 putLamp
,sPS (V2 25 20 ) 0 putLamp
,sPS (V2 25 (h-10)) 0 putLamp
]
@@ -423,12 +423,12 @@ shootersRoom1 = do
y3 <- iterateWhile (\y' -> abs (y1 - y2) < 60 && abs (y2 - y') < 60) $ state $ randomR (250,560)
x4 <- state $ randomR (60,w-60)
y4 <- state $ randomR (40,180)
p <- takeOne [(V2 (x1) (y1-10)),(V2 (x2) (y2-10)),(V2 (x3) (y3-10))]
p <- takeOne [V2 x1 (y1-10),V2 x2 (y2-10),V2 x3 (y3-10)]
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
++ [sPS p (-pi/2) $ PutCrit autoCrit
,sPS (V2 (w/2) (200)) 0 putLamp
,sPS (V2 (w/2) 200) 0 putLamp
]
return $ set rmPS plmnts $ roomRectAutoLinks w 600
@@ -446,10 +446,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
++ [sPS (V2 (x1) (y1-10)) (-pi/2) $ PutCrit autoCrit
,sPS (V2 (x2) (y2-10)) (-pi/2) $ PutCrit autoCrit
,sPS (V2 (x3) (y3-10)) (-pi/2) $ PutCrit autoCrit
,sPS (V2 (w/2) (200)) 0 putLamp
++ [sPS (V2 x1 (y1-10)) (-pi/2) $ PutCrit autoCrit
,sPS (V2 x2 (y2-10)) (-pi/2) $ PutCrit autoCrit
,sPS (V2 x3 (y3-10)) (-pi/2) $ PutCrit autoCrit
,sPS (V2 (w/2) 200 ) 0 putLamp
]
return $ set rmPS plmnts $ roomRectAutoLinks w 600
@@ -479,11 +479,11 @@ pistolerRoom = do
,sPS (ps !! 1) ab $ PutCrit pistolCrit
,sPS (ps !! 2) ac $ PutCrit pistolCrit
,sPS (V2 (w/2) (h-50)) 0 putLamp
,sPS (V2 (w/2) (50) ) 0 putLamp
,sPS (V2 (w/2) 50 ) 0 putLamp
,sPS (V2 (w-5) (h-5) ) 0 putLamp
,sPS (V2 ( 5) (h-5) ) 0 putLamp
,sPS (V2 (w-5) (5) ) 0 putLamp
,sPS (V2 ( 5) (5) ) 0 putLamp
,sPS (V2 5 (h-5) ) 0 putLamp
,sPS (V2 (w-5) 5 ) 0 putLamp
,sPS (V2 5 5 ) 0 putLamp
,sPS (V2 (w/2) (h/2) ) 0 putLamp
]
++
@@ -493,11 +493,11 @@ pistolerRoom = do
shootingRange :: RandomGen g => State g (Tree (Either Room Room))
shootingRange = do
rm1 <- shootersRoom1 >>= changeLinkTo (\((V2 _ y),_) -> y < 40)
>>= filterLinks (\((V2 _ y),r) -> y > 200 && r /= 0)
rm2 <- shootersRoom >>= changeLinkTo (\((V2 x y),_) -> y < 10 && x > 20 && x < 180)
>>= filterLinks (\((V2 _ y),r) -> y > 200 && r /= 0)
rm3 <- shootersRoom >>= changeLinkTo (\((V2 x y),_) -> y < 10 && x > 20 && x < 180)
rm1 <- shootersRoom1 >>= changeLinkTo (\(V2 _ y,_) -> y < 40)
>>= filterLinks (\(V2 _ y,r) -> y > 200 && r /= 0)
rm2 <- shootersRoom >>= changeLinkTo (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
>>= filterLinks (\(V2 _ y,r) -> y > 200 && r /= 0)
rm3 <- shootersRoom >>= changeLinkTo (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
>>= filterLinks (\(_,r) -> r == 0)
return $ treeFromPost [Left rm1
,Left $ roomPadCut (rectNSWE 20 (-20) (-80) 80) (V2 0 20)
@@ -512,13 +512,13 @@ spawnerRoom = do
y <- state $ randomR (300,400)
wl <- takeOne [sPS (V2 0 0) 0 $ PutWall (rectNSWE (y-60) 0 (x/2-10) (x/2+10))
defaultCrystalWall
,windowLine (V2 (x/2) (0)) (V2 (x/2) (y-60))
,windowLine (V2 (x/2) 0) (V2 (x/2) (y-60))
]
let plmnts = [sPS (V2 (x/4) ( y/4)) (pi/2) $ PutCrit spawnerCrit
,wl
,sPS (V2 (x/2) ( y-10)) 0 putLamp
]
let f ((V2 lx _),_) = lx < x/2-5
let f (V2 lx _,_) = lx < x/2-5
roomWithSpawner <- (fmap connectRoom . randomiseOutLinks) =<< filterLinks f (set rmPS plmnts $ roomRect x y 2 2)
aRoom <- airlock 0
return $ treeFromTrunk [Left aRoom] roomWithSpawner