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

Refactoring, add screen when generating level

Browse Source
This commit is contained in:
justin
2021-05-03 14:44:27 +02:00
parent 2bf23db935
commit 6e6757499c
19 changed files with 342 additions and 118 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room.hs
+7 -58
View File
@@ -28,6 +28,7 @@ import Dodge.Room.Link
import Dodge.Room.Branch
import Dodge.Room.Door
import Dodge.Room.Airlock
import Dodge.Room.LongDoor
import Geometry
import Picture
@@ -84,22 +85,6 @@ roomPillars = over rmLinks init $ set rmPS plmnts $ roomRect 240 240 2 2
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
putBlockRect a x b y = [ blockLine (a,b) (a,y)
, blockLine (a,y) (x,y)
, blockLine (x,y) (x,b)
, blockLine (x,b) (a,b)
]
putBlockV a x b y = [ blockLine (a,b) (a,y)
, blockLine (x,b) (a,b)
]
putBlockC a x b y = [ blockLine (a,b) (a,y)
, blockLine (x,b) (a,b)
, blockLine (a,y) (x,y)
]
putBlockN a x b y = [ blockLine (a,b) (a,y)
, blockLine (x,b) (a,b)
, blockLine (x,y) (x,b)
]
branchWith :: Room -> [Tree Room] -> Tree (Either Room Room)
branchWith r ts = Node (Left r) $ [return $ Right door] ++ fmap (fmap Left) ts
@@ -134,8 +119,8 @@ glassLesson = do
$ roomRect 200 200 1 1
topRoom = set rmPS topplmnts
$ roomRect 200 200 1 1
botplmnts = [PS (0,0) 0 $ PutWindow (rectNSWE (200) 0 (90) (110))
$ withAlpha 0.5 aquamarine
botplmnts = [PS (0,0) 0 $ PutWall (rectNSWE (200) 0 (90) (110))
$ defaultCrystalWall
,PS (50,100) 0 $ PutCrit miniGunCrit
,PS (50,50) 0 putLamp
]
@@ -275,7 +260,6 @@ randFirstWeapon = do
-- ++ [flamer]
--randC1 :: State StdGen PSType
randC1 = RandPS $ takeOne $ map PutCrit $ (armourChaseCrit : replicate 50 chaseCrit)
randC = randC1
@@ -396,53 +380,18 @@ roomCCrits = do
return $ connectRoom $ over rmPS ((lamps ++) . (plmnts ++)) $ roomC 200 200
slowDoorRoom :: RandomGen g => State g (Tree (Either Room Room))
slowDoorRoom = do
x <- state $ randomR (400,800)
y <- state $ randomR (400,800)
h <- state $ randomR (200,min (y-100) 500)
(butPos,butRot) <- takeOne [( (x/2-50,5),0)
,( (x/2+50,5),0)
]
let n = 25
xs <- sequence $ replicate n $ state $ randomR (10,x-10)
ys <- sequence $ replicate n $ state $ randomR (h+20,y)
rs <- sequence $ replicate n $ state $ randomR (0,2*pi)
let ps = zip xs ys
xs' <- sequence $ replicate 5 $ state $ randomR (10,x-10)
ys' <- sequence $ replicate 5 $ state $ randomR (h+20,y)
let crits = zipWith (\p r -> PS p r randC1) ps rs
lsources = [PS (x/2,30) 0 putLamp, PS (x/2,y-30) 0 putLamp]
let barrels = zipWith (\x y -> PS (x,y) 0 $ PutCrit explosiveBarrel) xs' ys'
let pillarsa = []
let pillarsb = putBlockRect (x/5-20) (x/5+20) (h/2-20) (h/2+20)
++ putBlockRect (2*x/5-20) (2*x/5+20) (h/2-20) (h/2+20)
++ putBlockRect (3*x/5-20) (3*x/5+20) (h/2-20) (h/2+20)
++ putBlockRect (4*x/5-20) (4*x/5+20) (h/2-20) (h/2+20)
let pillarsc = putBlockRect (x/3-20) (x/3+20) (h/2-20) (h/2+20)
++ putBlockRect (2*x/3-20) (2*x/3+20) (h/2-20) (h/2+20)
pillars <- takeOne [pillarsa, pillarsb, pillarsc]
let cond x = (snd . fst) x > h + 40
let cond2 x = (snd . fst) x < h - 40
but <- takeOne [PutBtDoor (dim $ light red) butPos butRot (0,h) (x,h)
-- ,PutSwitchDoor (dim $ light red) butPos butRot (0,h) (x,h)
]
fmap connectRoom (filterLinks cond =<< (changeLinkTo cond2
$ set rmPS ([PS (0,0) 0 but] ++ crits ++ pillars ++ barrels ++ lsources)
$ roomRectAutoLinks x y
))
longRoom :: RandomGen g => State g Room
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 $ PutWindow ps $ withAlpha 0.5 aquamarine)
let ws = map (\ps -> PS (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 $ PutWindow ps $ withAlpha 0.5 aquamarine)
let wsDefense = map (\ps -> PS (0,0) 0 $ PutWall ps defaultCrystalWall)
[rectNSWE (95) (70) 0 25
,rectNSWE (95) (70) 50 75
]
@@ -577,8 +526,8 @@ 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 $ PutWindow (rectNSWE (y-60) 0 (x/2-10) (x/2+10))
$ withAlpha 0.5 aquamarine
wl <- takeOne [PS (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