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/Boss.hs
+79 -9
View File
@@ -5,12 +5,17 @@ module Dodge.Room.Boss
where
import Dodge.Data
import Dodge.Room.Data
import Dodge.Room.Procedural
import Dodge.Room.Placement
import Dodge.Room.Link
import Dodge.Room.Corridor
import Dodge.LevelGen.Data
import Dodge.Creature
import Dodge.RandomHelp
import Dodge.Layout.Tree.Polymorphic
import Geometry
import Data.Tree
import Control.Monad.State
import Control.Lens
import System.Random
@@ -21,7 +26,10 @@ roomOctogon x = Room
{ _rmPolys = [rectNSWE x (-x) (-x) x
,rectNSWE 0 (-(x + 40)) (-20) 20
]
, _rmLinks = [((0,x),0),((0,-(x+40)),pi)]
, _rmLinks =
[((0,x),0)
,((0,-(x+40)),pi)
]
, _rmPath = [((0,x),(0,-(x+40)))
,((0,-(x+40)),(0,x))]
, _rmPS =
@@ -41,19 +49,26 @@ roomOctogon x = Room
fx = 4 * x / 5
bossRoom :: RandomGen g => Creature -> State g Room
--bossRoom cr = pure $ roomOctogon 300 & rmPS %~ ( PS (0,100) (negate $ pi/2) (PutCrit cr) :)
bossRoom cr = pure $ roomCross 200 300 & rmPS %~ ( PS (0,100) (negate $ pi/2) (PutCrit cr) :)
bossRoom cr = randomMediumRoom <&> rmPS %~ ( PS (0,100) (negate $ pi/2) (PutCrit cr) :)
armouredChasers :: RandomGen g => State g Room
armouredChasers :: RandomGen g => State g (Tree Room)
armouredChasers = do
ps <- takeN 5 [(x,y) | x <- [-200,-120 .. 200] ,y <- [-200,-120 .. 200] ]
ps <- takeN 5 [(x,y) | x <- [-100,-80 .. 100] ,y <- [-100,-80 .. 100] ]
as <- replicateM 5 . state $ randomR (0,2*pi)
let theCrits = zipWith3 (\p a c -> PS p a (PutCrit c)) ps as cs
pure $ roomOctogon 300 & rmPS %~ (++ theCrits)
treeFromPost [corridor,corridor] <$> (randomMediumRoom <&> rmPS %~ (++ theCrits))
where
cs = (armourChaseCrit & crState . crDropsOnDeath .~ DropSpecific [0])
: replicate 4 chaseCrit
randomMediumRoom :: RandomGen g => State g Room
randomMediumRoom = takeOne
[ roomOctogon 300
, roomCross 180 300
, roomShuriken 200 300
, roomTwistCross 230 300 (0)
]
roomCross
:: Float -- ^ First width/2
-> Float -- ^ Second width/2
@@ -62,7 +77,16 @@ roomCross x y = Room
{ _rmPolys = [rectNSWE y (-y) (-x) x
,rectNSWE (-x) x y (-y)
]
, _rmLinks = [((x,y-20),negate $ pi/2)]
, _rmLinks =
[((x,y-20),negate $ pi/2)
,((x,20-y),negate $ pi/2)
,((20-y,x),0)
,((y-20,x),0)
,((-x,y-20),pi/2)
,((-x,20-y),pi/2)
,((20-y,-x),pi)
,((y-20,-x),pi)
]
, _rmPath = []
, _rmPS =
[PS ( x, 0) 0 putLamp
@@ -70,6 +94,52 @@ roomCross x y = Room
,PS ( 0, x) 0 putLamp
,PS ( 0,-x) 0 putLamp
]
, _rmBound = [rectNSWE x (-x) (-x) x]
, _rmBound =
[rectNSWE y (-y) (-x) x
,rectNSWE x (-x) (-y) y
]
}
where
{- | TODO: pathing -}
roomShuriken
:: Float -- ^ First width/2
-> Float -- ^ Second width/2
-> Room
roomShuriken x y =
let ps = [
[ (0,-20)
, (x,-20)
, (x,y)
, (0,x)
] ]
corner = Room
{ _rmPolys = ps
, _rmLinks = [((x-1,y-20),negate $ pi/2)]
, _rmPath = []
, _rmPS = [PS (x/2,x/2) 0 putLamp]
, _rmBound = ps
}
in foldr1 combineRooms $ map (\r -> shiftRoomBy ((0,0), r) corner) [0,pi/2,pi,3*pi/2]
{- | TODO: pathing
Precondition: first float is less than the second by at least 40. -}
roomTwistCross
:: Float -- ^ First width/2,
-> Float -- ^ Second width/2, should be biggest
-> Float -- ^ Third width, should be smallest, possibly negative
-> Room
roomTwistCross x y z =
let ps = [ [ (x,negate $ z+20)
, (x,x)
, (z,y)
, (z-20,x)
, (z,negate $ z+20)
]
, rectNSWE (x-5) 0 0 (x-5)
]
corner = Room
{ _rmPolys = ps
, _rmLinks = [((z,y-20), pi/2)]
, _rmPath = []
, _rmPS = [PS (x/2,x/2) 0 putLamp]
, _rmBound = ps
}
in foldr1 combineRooms $ map (\r -> shiftRoomBy ((0,0), r) corner) [0,pi/2,pi,3*pi/2]
src/Dodge/Room/Link.hs
+2 -2
View File
@@ -43,13 +43,13 @@ filterLinks :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
filterLinks cond r = do
newLinks <- shuffle $ filter cond $ init $ _rmLinks r
return $ r {_rmLinks = newLinks ++ [last $ _rmLinks r]}
{- | Swaps the last link in the list with one that satisfies a given
- property (it might swap with itself). Unsafe. -}
changeLinkTo :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
changeLinkTo cond r = do
l <- takeOne $ filter cond $ _rmLinks r
let newLinks = delete l (_rmLinks r) ++ [l]
return $ r {_rmLinks = newLinks}
{- | Move a room so that the last link in '_rmLinks' lines up to
an external point and direction.
This is intended to work when the external point is an outgoing link from another room.
src/Dodge/Room/LockAndKeyList.hs
+1 -1
View File
@@ -14,6 +14,6 @@ lockAndKeyRoomList :: RandomGen g =>
) ]
lockAndKeyRoomList =
[ ( fmap (pure . Right) armouredCorridor
, fmap (pure . Left) armouredChasers
, fmap (fmap Left) armouredChasers
)
]
src/Dodge/Room/LongDoor.hs
+112
View File
@@ -0,0 +1,112 @@
{-# LANGUAGE TupleSections #-}
{- | Rooms containing long doors, probably with a big reveal behind them.
-}
module Dodge.Room.LongDoor
where
import Dodge.Data
import Dodge.Room.Data
import Dodge.Room.Placement
import Dodge.Room.Link
import Dodge.Room.Procedural
import Dodge.Layout.Tree.Either
import Dodge.LevelGen.Data
import Dodge.LevelGen.Switch
import Dodge.RandomHelp
import Dodge.Creature.Inanimate
import Dodge.Creature
import Picture
import Geometry
import System.Random
import Control.Lens
import Control.Monad.State
import Data.Tree
import qualified Data.Map as M
twinSlowDoorRoom
:: Int -- ^ Door id
-> Float -- ^ Half width
-> Float -- ^ Half height
-> Float -- ^ Inner width
-> Room
twinSlowDoorRoom drID w h x = Room
{ _rmPolys = ps
, _rmLinks =
[ ((w,h/2) , negate $ pi/2)
, ((-w,h/2) , pi/2)
, ((0,-h), pi)
]
, _rmPath = []
, _rmPS =
[ PS (0,h/2) 0 putLamp
, PS (25,5) 0 putLamp
, PS (negate $ 25,5) 0 putLamp
, PS (0,0) 0 $ PutDoor col (not . cond) drL
, PS (0,0) 0 $ PutDoor col (not . cond) drR
, PS (0,h-5) pi $ PutButton $ makeButton col
(over worldState (M.insert (DoorNumOpen drID) True))
]
, _rmBound = ps
}
where
ps =
[rectNSWE h (-2) (-w) w
,rectNSWE 20 (-h) (negate x) x
]
drL = fmap ((\h' -> ((x,-h'),(x,h-h'))) . (* h) . (/ fromIntegral nDrp) . fromIntegral)
[0..nDrp]
drR = fmap ((\h' -> ((-x,-h'),(-x,h-h'))) . (* h) . (/ fromIntegral nDrp) . fromIntegral)
[0..nDrp]
nDrp = ceiling $ h
cond w = or $ M.lookup (DoorNumOpen drID) (_worldState w)
col = dim $ dim $ bright red
twinSlowDoorChasers
:: RandomGen g
=> Int -- ^ Door id
-> State g Room
twinSlowDoorChasers drid = do
let lps = (-65 ,) <$> [20,40 .. 180]
rps = (65 ,) <$> [20,40 .. 180]
ps <- takeN 4 $ lps ++ rps
let plmnts = map (\p -> PS p 0 $ PutCrit chaseCrit) ps
return $ twinSlowDoorRoom drid 80 200 40 & rmPS %~ (plmnts ++)
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
))
randC1 = RandPS $ takeOne $ map PutCrit $ (armourChaseCrit : replicate 50 chaseCrit)
src/Dodge/Room/NoNeedWeapon.hs
+38
View File
@@ -0,0 +1,38 @@
{- | Rooms that can be successfully tackled without having any items. -}
module Dodge.Room.NoNeedWeapon
( centerVaultExplosiveExit
) where
import Dodge.Data
import Dodge.Creature
import Dodge.Creature.Inanimate
import Dodge.Room.Data
import Dodge.Room.Procedural
import Dodge.Room.Link
import Dodge.RandomHelp
import Dodge.LevelGen.Data
import Control.Lens
import Control.Monad
import Control.Monad.State
import System.Random
{- |
A room designed to be /passable/ with no weapons.
Highlights an issue: when trying to place next door rooms, if the level generation fails it will try a different link.
So if there are multiple such, we cannot assume that a given link will be chosen.
To solve this, here we delete unwanted links.
-}
centerVaultExplosiveExit
:: RandomGen g
=> Int -- ^ Door id
-> State g Room
centerVaultExplosiveExit drID = do
cr <- takeOne [miniGunCrit, autoCrit]
let extraPS =
[PS (0,175) 0 $ PutCrit explosiveBarrel
,PS (5,195) 0 $ PutCrit explosiveBarrel
,PS (0,200) 0 $ PutCrit explosiveBarrel
,PS (-4,195) 0 $ PutCrit explosiveBarrel
,PS (0,0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll)
]
r <- centerVaultRoom drID 200 200 50 <&> rmPS %~ (extraPS ++)
randomiseLinksBy shuffleTail r <&> rmLinks %~ take 2
src/Dodge/Room/Placement.hs
+40 -10
View File
@@ -2,6 +2,7 @@
module Dodge.Room.Placement
where
import Dodge.Data
import Dodge.Default
import Dodge.LevelGen.Data
import Dodge.Room.Data
import Dodge.Creature.Inanimate
@@ -47,7 +48,7 @@ crystalLine :: Point2 -> Point2 -> PlacementSpot
crystalLine a b = PS
{ _psPos = (0,0)
, _psRot = 0
, _psType = PutWindow ps $ withAlpha 0.5 aquamarine
, _psType = PutWall ps defaultCrystalWall
}
where
ps =
@@ -58,6 +59,24 @@ crystalLine a b = PS
]
left = 7 *.* normalizeV (a-.-b)
up = vNormal left
{- Places an unbreakable wall between two points.
Depth 15, does not extend wider than points.
-}
wallLine :: Point2 -> Point2 -> PlacementSpot
wallLine a b = PS
{ _psPos = (0,0)
, _psRot = 0
, _psType = PutWall ps defaultWall
}
where
ps =
[ a +.+ up
, a -.- up
, b -.- up
, b +.+ up
]
left = 15 *.* normalizeV (a-.-b)
up = vNormal left
windowLineType :: Point2 -> Point2 -> PSType
windowLineType = PutLineBlock baseWindowPane 8 8
@@ -88,10 +107,7 @@ baseWindowPane = Block
, _blShadows = []
, _blDegrades = [5,5]
}
{-
Replaces instances of a given 'PutID' with 'PSType's drawn from a list.
-}
{- Replaces instances of a given 'PutID' with 'PSType's drawn from a list. -}
replacePutID
:: Int -- ^ The id of 'PutID' to be replaced
-> [PSType] -- ^ List of replacements
@@ -99,12 +115,9 @@ replacePutID
-> Room
replacePutID i psts r =
r & rmPS %~ flip (subZipWith (isPutID i) (\ps pt -> ps & psType .~ pt)) psts
{-
Partition a list by a predicate, apply a zip to those elements
{- Partition a list by a predicate, apply a zip to those elements
that satisfy the predicate, concatenate
the new zipped list and the other (unchanged) half.
-}
the new zipped list and the other (unchanged) half. -}
subZipWith
:: (a -> Bool) -- ^ Filter: elements to apply zip to
-> (a -> b -> a) -- ^ Combining function
@@ -116,3 +129,20 @@ subZipWith f g xs ys =
in zipWith g zs ys ++ ws
isPutID i ps = Just i == ps ^? psType . putID
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)
]
src/Dodge/Room/Procedural.hs
+2 -6
View File
@@ -6,6 +6,7 @@ module Dodge.Room.Procedural
, roomRectAutoLinks
, randomFourCornerRoom
, centerVaultRoom
, combineRooms
) where
import Dodge.Data
import Dodge.Room.Data
@@ -230,7 +231,6 @@ centerVaultRoom n w h d = do
weDoors = rectNSWE 20 (-20) (d + 20) (negate (d +20))
centerPoly = rectWdthHght (d - 20) (d - 20)
polys = centerPoly : nsDoors : weDoors : (take 4 $ iterate (map vNormal) northPoly)
cr <- takeOne [miniGunCrit, autoCrit]
return $ Room
{ _rmPolys = polys
, _rmLinks =
@@ -246,11 +246,6 @@ centerVaultRoom n w h d = do
,PS (w-5,5-h) 0 putLamp
,PS (5-w,h-5) 0 putLamp
,PS (5-w,5-h) 0 putLamp
,PS (0,h-5) 0 $ PutCrit explosiveBarrel
,PS (5,h-5) 0 $ PutCrit explosiveBarrel
,PS (0,h) 0 $ PutCrit explosiveBarrel
,PS (-4,h-5) 0 $ PutCrit explosiveBarrel
,PS (0,0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll)
]
++ concat (zipWith (\i r -> map (shiftPSBy ((0,0),r)) $ theDoor i)
[n, n+1, n+2, n+3] [0,pi/2,pi,3*pi/2])
@@ -265,3 +260,4 @@ centerVaultRoom n w h d = do
(over worldState (M.insert (DoorNumOpen i) False))
]
cond i w = or $ M.lookup (DoorNumOpen i) (_worldState w)