From 3bc57ff65064964e86dcb0ece273b1c9d41df85f Mon Sep 17 00:00:00 2001 From: jgk Date: Mon, 26 Apr 2021 11:41:04 +0200 Subject: [PATCH] Start to implement lock and key system --- src/Dodge/AIs.hs | 2 +- src/Dodge/Creature.hs | 5 ++- src/Dodge/Data.hs | 5 +++ src/Dodge/Floor.hs | 21 ++++++++---- src/Dodge/Item/Weapon.hs | 21 +++++------- src/Dodge/Layout/Tree/Annotate.hs | 8 +++-- src/Dodge/Layout/Tree/Polymorphic.hs | 32 ++++++++++++++---- src/Dodge/LevelGen.hs | 37 ++++++++++++-------- src/Dodge/LevelGen/Data.hs | 2 +- src/Dodge/Lock.hs | 2 ++ src/Dodge/Lock/Data.hs | 15 +++++++++ src/Dodge/Room.hs | 50 ++++++++++++++-------------- src/Dodge/Room/Boss.hs | 12 +++++++ src/Dodge/Room/Branch.hs | 2 +- src/Dodge/Room/Data.hs | 26 +++++---------- src/Dodge/Room/LockAndKeyList.hs | 19 +++++++++++ src/Dodge/Room/Placement.hs | 36 ++++++++++++++++++-- src/Dodge/Room/RoadBlock.hs | 48 ++++++++++++++++++++++++++ src/Dodge/Room/Treasure.hs | 31 +++++++++++++---- 19 files changed, 276 insertions(+), 98 deletions(-) create mode 100644 src/Dodge/Lock.hs create mode 100644 src/Dodge/Lock/Data.hs create mode 100644 src/Dodge/Room/LockAndKeyList.hs create mode 100644 src/Dodge/Room/RoadBlock.hs diff --git a/src/Dodge/AIs.hs b/src/Dodge/AIs.hs index c4931ab6e..9d89400a2 100644 --- a/src/Dodge/AIs.hs +++ b/src/Dodge/AIs.hs @@ -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 diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index b47f7611a..e1a291e68 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 16e3cad6c..d6acff641 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 #-} diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 40180b361..bcf8b296a 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -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 ] diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 7f1ea0ec2..8de0d7cee 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -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 diff --git a/src/Dodge/Layout/Tree/Annotate.hs b/src/Dodge/Layout/Tree/Annotate.hs index 4de4eb1ad..bddb2d718 100644 --- a/src/Dodge/Layout/Tree/Annotate.hs +++ b/src/Dodge/Layout/Tree/Annotate.hs @@ -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) diff --git a/src/Dodge/Layout/Tree/Polymorphic.hs b/src/Dodge/Layout/Tree/Polymorphic.hs index f8667f243..847e9f800 100644 --- a/src/Dodge/Layout/Tree/Polymorphic.hs +++ b/src/Dodge/Layout/Tree/Polymorphic.hs @@ -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 diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 0dfa77519..c075111ad 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -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 diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index 174e699fc..3233fc87a 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -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 diff --git a/src/Dodge/Lock.hs b/src/Dodge/Lock.hs new file mode 100644 index 000000000..31a97c00c --- /dev/null +++ b/src/Dodge/Lock.hs @@ -0,0 +1,2 @@ +module Dodge.Lock + where diff --git a/src/Dodge/Lock/Data.hs b/src/Dodge/Lock/Data.hs new file mode 100644 index 000000000..edaf5d4f8 --- /dev/null +++ b/src/Dodge/Lock/Data.hs @@ -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 diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index e094005a5..54a78a9e3 100644 --- a/src/Dodge/Room.hs +++ b/src/Dodge/Room.hs @@ -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 diff --git a/src/Dodge/Room/Boss.hs b/src/Dodge/Room/Boss.hs index 1b166403b..9ed8e68a0 100644 --- a/src/Dodge/Room/Boss.hs +++ b/src/Dodge/Room/Boss.hs @@ -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]) diff --git a/src/Dodge/Room/Branch.hs b/src/Dodge/Room/Branch.hs index f91d6d38b..a8fd7d269 100644 --- a/src/Dodge/Room/Branch.hs +++ b/src/Dodge/Room/Branch.hs @@ -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 diff --git a/src/Dodge/Room/Data.hs b/src/Dodge/Room/Data.hs index 26b771c99..3c279b95a 100644 --- a/src/Dodge/Room/Data.hs +++ b/src/Dodge/Room/Data.hs @@ -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] - } diff --git a/src/Dodge/Room/LockAndKeyList.hs b/src/Dodge/Room/LockAndKeyList.hs new file mode 100644 index 000000000..60b4e3702 --- /dev/null +++ b/src/Dodge/Room/LockAndKeyList.hs @@ -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 + ) + ] diff --git a/src/Dodge/Room/Placement.hs b/src/Dodge/Room/Placement.hs index 0f6f75896..2bfad1ba3 100644 --- a/src/Dodge/Room/Placement.hs +++ b/src/Dodge/Room/Placement.hs @@ -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 diff --git a/src/Dodge/Room/RoadBlock.hs b/src/Dodge/Room/RoadBlock.hs new file mode 100644 index 000000000..0d5d4454c --- /dev/null +++ b/src/Dodge/Room/RoadBlock.hs @@ -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 + } diff --git a/src/Dodge/Room/Treasure.hs b/src/Dodge/Room/Treasure.hs index 5d8c9edd9..d93f05fef 100644 --- a/src/Dodge/Room/Treasure.hs +++ b/src/Dodge/Room/Treasure.hs @@ -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