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

Implement first weapon into tree structure

Browse Source
This commit is contained in:
jgk
2021-04-21 13:00:11 +02:00
parent 7c0fbe0ce2
commit a1c344a342
9 changed files with 93 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Floor.hs
+15 -12
View File
@@ -33,10 +33,13 @@ import System.Random
roomTreex :: RandomGen g => State g (Maybe [Room])
roomTreex = do
struct <- aTreeStrut
struct' <- aTreeStrut
let struct = Node () []
-- t <- randomPadCorridors $ fmap (const []) struct
let t = padCorridors $ fmap (const []) struct
fmap shiftExpandTree $ mapM annoToRoom t
let t' = padCorridors $ fmap (const []) struct
t = treeTrunk [[StartRoom],[Corridor],[FirstWeapon],[Corridor]] t'
-- fmap shiftExpandTree $ mapM annoToRoom t
fmap (shiftExpandTree . expandTreeBy id) $ mapM annoToRoomTree t
roomTreex' :: RandomGen g => State g (Maybe [Room])
roomTreex' = do
@@ -64,7 +67,7 @@ lev1' = do
]
++ [return $ connectRoom corridor
,return $ connectRoom door
,glassSwitchBack >>= (fmap connectRoom . randLinks)]
,glassSwitchBack >>= (fmap connectRoom . randomiseOutLinks)]
++ [return $ connectRoom corridor
,return $ connectRoom door]
++ [miniRoom3]
@@ -74,25 +77,25 @@ lev1' = do
++ [return $ connectRoom corridor
,return $ connectRoom door]
++[roomMiniIntro]
++ [longRoom >>= (fmap connectRoom . randLinks)]
++ [longRoom >>= (fmap connectRoom . randomiseOutLinks)]
++ [return $ connectRoom corridor
,return $ connectRoom door]
++ firstWeapon
++ [return $ connectRoom corridor
,return $ connectRoom door]
++ [(fmap connectRoom . randLinks) =<< pistolerRoom]
++ [(fmap connectRoom . randomiseOutLinks) =<< pistolerRoom]
++ [return $ connectRoom door]
++ [(fmap connectRoom . randLinks) =<< shooterRoom]
++ (replicate 3 $ (fmap connectRoom . randLinks) corridor)
++ [(fmap connectRoom . randomiseOutLinks) =<< shooterRoom]
++ (replicate 3 $ (fmap connectRoom . randomiseOutLinks) corridor)
++ [return $ connectRoom (set rmPS [PS (20,40) 0 basicLS] corridor)]
++ [return $ connectRoom corridor]
++ (replicate 3 $ (fmap connectRoom . randLinks) corridor)
++ (replicate 3 $ (fmap connectRoom . randomiseOutLinks) corridor)
++ [return $ connectRoom corridor]
++[return $ connectRoom corridor,return $ connectRoom door]
++ [shootingRange]
++ (replicate 3 $ (fmap connectRoom . randLinks) corridor)
++ (replicate 3 $ (fmap connectRoom . randomiseOutLinks) corridor)
++[roomMiniIntro]
++ (replicate 3 $ (fmap connectRoom . randLinks) corridor)
++ (replicate 3 $ (fmap connectRoom . randomiseOutLinks) corridor)
++ [return $ connectRoom corridor
,return $ connectRoom door
,slowDoorRoom]
@@ -101,7 +104,7 @@ lev1' = do
,return $ connectRoom corridor
]
)
$ (fmap connectRoom . randLinks) corridor
$ (fmap connectRoom . randomiseOutLinks) corridor
roomToLevel2 :: RandomGen g => State g (Tree (Either Room Room))
roomToLevel2 = join $ takeOne
src/Dodge/Layout/Tree/Annotate.hs
+15 -2
View File
@@ -18,6 +18,8 @@ data Annotation
= Lock Int
| Key Int
| Corridor
| FirstWeapon
| StartRoom
addLock :: RandomGen g => Int -> Tree [Annotation] -> State g (Tree [Annotation])
addLock i t = do
@@ -34,9 +36,20 @@ randomPadCorridors (Node x xs) = do
xs' <- mapM randomPadCorridors xs
return $ treeTrunk (replicate n [Corridor]) (Node x xs')
annoToRoomTree :: RandomGen g => [Annotation] -> State g (Tree (Either Room Room))
annoToRoomTree [Corridor] = fmap (pure . Right) $ randomiseOutLinks corridor
annoToRoomTree [FirstWeapon] = weaponRoom
annoToRoomTree _ = do
w <- state $ randomR (100,400)
h <- state $ randomR (200,400)
fmap (pure . Right) $ return (roomRectAutoLinks w h) >>= randomiseOutLinks
annoToRoom :: RandomGen g => [Annotation] -> State g Room
annoToRoom [Corridor] = takeOne [corridor]
annoToRoom _ = randLinks $ roomRectAutoLinks 200 200
annoToRoom [Corridor] = randomiseOutLinks corridor
annoToRoom _ = do
w <- state $ randomR (100,400)
h <- state $ randomR (200,400)
return (roomRectAutoLinks w h) >>= randomiseOutLinks
annoToRoom' :: [Annotation] -> Room
annoToRoom' [Corridor] = corridor
src/Dodge/Layout/Tree/Either.hs
+2
View File
@@ -34,3 +34,5 @@ Make a singleton dead end of an Either Tree.
-}
deadRoom :: a -> Tree (Either a a)
deadRoom r = Node (Left r) []
src/Dodge/Layout/Tree/GenerateStructure.hs
-1
View File
@@ -53,4 +53,3 @@ aTreeStrut = do
let trunk = treePath d
return $ foldr (uncurry addBranchAt) trunk $ zip bds bs
src/Dodge/Room.hs
+21 -18
View File
@@ -169,7 +169,7 @@ manyDoors i = treePost (replicate i (Left door)) $ Right door
glassLesson :: RandomGen g => State g (Tree (Either Room Room))
glassLesson = do
corridors <- sequence $ replicate 3 $ fmap Left $ randLinks corridor
corridors <- sequence $ replicate 3 $ fmap Left $ randomiseOutLinks corridor
return $ Node (Left $ botRoom) [deadRoom door,uppers, treePost (Left door : corridors) $ Right door]
where uppers = Node (Left door) [deadRoom topRoom]
botRoom = set rmPS botplmnts
@@ -212,7 +212,7 @@ miniRoom1 = do
return $ set rmPS plmnts $ shiftRoomBy ((0,40),0) $ roomRect' wth hgt 2 4
miniTree2 :: RandomGen g => State g (Tree (Either Room Room))
miniTree2 = miniRoom1 >>= randLinks >>= changeLinkTo (\p -> (snd . fst) p < 70)
miniTree2 = miniRoom1 >>= randomiseOutLinks >>= changeLinkTo (\p -> (snd . fst) p < 70)
>>= return . flip branchWith (replicate 3 $ treePost [door,corridor]
critInDeadEnd )
@@ -245,7 +245,7 @@ miniRoom3 = do
,PS cp (pi/8+7*pi/4) b
,PS (w/2,h/2) 0 putLamp
]
fmap connectRoom $ randLinks $ set rmPS plmnts $ roomRectAutoLinks w h
fmap connectRoom $ randomiseOutLinks $ set rmPS plmnts $ roomRectAutoLinks w h
rot90Around :: Point2 -> Point2 -> Point2
rot90Around cen p = cen +.+ vNormal (p -.- cen)
@@ -258,7 +258,7 @@ roomMiniIntro = fmap (g . expandTreeBy f) $ sequence $ treePost
,join $ takeOne [miniTree2,glassLesson]
-- ,join $ takeOne [miniRoom1]
]
$ fmap connectRoom $ randLinks corridor
$ fmap connectRoom $ randomiseOutLinks corridor
where f (Node (Right x) xs) = Node (Right (Right x)) $ map f xs
f (Node (Left x) xs) = Node (Left (Left x)) $ map f xs
g (Node (Right x) []) = Node (Right x) []
@@ -332,7 +332,7 @@ weaponEmptyRoom = do
,PS (w-20,20) (pi/2) $ randC1
,PS (w/2,h/2) 0 $ putLamp
]
(fmap connectRoom . randLinks) =<< (changeLinkTo ((\p -> dist p (w/2,0) < 10) . fst)
(fmap connectRoom . randomiseOutLinks) =<< (changeLinkTo ((\p -> dist p (w/2,0) < 10) . fst)
$ set rmPS plmnts $ roomRect' w h 2 2)
@@ -377,7 +377,7 @@ weaponBetweenPillars = do
,PS crPos1 (d crPos1) $ randC1
,PS crPos2 (d crPos2) $ randC1
]
(fmap connectRoom . randLinks) =<< (filterLinks f $ over rmPS (++plmnts) $ roomPillars)
(fmap connectRoom . randomiseOutLinks) =<< (filterLinks f $ over rmPS (++plmnts) $ roomPillars)
where f (_,a) = a == 0
blockedCorridor :: RandomGen g => State g (Tree (Either Room Room))
@@ -387,21 +387,24 @@ blockedCorridor = do
let plmnts = [PS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256)
$ reverse $ rectNSWE 10 (-10) (-10) 10
]
sequence $ treePost (replicate n $ fmap Left $ randLinks corridor)
sequence $ treePost (replicate n $ fmap Left $ randomiseOutLinks corridor)
$ fmap Right $ return $ set rmPS plmnts corridor
weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room))
weaponLongCorridor = do
root <- takeOne $ [tEast, tWest]
connectingRoom <- takeOne [tEast,tWest]
connectingRoom <- takeOne
[--tEast & rmPS .~ [PS (-40,60) 0 $ putLamp]
tWest & rmPS .~ [PS (40,60) 0 $ putLamp]
]
i1 <- state $ randomR (2,5)
i2 <- state $ randomR (2,5)
let branch1 = treeTrunk (replicate i1 $ Left corridor) (connectRoom $ putCrs connectingRoom)
let branch2 = treeTrunk (replicate i2 $ Left corridor) (deadRoom $ putWp corridorN)
let branch1 = treeTrunk (replicate i1 $ Left corridorN) (connectRoom $ putCrs connectingRoom)
let branch2 = treeTrunk (replicate i2 $ Left corridorN) (deadRoom $ putWp corridor)
return $ Node (Left root) [branch1,branch2]
where putCrs = set rmPS [PS (10,40) (-pi/2) $ randC
where putCrs = over rmPS (++ [PS (10,40) (-pi/2) $ randC
,PS (-10,40) (-pi/2) $ randC
]
])
putWp = set rmPS [PS (20,40) 0 $ RandPS randFirstWeapon
,PS (20,60) 0 $ putLamp
]
@@ -424,11 +427,11 @@ deadEndRoom = Room
weaponRoom :: RandomGen g => State g (Tree (Either Room Room))
weaponRoom = do
x <- takeOne [weaponEmptyRoom
x <- takeOne --[weaponEmptyRoom
--, weaponUnderCrits
, weaponBehindPillar
, weaponBetweenPillars
, weaponLongCorridor
--, weaponBehindPillar
--, weaponBetweenPillars
[ weaponLongCorridor
]
x
@@ -445,7 +448,7 @@ branchRectWith t = do
x <- state $ randomR (100,200)
y <- state $ randomR (100,200)
b <- t
root <- randLinks $ roomRectAutoLinks x y
root <- randomiseOutLinks $ roomRectAutoLinks x y
return $ Node (Left root) [Node (Right door) [], fmap rToL $ treeTrunk [Left door] b]
where rToL :: Either a a -> Either a a
rToL (Right r) = Left r
@@ -648,5 +651,5 @@ spawnerRoom = do
,PS (x/2, y-10) 0 putLamp
]
let f ((lx,_),_) = lx < x/2-5
roomWithSpawner <- (fmap connectRoom . randLinks) =<< (filterLinks f $ set rmPS plmnts $ roomRect' x y 2 2)
roomWithSpawner <- (fmap connectRoom . randomiseOutLinks) =<< (filterLinks f $ set rmPS plmnts $ roomRect' x y 2 2)
return $ treeTrunk [Left (airlock 0)] roomWithSpawner
src/Dodge/Room/Corridor.hs
+7 -5
View File
@@ -6,19 +6,21 @@ import Geometry
corridor :: Room
corridor = Room
{ _rmPolys = [rectNSWE 80 0 0 40
,[(0,80), (0,80) +.+ rotateV (pi/3) (40,0),(40,80)]
,[(40,0), (0,0) +.+ rotateV (0-pi/3) (40,0),( 0, 0)]
-- ,[(0,80), (0,80) +.+ rotateV (pi/3) (40,0),(40,80)]
-- ,[(40,0), (0,0) +.+ rotateV (0-pi/3) (40,0),( 0, 0)]
]
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (20,60)) $ map fst lnks
, _rmPS = []
, _rmBound = [] -- rectNSWE 50 30 0 40
, _rmBound = rectNSWE 50 30 0 40
}
where
lnks =
[((20,70) ,0)
,((20,80) +.+ rotateV (0-pi/3) (-10,0), pi/6)
,((20,80) +.+ rotateV ( pi/3) ( 10,0),0-pi/6)
-- ,((20,80) +.+ rotateV (0-pi/3) (-10,0), pi/6)
-- ,((20,80) +.+ rotateV ( pi/3) ( 10,0),0-pi/6)
,((20,70), pi/6)
,((20,70), 0-pi/6)
,((20,10) ,pi)
]
corridorN :: Room
src/Dodge/Room/Data.hs
+14
View File
@@ -18,3 +18,17 @@ data RoomLink = RL {_rlPos :: Point2, _rlRot :: Float}
makeLenses ''Room
makeLenses ''RoomLink
-- want to split a room into its dimensions and contents
data Room' = Room'
{ _dimensions :: Dimensions
, _contents :: [PlacementSpot]
}
data Dimensions = Dimensions
{ _dmPolys :: [[Point2]]
, _dmLinks :: [(Point2,Float)]
, _dmPath :: [(Point2, Point2)]
, _dmBound :: [Point2]
}
src/Dodge/Room/Link.hs
+16 -2
View File
@@ -1,3 +1,10 @@
{-
Concerns link pairs of rooms.
Link pairs determine where rooms can attach to each other; each pair consists
of a position and a rotation.
The last link in the list is considered the incoming link, the other links are
the outgoing links.
-}
module Dodge.Room.Link
where
import Dodge.LevelGen
@@ -11,11 +18,18 @@ import Control.Monad.State
import Control.Lens
import Data.List (delete)
randLinks :: RandomGen g => Room -> State g Room
randLinks r = do
{- Shuffle the initial links of a room randomly. -}
randomiseOutLinks :: RandomGen g => Room -> State g Room
randomiseOutLinks r = do
newLinks <- shuffle $ init $ _rmLinks r
return $ r {_rmLinks = newLinks ++ [last $ _rmLinks r]}
{- Shuffle all links of a room randomly. -}
randomiseAllLinks :: RandomGen g => Room -> State g Room
randomiseAllLinks r = do
newLinks <- shuffle $ _rmLinks r
return $ r {_rmLinks = newLinks}
filterLinks :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room
filterLinks cond r = do
newLinks <- shuffle $ filter cond $ init $ _rmLinks r
src/Dodge/Room/Procedural.hs
+3
View File
@@ -8,6 +8,8 @@ import Geometry
import Data.List (nub,sortBy)
import Data.Function (on)
--import Control.Monad.State
--import System.Random
{-
A simple rectangular room with a light in the center.
Creates links and pathfinding graph.
@@ -58,3 +60,4 @@ makeRect x y = [((0,0),(x,0))
linksAndPath :: [(Point2,Float)] -> [(Point2,Point2)] -> [(Point2,Point2)]
linksAndPath lnks subpth = subpth ++ concatMap linkClosest lnks
where linkClosest (p,_) = doublePair (p, head $ sortBy (compare `on` dist p) $ map fst subpth)