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

Start to implement lock and key system

Browse Source
This commit is contained in:
jgk
2021-04-26 11:41:04 +02:00
parent 5d8575b03f
commit 3bc57ff650
19 changed files with 276 additions and 98 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/AIs.hs
+1 -1
View File
@@ -1515,7 +1515,7 @@ basicShooterAI w (f,g) cr =
cid = _crID cr
ypos = _crPos $ you w
wp = _crInv cr IM.! _crInvSel cr
(aimtime,g1) = randomR (80,120) g
(aimtime,g1) = randomR (60,80) g
noAmmo = 0 == _wpLoadedAmmo wp
turnCloseSlow p | errorAngleVV 22 (p -.- cpos)
(unitVectorAtAngle (_crDir cr)) < 0.4
src/Dodge/Creature.hs
+4 -1
View File
@@ -74,7 +74,10 @@ armourChaseCrit = defaultCreature
, _crHP = 300
, _crPict = enemyPict green
, _crState = defaultState {_goals = [[Wait]]}
, _crInv = IM.fromList [(0,frontArmour)]
, _crInv = IM.fromList
[(0,frontArmour)
,(1,medkit 200)
]
}
miniGunCrit :: Creature
miniGunCrit = defaultCreature
src/Dodge/Data.hs
+5
View File
@@ -1,3 +1,8 @@
{-
Contains base datatypes that cannot be seperated into
different modules because they are interdependent;
circular imports are scary.
-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StrictData #-}
src/Dodge/Floor.hs
+14 -7
View File
@@ -6,10 +6,12 @@ import Picture
import Dodge.Data
import Dodge.Room
import Dodge.Room.Procedural
import Dodge.Room.RoadBlock
import Dodge.Room.Data
import Dodge.Room.Link
import Dodge.Room.Door
import Dodge.Room.Branch
import Dodge.Room.Boss
import Dodge.Base
import Dodge.Layout
import Dodge.Layout.Tree.Polymorphic
@@ -22,6 +24,7 @@ import Dodge.SoundLogic
import Dodge.RandomHelp
import Dodge.LightSources
import Dodge.LevelGen.Data
import Dodge.Item.Weapon
import Data.Tree
import Data.Maybe (fromJust,isNothing)
@@ -33,15 +36,18 @@ import System.Random
roomTreex :: RandomGen g => State g (Maybe [Room])
roomTreex = do
struct' <- aTreeStrut
-- let struct = treePost [[SpecificRoom $ fmap (pure . Right) pistolerRoom]] [EndRoom]
let struct = treePost [[SpecificRoom $ fmap (pure . Right) testRoom]] [EndRoom]
-- let struct = treeFromPost [[SpecificRoom $ fmap (pure . Right) pistolerRoom]] [EndRoom]
let struct = treeFromPost [[SpecificRoom $ fmap (pure . Right) testRoom]] [EndRoom]
let t' = padCorridors struct
t = treeTrunk
t = treeFromTrunk
[[StartRoom]
,[Corridor]
,[BossAno $ addArmour launcherCrit & crHP +~ 800
& crState . crDropsOnDeath .~ DropSpecific [0]
]
,[SpecificRoom $ fmap (pure . Right) armouredCorridor]
,[Corridor]
,[TreasureAno [addArmour autoCrit,addArmour autoCrit] [launcher]]
-- ,[BossAno $ addArmour launcherCrit & crHP +~ 800
-- & crState . crDropsOnDeath .~ DropSpecific [0]
-- ]
,[Corridor]
,[OrAno [[DoorAno]
,[Corridor]
@@ -49,6 +55,7 @@ roomTreex = do
]
,[FirstWeapon]
,[Corridor]
,[SpecificRoom $ branchRectWith $ fmap (pure . Left) armouredChasers]
]
t'
fmap (shiftExpandTree . expandTreeBy id) $ mapM annoToRoomTree t
@@ -60,7 +67,7 @@ lev1' :: RandomGen g => State g (Tree Room)
lev1' = do
firstWeapon <- takeOne $ [[branchRectWith weaponRoom,blockedCorridor]] ++ replicate 5 [weaponRoom]
iterateWhile boundClip $ fmap (shiftRoomTree . expandTreeBy id)
$ sequence $ treePost
$ sequence $ treeFromPost
(
[return $ return $ Right deadEndRoom
]
src/Dodge/Item/Weapon.hs
+9 -12
View File
@@ -124,19 +124,16 @@ autoGun = defaultGun
, _itInvDisplay = displayAutoGun
}
autoFireMode = shootWithSound (fromIntegral autoGunSound)
. withRecoil 40
. torqueBefore 0.05
. withRandomDir (autogunSpread/2)
. withMuzFlare
. withVelWthHiteff (50,0) 3
$ destroyOnImpact bulIncCr' bulIncWall' bulHitFF'
. torqueBefore 0.05
$ autoGunNonTwistEff
singleFireMode = shootWithSound (fromIntegral autoGunSound)
. withRecoil 40
. torqueAfter 0.03
. withRandomDir (autogunSpread/2)
. withMuzFlare
. withVelWthHiteff (50,0) 3
$ destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
. torqueAfter 0.03
$ autoGunNonTwistEff
autoGunNonTwistEff = withRecoil 40
. withRandomDir (autogunSpread/2)
. withMuzFlare
. withVelWthHiteff (50,0) 3
$ destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
incMode :: Int -> World -> World
src/Dodge/Layout/Tree/Annotate.hs
+6 -2
View File
@@ -11,6 +11,7 @@ import Dodge.Room.Procedural
import Dodge.Room.Branch
import Dodge.Room.Door
import Dodge.Room.Boss
import Dodge.Room.Treasure
import Dodge.Room.Link
import Dodge.Room.Data
import Dodge.Room
@@ -34,7 +35,7 @@ data Annotation g
| OrAno [[Annotation g]]
| SpecificRoom (State g (Tree (Either Room Room)))
| BossAno Creature
| TreasureAno [Creature] Item
| TreasureAno [Creature] [Item]
addLock :: RandomGen g => Int -> Tree [Annotation g] -> State g (Tree [Annotation g])
addLock i t = do
@@ -49,12 +50,13 @@ randomPadCorridors :: RandomGen g => Tree [Annotation g] -> State g (Tree [Annot
randomPadCorridors (Node x xs) = do
n <- state $ randomR (1, 3)
xs' <- mapM randomPadCorridors xs
return $ treeTrunk (replicate n [Corridor]) (Node x xs')
return $ treeFromTrunk (replicate n [Corridor]) (Node x xs')
roomThenCorridor :: RandomGen g => Room -> State g (Tree (Either Room Room))
roomThenCorridor theRoom = fmap (\r -> Node (Left theRoom) [(pure . Right) r])
(randomiseOutLinks corridor)
annoToRoomTree :: RandomGen g => [Annotation g] -> State g (Tree (Either Room Room))
annoToRoomTree [OrAno as] = do
a <- takeOne as
@@ -74,6 +76,8 @@ annoToRoomTree [StartRoom] = do
fmap (pure . Right) $ randomiseOutLinks (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h)
annoToRoomTree (SpecificRoom rt:_) = rt
annoToRoomTree (BossAno cr : _) = branchRectWith . fmap (pure . Left) $ bossRoom cr
annoToRoomTree (TreasureAno crs loot : _) =
branchRectWith . fmap (pure . Left) $ lootRoom crs loot
annoToRoomTree _ = do
w <- state $ randomR (100,400)
h <- state $ randomR (200,400)
src/Dodge/Layout/Tree/Polymorphic.hs
+25 -7
View File
@@ -1,3 +1,12 @@
{-
Helpers for the manipulation of rose trees.
Throughout, the _trunk_ refers to successive first children in the tree.
For example, in the tree
> Node a [ Node b [], Node c [Node d []] ]
the nodes in the trunk are [a,b] (note that d is not the first child of b).
-}
module Dodge.Layout.Tree.Polymorphic
where
import Dodge.RandomHelp
@@ -10,20 +19,20 @@ import System.Random
Creates a linear tree.
Safe.
-}
treePost :: [a] -> a -> Tree a
treePost [] y = Node y []
treePost (x:xs) y = Node x [treePost xs y]
treeFromPost :: [a] -> a -> Tree a
treeFromPost [] y = Node y []
treeFromPost (x:xs) y = Node x [treeFromPost xs y]
{-
Creates a tree with one trunk branch,
input as a list, that ends in another tree.
-}
treeTrunk
treeFromTrunk
:: [a] -- ^ The trunk
-> Tree a -- ^ The end of the tree
-> Tree a
treeTrunk [] t = t
treeTrunk (x:xs) t = Node x [treeTrunk xs t]
treeFromTrunk [] t = t
treeFromTrunk (x:xs) t = Node x [treeFromTrunk xs t]
{-
Applies a function to the root of a tree.
@@ -43,6 +52,15 @@ applyToNode (i:is) f (Node x xs) = Node x (ys ++ [applyToNode is f z] ++ zs)
where
(ys, z:zs) = splitAt i xs
{-
Applies a function to the first node along a trunk that satisfies a given property.
-}
applyToSubTrunkBy :: (a -> Bool) -> (Tree a -> Tree a) -> Tree a -> Tree a
applyToSubTrunkBy cond f (Node x (t:ts))
| cond x = f (Node x (t:ts))
| otherwise = Node x (applyToSubTrunkBy cond f t : ts)
applyToSubTrunkBy _ _ t = t
zipTree :: Tree a -> Tree b -> Tree (a,b)
zipTree (Node x xs) (Node y ys) = Node (x,y) $ zipWith zipTree xs ys
@@ -79,7 +97,7 @@ applyToRandomNode f t = do
return $ applyToNode p f t
{-
Add a forest to the end of a tree.
Add a forest to the end of a tree (along the trunk).
-}
addToTrunk :: Tree a -> [Tree a] -> Tree a
addToTrunk (Node x []) f = Node x f
src/Dodge/LevelGen.hs
+23 -14
View File
@@ -106,10 +106,6 @@ instance (Shiftable a) => Shiftable [a] where
translateS p x = map (translateS p) x
rotateS r x = map (rotateS r) x
instance Shiftable RoomLink where
translateS q (RL p r) = RL (p +.+ q) r
rotateS s (RL p r) = RL (rotateV s p) (r+s)
instance Shiftable PlacementSpot where
translateS p' (PS p r x) = PS (p +.+ p') r x
rotateS r' (PS p r x) = PS (rotateV r' p) (r + r') x
@@ -133,16 +129,29 @@ addPane c (p0,p1) wls = IM.insert (newKey wls) (Wall { _wlLine = [p0,p1]
placeBt bt p rot w = over buttons addBT w
where addBT bts = IM.insert (newKey bts) (bt {_btPos = p, _btRot = rot, _btID = newKey bts}) bts
placeFlIt itm p rot w = over floorItems addFI w
where addFI fis = IM.insert (newKey fis)
(FlIt
{_flItPos = p
, _flItRot = rot
, _flItID = newKey fis
, _flIt = itm
}
) fis
where
addBT bts = IM.insert (newKey bts) (bt {_btPos = p, _btRot = rot, _btID = newKey bts}) bts
{-
Creates a floor item at a given point.
Assigns an id correctly.
-}
placeFlIt
:: Item
-> Point2 -- ^ Position
-> Float -- ^ Rotation
-> World
-> World
placeFlIt itm p rot = floorItems %~
\ fis -> IM.insert (newKey fis)
(FlIt
{ _flItPos = p
, _flItRot = rot
, _flItID = newKey fis
, _flIt = itm
}
) fis
placePressPlate pp p rot w = over pressPlates addPP w
where addPP pps = IM.insert (newKey pps) (pp {_ppPos = p,_ppRot = rot}) pps
src/Dodge/LevelGen/Data.hs
+1 -1
View File
@@ -22,7 +22,7 @@ data PSType = PutCrit Creature
| PutSwitchDoor Color Point2 Float Point2 Point2
| RandPS (State StdGen PSType)
| PutNothing
| PutID Int
| PutID { _putID :: Int}
| CollectivePS
{ _collectiveID :: Int
, _collectiveNum :: Int
src/Dodge/Lock.hs
+2
View File
@@ -0,0 +1,2 @@
module Dodge.Lock
where
src/Dodge/Lock/Data.hs
+15
View File
@@ -0,0 +1,15 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Lock.Data
where
import Dodge.Data
import Control.Lens
data Lock = Lock
{ _lkUnlocker :: Unlocker
}
data Unlocker
= ItemUnlocker Item
makeLenses ''Lock
src/Dodge/Room.hs
+25 -25
View File
@@ -164,12 +164,12 @@ glassSwitchBack = do
return $ set rmPS plmnts $ roomRect wth hgt 2 6
manyDoors :: Int -> Tree (Either Room Room)
manyDoors i = treePost (replicate i (Left door)) $ Right door
manyDoors i = treeFromPost (replicate i (Left door)) $ Right door
glassLesson :: RandomGen g => State g (Tree (Either Room Room))
glassLesson = do
corridors <- sequence $ replicate 3 $ fmap Left $ randomiseOutLinks corridor
return $ Node (Left $ botRoom) [deadRoom door,uppers, treePost (Left door : corridors) $ Right door]
return $ Node (Left $ botRoom) [deadRoom door,uppers, treeFromPost (Left door : corridors) $ Right door]
where uppers = Node (Left door) [deadRoom topRoom]
botRoom = set rmPS botplmnts
$ roomRect 200 200 1 1
@@ -212,7 +212,7 @@ miniRoom1 = do
miniTree2 :: RandomGen g => State g (Tree (Either Room Room))
miniTree2 = miniRoom1 >>= randomiseOutLinks >>= changeLinkTo (\p -> (snd . fst) p < 70)
>>= return . flip branchWith (replicate 3 $ treePost [door,corridor]
>>= return . flip branchWith (replicate 3 $ treeFromPost [door,corridor]
critInDeadEnd )
miniRoom3 :: RandomGen g => State g (Tree (Either Room Room))
@@ -252,7 +252,7 @@ rot90Around cen p = cen +.+ vNormal (p -.- cen)
-- So, the idea is to attach outer children to the bottommost right nodes
-- inside an inner tree
roomMiniIntro :: RandomGen g => State g (Tree (Either Room Room))
roomMiniIntro = fmap (g . expandTreeBy f) $ sequence $ treePost
roomMiniIntro = fmap (g . expandTreeBy f) $ sequence $ treeFromPost
[return $ connectRoom door
,join $ takeOne [miniTree2,glassLesson]
-- ,join $ takeOne [miniRoom1]
@@ -298,22 +298,22 @@ allPairs xs = [(x,y) | x <- xs, y <- xs, x /= y]
randomCorridorFrom :: RandomGen g => [a] -> State g (Tree (Either a a))
randomCorridorFrom xs = do
rooms <- sequence $ replicate 5 $ takeOne xs
return $ treeTrunk (map Left $ init rooms) (Node (Right (last rooms)) [])
return $ treeFromTrunk (map Left $ init rooms) (Node (Right (last rooms)) [])
{-
Probabilites of the type of the first floor weapon.
-}
randFirstWeapon :: State StdGen PSType
randFirstWeapon = do
-- r <- state $ randomR (-pi,pi)
takeOne $ map PutFlIt
[ pistol
, ltAutoGun
-- , autoGun
, spreadGun
, multGun
, launcher
-- , lasGun
-- , flamer
]
takeOne $ map PutFlIt $
replicate 10 pistol
++ replicate 5 ltAutoGun
++ replicate 5 spreadGun
++ replicate 5 multGun
++ replicate 2 autoGun
++ [launcher]
++ [lasGun]
++ [flamer]
--randC1 :: State StdGen PSType
randC1 = RandPS $ takeOne $ map PutCrit $ (armourChaseCrit : replicate 50 chaseCrit)
@@ -341,13 +341,13 @@ weaponUnderCrits = do
,PS (20,0) (0-pi/2) $ randC1
,PS (20,20) (0-pi/2) $ randC1
]
let continuationRoom = treeTrunk [Left corridorN,Left corridorN]
let continuationRoom = treeFromTrunk [Left corridorN,Left corridorN]
(connectRoom (set rmPS plmnts $ corridorN))
rcp' <- roomCenterPillar
let rcp = over rmPS ( PS (120,80) 0 putLamp : ) rcp'
deadEndRoom <- takeOne [roomPillars,rcp]
junctionRoom <- takeOne [Left tEast,Left tWest]
return $ treeTrunk [Left corridorN,Left corridorN]
return $ treeFromTrunk [Left corridorN,Left corridorN]
$ Node junctionRoom
[continuationRoom
,deadRoom deadEndRoom
@@ -362,7 +362,7 @@ weaponBehindPillar = do
,PS crPos (d crPos) $ randC1
]
rcp <- roomCenterPillar
return $ treeTrunk [Left door
return $ treeFromTrunk [Left door
,Left $ over rmLinks tail $ over rmPS (++ plmnts1) rcp]
(connectRoom $ set rmPS [PS (20,60) (0-pi/2) $ randC1]
$ corridorN)
@@ -389,7 +389,7 @@ blockedCorridor = do
$ reverse $ rectNSWE 10 (-10) (-10) 10
,PS (20,15) 0 $ putLamp
]
sequence $ treePost (replicate n $ fmap Left $ randomiseOutLinks corridor)
sequence $ treeFromPost (replicate n $ fmap Left $ randomiseOutLinks corridor)
$ fmap Right $ return $ set rmPS plmnts corridor
weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room))
@@ -401,8 +401,8 @@ weaponLongCorridor = do
]
i1 <- state $ randomR (2,5)
i2 <- state $ randomR (2,5)
let branch1 = treeTrunk (replicate i1 $ Left corridorN) (connectRoom $ putCrs connectingRoom)
let branch2 = treeTrunk (replicate i2 $ Left corridorN) (deadRoom $ putWp corridor)
let branch1 = treeFromTrunk (replicate i1 $ Left corridorN) (connectRoom $ putCrs connectingRoom)
let branch2 = treeFromTrunk (replicate i2 $ Left corridorN) (deadRoom $ putWp corridor)
return $ Node (Left root) [branch1,branch2]
where putCrs = over rmPS (++ [PS (10,40) (-pi/2) $ randC
,PS (-10,40) (-pi/2) $ randC
@@ -618,7 +618,7 @@ shootingRange = do
>>= filterLinks (\((_,y),r) -> y > 200 && r /= 0)
rm3 <- shootersRoom >>= changeLinkTo (\((x,y),_) -> y < 10 && x > 20 && x < 180)
>>= filterLinks (\(_,r) -> r == 0)
return $ treePost [Left rm1
return $ treeFromPost [Left rm1
,Left $ roomPadCut (rectNSWE 20 (-20) (-80) 80) (0,20)
,Left rm2
,Left $ roomPadCut (rectNSWE 20 (-20) (-80) 80) (0,20)
@@ -639,4 +639,4 @@ spawnerRoom = do
]
let f ((lx,_),_) = lx < x/2-5
roomWithSpawner <- (fmap connectRoom . randomiseOutLinks) =<< filterLinks f (set rmPS plmnts $ roomRect x y 2 2)
return $ treeTrunk [Left (airlock 0)] roomWithSpawner
return $ treeFromTrunk [Left (airlock 0)] roomWithSpawner
src/Dodge/Room/Boss.hs
+12
View File
@@ -7,6 +7,8 @@ import Dodge.Data
import Dodge.Room.Data
import Dodge.Room.Placement
import Dodge.LevelGen.Data
import Dodge.Creature
import Dodge.RandomHelp
import Geometry
import Control.Monad.State
@@ -40,3 +42,13 @@ roomOctogon x = Room
bossRoom :: RandomGen g => Creature -> State g Room
bossRoom cr = pure $ roomOctogon 300 & rmPS %~ ( PS (0,100) (negate $ pi/2) (PutCrit cr) :)
armouredChasers :: RandomGen g => State g Room
armouredChasers = do
ps <- takeN 5 [(x,y) | x <- [-200,-120 .. 200] ,y <- [-200,-120 .. 200] ]
as <- replicateM 5 . state $ randomR (0,2*pi)
let theCrits = zipWith3 (\p a c -> PS p a (PutCrit armourChaseCrit)) ps as cs
pure $ roomOctogon 300 & rmPS %~ (++ theCrits)
where
cs = (armourChaseCrit & crState . crDropsOnDeath .~ DropSpecific [0])
: replicate 4 (armourChaseCrit & crState . crDropsOnDeath .~ DropSpecific [1])
src/Dodge/Room/Branch.hs
+1 -1
View File
@@ -21,7 +21,7 @@ branchRectWith t = do
y <- state $ randomR (100,200)
b <- t
root <- randomiseOutLinks $ roomRectAutoLinks x y
return $ Node (Left root) [Node (Right door) [], fmap rToL $ treeTrunk [Left door] b]
return $ Node (Left root) [Node (Right door) [], fmap rToL $ treeFromTrunk [Left door] b]
where rToL :: Either a a -> Either a a
rToL (Right r) = Left r
rToL (Left r) = Left r
src/Dodge/Room/Data.hs
+9 -17
View File
@@ -7,6 +7,15 @@ import Geometry
import Control.Lens
{-
The '_rmPolys' list states which polygons should be cut out to form the indestructible walls of the room.
Link pairs contain a position and rotation to attach to another room;
0 is for links going to another room to the north, pi/2 for links going to a room to the west, etc.
TODO : Explain path, does it need both directions?
Placement spots allow things to be put in the room during level generation.
Room bounds between a new room and previously placed rooms are checked during level generation,
assigning no bounds will allow rooms to overlap.
-}
data Room = Room
{ _rmPolys :: [ [Point2] ]
, _rmLinks :: [(Point2,Float)]
@@ -14,21 +23,4 @@ data Room = Room
, _rmPS :: [PlacementSpot]
, _rmBound :: [Point2]
}
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/LockAndKeyList.hs
+19
View File
@@ -0,0 +1,19 @@
module Dodge.Room.LockAndKeyList
where
import Dodge.Room.Data
import Dodge.Room.RoadBlock
import Dodge.Room.Boss
import Control.Monad.State
import System.Random
import Data.Tree
lockAndKeyRoomList :: RandomGen g =>
[ (State g (Tree (Either Room Room))
,State g (Tree (Either Room Room))
) ]
lockAndKeyRoomList =
[ ( fmap (pure . Right) armouredCorridor
, fmap (pure . Left) armouredChasers
)
]
src/Dodge/Room/Placement.hs
+33 -3
View File
@@ -3,18 +3,20 @@ module Dodge.Room.Placement
where
import Dodge.Data
import Dodge.LevelGen.Data
import Picture
import Dodge.Room.Data
import Dodge.Creature.Inanimate
import Picture
import Geometry
import Data.List
import Control.Lens
putLamp = PutCrit lamp
singleBlock :: Point2 -> [PlacementSpot]
singleBlock a = [PS a 0 $ PutBlock [5,20,20] (greyN 0.5)
$ reverse $ rectNSWE 10 (-10) (-10) 10]
{-
Places a line of blocks between two points.
Width 9, also extends out from each point by 9.
@@ -88,3 +90,31 @@ baseWindowPane = Block
, _blShadows = []
, _blDegrades = [5,5]
}
{-
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
-> Room
-> 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
that satisfy the predicate, concatenate
the new zipped list and the other (unchanged) half.
-}
subZipWith
:: (a -> Bool) -- ^ Filter: elements to apply zip to
-> (a -> b -> a) -- ^ Combining function
-> [a] -- ^ List to be partition
-> [b] -- ^ Modifying list
-> [a]
subZipWith f g xs ys =
let (zs,ws) = partition f xs
in zipWith g zs ys ++ ws
isPutID i ps = Just i == ps ^? psType . putID
src/Dodge/Room/RoadBlock.hs
+48
View File
@@ -0,0 +1,48 @@
{-
Connecting rooms designed with a pass-through technique in mind.
-}
module Dodge.Room.RoadBlock
where
import Geometry
import Dodge.Room.Data
import Dodge.Room.Link
import Dodge.Room.Placement
import Dodge.LevelGen.Data
import Dodge.RandomHelp
import Dodge.Creature
import Data.Tree
import Control.Monad.State
import System.Random
armouredCorridor :: RandomGen g => State g Room
armouredCorridor = fmap (replacePutID 0 [PutCrit $ addArmour autoCrit]) litCorridor90
{-
A corridor of random length with a 90 degree link at the end.
-}
litCorridor90 :: RandomGen g => State g Room
litCorridor90 = do
h <- state $ randomR (500,800)
let poly = rectNSWE h 0 0 40
poly2 = rectNSWE (h-60) (h-100) (-60) 5
pure $ Room
{ _rmPolys = [poly,poly2]
, _rmLinks = [ ((40,h - 80), -pi/2)
, ((20, 0), pi)
]
, _rmPath = concatMap doublePair
[((20,0),(20,h-40))
,(( 0,h-40),(20,h-40))
,((40,h-40),(20,h-40))
]
, _rmPS =
[ PS (20,h-5) 0 $ putLamp
, windowLine (0,h-20) (40,h-20)
, PS (-50,h-85) 0 $ putLamp
, windowLine (0-40,h-60) (0-40,h-100)
, PS ( 20,h-40) 0 $ PutID 0
, PS (-20,h-80) 0 $ PutID 2
]
, _rmBound = poly
}
src/Dodge/Room/Treasure.hs
+24 -7
View File
@@ -5,10 +5,14 @@ Typically dead ends.
module Dodge.Room.Treasure
where
import Geometry
import Dodge.Data
import Dodge.Room.Data
import Dodge.Room.Placement
import Dodge.LevelGen.Data
import Data.List
import Control.Monad.State
import Control.Lens
import System.Random
{-
@@ -21,18 +25,24 @@ triLootRoom
-> Float -- Height
-> State g Room
triLootRoom w h = pure $ Room
{ _rmPolys = [poly]
, _rmLinks = [((0,10),pi)]
, _rmPath = doublePair ((0,10),(0,h/2))
{ _rmPolys = [ tri
, base
]
, _rmLinks = [((0,-80),pi)]
, _rmPath = doublePair ((0,-80),(0,h/2))
, _rmPS =
[PS (15-w,15) 0 $ PutID 0
,PS (w-15,15) 0 $ PutID 0
,PS (0,h-15) 0 $ PutID 2
,PS (w-15,15) pi $ PutID 0
,PS (0,h-35) 0 $ PutID 2
,PS (-5,h-10) 0 putLamp
,PS (5,h-10) 0 putLamp
,PS (0,h-15) 0 putLamp
,PS (0,-60) 0 putLamp
]
, _rmBound = poly
, _rmBound = convexHull $ tri ++ base
}
where
poly =
tri =
[ ( -w,30)
, ( -w, 0)
, ( w, 0)
@@ -40,3 +50,10 @@ triLootRoom w h = pure $ Room
, ( 20, h)
, (-20, h)
]
base = rectNSWE 20 (-80) (-20) 20
lootRoom :: RandomGen g => [Creature] -> [Item] -> State g Room
lootRoom crs itms = do
let w = 300
h = 700
fmap (replacePutID 0 (map PutCrit crs) . replacePutID 2 (map PutFlIt itms)) $ triLootRoom w h