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:
jgk
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/Creature.hs
+2 -2
View File
@@ -265,11 +265,11 @@ Items you start with.
startInventory = IM.fromList (zip [0..20]
(
[bezierGun
,autoGun
,remoteLauncher
,grenade
--,spawnGun lamp
,spawnGun lamp
--,poisonSprayer
--,autoGun
--,launcher
--,lasGun
--,grenade
src/Dodge/Data/Menu.hs
+1 -1
View File
@@ -9,5 +9,5 @@ data MenuLayer
| SoundOptionMenu
| GraphicsOptionMenu
| ControlList
| WaitMessage String
| WaitMessage String Int
deriving (Eq,Ord)
src/Dodge/Default.hs
+10 -2
View File
@@ -25,8 +25,7 @@ import qualified Data.Map as M
import qualified Data.Set as S
import Data.Graph.Inductive.Graph hiding ((&))
import Data.List
{-
Indestructible wall. -}
{- Indestructible wall. -}
defaultWall = Wall
{ _wlLine = [(0,0),(50,0)]
, _wlID = 0
@@ -34,6 +33,15 @@ defaultWall = Wall
, _wlSeen = False
, _wlIsSeeThrough = False
}
{- Indestructible see-through wall. -}
defaultCrystalWall = Wall
{ _wlLine = [(0,0),(50,0)]
, _wlID = 0
, _wlColor = withAlpha 0.5 aquamarine
, _wlSeen = False
, _wlIsSeeThrough = True
}
{-
Door that opens on approach.
Pathable. -}
src/Dodge/Event/Menu.hs
+7 -4
View File
@@ -65,10 +65,13 @@ handlePressedKeyInMenu mState scode w = case mState of
pushMenu ml w = Just $ w & menuLayers %~ (ml :)
popMenu w = Just $ w & menuLayers %~ tail
sw = w & sideEffects %~ (setVol (_config w) : )
startNewGame = Just $ updateFramebufferSize $ generateFromList levx
$ initialWorld
& randGen .~ _randGen w
& config .~ _config w
startNewGame = Just $ w
& menuLayers .~ [WaitMessage "GENERATING..." 1]
& worldEvents .~ const aNewGame
aNewGame :: World
aNewGame = updateFramebufferSize $ generateFromList levx $ initialWorld
& randGen .~ _randGen w
& config .~ _config w
updateFramebufferSize :: World -> World
updateFramebufferSize w = w & sideEffects
src/Dodge/Floor.hs
+5 -4
View File
@@ -15,6 +15,8 @@ import Dodge.Room.Door
import Dodge.Room.Branch
import Dodge.Room.Boss
import Dodge.Room.Airlock
import Dodge.Room.LongDoor
import Dodge.Room.NoNeedWeapon
import Dodge.Base
import Dodge.Layout
import Dodge.Layout.Tree.Polymorphic
@@ -46,12 +48,11 @@ roomTreex = do
t = treeFromTrunk
[[StartRoom]
,[Corridor]
,[BossAno $ addArmour launcherCrit & crHP +~ 800
& crState . crDropsOnDeath .~ DropSpecific [0] ]
,[SpecificRoom . fmap (pure . Right) $ twinSlowDoorChasers 30]
,[Corridor]
,[DoorAno]
,[SpecificRoom $ fmap (pure . Right)
$ randomiseLinksBy shuffleTail =<< centerVaultRoom 1 200 200 50]
$ centerVaultExplosiveExit 50]
,[SpecificRoom blockedCorridor]
,[OrAno [[DoorAno]
,[Corridor]
@@ -62,7 +63,7 @@ roomTreex = do
,[SpecificRoom $ fmap (pure . Right) randomFourCornerRoom]
,[Corridor]
,[OrAno
[[SpecificRoom $ branchRectWith $ fmap (pure . Left) armouredChasers]
[[SpecificRoom $ branchRectWith $ fmap (fmap Left) armouredChasers]
,[BossAno $ addArmour launcherCrit & crHP +~ 800
& crState . crDropsOnDeath .~ DropSpecific [0] ]
]
src/Dodge/Layout/Tree/Either.hs
+8
View File
@@ -5,6 +5,7 @@ module Dodge.Layout.Tree.Either
( expandTreeBy
, appendEitherTree
, connectRoom
, connectTrunk
, deadRoom
) where
import Data.Tree
@@ -40,6 +41,13 @@ Make a singleton connection of an Either Tree.
connectRoom :: a -> Tree (Either a a)
connectRoom r = Node (Right r) []
{- |
Make a single Either connection at the end of a tree.
-}
connectTrunk :: Tree a -> Tree (Either a a)
connectTrunk (Node x (t:ts)) = Node (Left x) (connectTrunk t : map (fmap Left) ts)
connectTrunk (Node x []) = Node (Right x) []
{- |
Make a singleton dead end of an Either Tree.
-}
src/Dodge/LevelGen.hs
+13 -14
View File
@@ -88,8 +88,8 @@ placeSpot ps w = case ps of
PS {_psPos = p, _psRot = rot, _psType = PutLineBlock wl width depth a b}
-> putLineBlock wl width depth (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
PS {_psPos = p, _psRot = rot, _psType = PutWindow { _pwPoly = ps, _pwColor = c }}
-> rmCrossPaths $ over walls (addWindow (q:qs) c) w
PS {_psPos = p, _psRot = rot, _psType = PutWall { _pwPoly = ps, _pwWall = wl }}
-> rmCrossPaths $ over walls (addWalls (q:qs) wl) w
where (q:qs) = map (shiftPointBy (p,rot)) ps
rmCrossPaths w = foldr (uncurry removePathsCrossing) w $ zip (q:qs) (qs++[q])
@@ -119,18 +119,17 @@ instance Shiftable PlacementSpot where
shiftPointBy (pos,rot) p = pos +.+ rotateV rot p
addWindow :: [Point2] -> Color -> IM.IntMap Wall -> IM.IntMap Wall
addWindow qs c wls = foldr (addPane c) wls pairs
where (p:ps) = orderPolygon qs
pairs = zip (ps ++ [p]) (p:ps)
addPane :: Color -> (Point2,Point2) -> IM.IntMap Wall -> IM.IntMap Wall
addPane c (p0,p1) wls = IM.insert (newKey wls) (Wall { _wlLine = [p0,p1]
, _wlID = newKey wls
, _wlColor = c
, _wlSeen = False
, _wlIsSeeThrough = True
}
) wls
addWalls :: [Point2] -> Wall -> IM.IntMap Wall -> IM.IntMap Wall
addWalls qs wl wls = foldr (addPane wl) wls pairs
where
(p:ps) = orderPolygon qs
pairs = zip (ps ++ [p]) (p:ps)
addPane :: Wall -> (Point2,Point2) -> IM.IntMap Wall -> IM.IntMap Wall
addPane wl (p0,p1) wls = IM.insert (newKey wls) (wl
{ _wlLine = [p0,p1]
, _wlID = newKey wls
})
wls
placeBt bt p rot w = over buttons addBT w
src/Dodge/LevelGen/Data.hs
+1 -1
View File
@@ -17,6 +17,7 @@ data PSType = PutCrit Creature
| PutAutoDoor Point2 Point2
| PutBlock [Int] Color [Point2]
| PutLineBlock Wall Float Float Point2 Point2
| PutWall { _pwPoly :: [Point2] , _pwWall :: Wall }
| PutDoubleDoor Color (World -> Bool) Point2 Point2
| PutDoor Color (World -> Bool) [(Point2,Point2)]
| PutBtDoor Color Point2 Float Point2 Point2
@@ -30,7 +31,6 @@ data PSType = PutCrit Creature
, _collectiveFunction :: [Int] -> State StdGen [PSType]
}
| LabelPS { _psLabel :: Int, _ps :: PSType}
| PutWindow { _pwPoly :: [Point2] , _pwColor :: Color }
data PlacementSpot = PS
{ _psPos :: Point2
, _psRot :: Float
src/Dodge/LevelGen/LineBlock.hs
+8 -1
View File
@@ -17,7 +17,14 @@ import qualified Data.IntMap as IM
evenOddSplit = foldr f ([],[])
where f a (ls,rs) = (rs, a : ls)
putLineBlock :: Wall -> Float -> Float -> Point2 -> Point2 -> World -> World
putLineBlock
:: Wall -- Base pane
-> Float -- Block width
-> Float -- Block depth
-> Point2 -- Start point (symmetric)
-> Point2 -- End point (symmetric)
-> World
-> World
putLineBlock basePane blockWidth depth a b w = removePathsCrossing a b $ foldr insertBlock w listBlocks
where
d = dist a b
src/Dodge/Render/MenuScreen.hs
+1 -1
View File
@@ -50,7 +50,7 @@ menuScreen cfig hw hh mLays = case mLays of
,tst (-100) 100 0.4 "CONTROLS"
,controlsList
]
(WaitMessage s : _) -> optionsList hw hh s []
(WaitMessage s _ : _) -> optionsList hw hh s []
_ -> blank
where
tst x y sc t = translate x y $ scale sc sc $ color white $ text t
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
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)
src/Dodge/Update.hs
+5 -2
View File
@@ -41,11 +41,14 @@ pushSideEffects w = w
For most menus the only way to change the world is using event handling. -}
update' :: World -> World
update' w = case _menuLayers w of
(WaitMessage _ : ls) -> w & menuLayers .~ ls
(WaitMessage s i: ls)
| i < 1 -> w & doubleArgumentFor _worldEvents
| otherwise -> w & menuLayers %~ ( (WaitMessage s (i-1) :) . tail )
(GameOverMenu : _) -> updateParticles
. updateProjectiles
. updateLightSources
$ updateClouds
. updateClouds
$ updateSoundQueue
w
(_ : _) -> w
[] -> checkEndGame