From 0e88544de2df7f14c67d20e5c1c9f0a88e63257d Mon Sep 17 00:00:00 2001 From: jgk Date: Thu, 22 Apr 2021 13:06:39 +0200 Subject: [PATCH] Implement level portal --- src/Dodge/Creature.hs | 43 +++++++++++---------- src/Dodge/Data.hs | 10 ++++- src/Dodge/Default.hs | 1 + src/Dodge/Floor.hs | 57 ++-------------------------- src/Dodge/Layout/Tree/Annotate.hs | 21 ++++------ src/Dodge/Layout/Tree/Polymorphic.hs | 1 - src/Dodge/Render.hs | 10 +---- src/Dodge/Render/Picture.hs | 1 + src/Dodge/Update.hs | 54 +++++++++++++++++--------- 9 files changed, 83 insertions(+), 115 deletions(-) diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index e08aa429b..f65870692 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -251,29 +251,32 @@ startCr = defaultCreature , _crMass = 10 , _crHP = 10000 , _crMaxHP = 1500 - , _crInv = IM.fromList (zip [0..20] - ( - [pistol - ,blinkGun - ,spawnGun lamp - ,poisonSprayer - ,autoGun - ,launcher - ,lasGun - ,grenade - ,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher - ,longGun - ,hvAutoGun - ,teslaGun - ,latchkey 0 - ,miniGun - ,medkit 50 - ,bezierGun - ] - ++ repeat NoItem)) + , _crInv = startInventory , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ pictures [color (greyN 0.8) $ circleSolid 10, circLine 10] } +startInventory = IM.fromList (zip [0..20] + ( + --[pistol + --,blinkGun + --,spawnGun lamp + --,poisonSprayer + --,autoGun + --,launcher + --,lasGun + --,grenade + --,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher + --,longGun + --,hvAutoGun + --,teslaGun + --,latchkey 0 + --,miniGun + --,medkit 50 + --,bezierGun + --] + -- ++ + repeat NoItem)) + smokeGenGun = effectGun "smoke" $ \_ -> spawnSmokeAtCursor enemyPict :: Color -> Creature -> Picture diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index cf8ac493d..2874958a1 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -70,6 +70,7 @@ data World = World , _storedLevel :: Maybe World , _menuLayers :: [MenuLayer] , _worldState :: M.Map WorldState Bool + , _worldTriggers :: S.Set WorldTrigger , _windowX :: !Float , _windowY :: !Float , _carteDisplay :: !Bool @@ -247,8 +248,13 @@ data Faction | NoFaction deriving (Eq,Show) --- NOTE: walls must be drawn counterclockwise -data WorldState = DoorNumOpen Int | CrNumAlive Int +data WorldState + = DoorNumOpen Int + | CrNumAlive Int + deriving (Eq,Ord) + +data WorldTrigger + = ResetLevel Int deriving (Eq,Ord) data Button = Button diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index bad62e229..db20b9fb8 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -213,6 +213,7 @@ defaultWorld = World , _storedLevel = Nothing , _menuLayers = [LevelMenu 1] , _worldState = M.empty + , _worldTriggers = S.empty , _clickMousePos = (0,0) , _pathGraph = Data.Graph.Inductive.Graph.empty , _pathGraph' = [] diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 6d7bf749c..37af6e0ce 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -1,9 +1,6 @@ module Dodge.Floor - ( lev1 - , levx - , generateLevel - ) - where + ( levx + ) where import Geometry import Picture import Dodge.Data @@ -34,29 +31,14 @@ import System.Random roomTreex :: RandomGen g => State g (Maybe [Room]) roomTreex = do struct' <- aTreeStrut - let struct = Node () [] - -- t <- randomPadCorridors $ fmap (const []) struct - let t' = padCorridors $ fmap (const []) struct + let struct = Node [EndRoom] [] + let t' = padCorridors 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 - struct <- aTreeStrut - let t = padCorridors $ fmap (const []) struct - return . shiftExpandTree $ fmap annoToRoom' t - - levx :: RandomGen g => State g [Room] levx = untilJust roomTreex -lev1 :: RandomGen g => State g (Tree Room) -lev1 = do - struct <- aTreeStrut - let t = padCorridors $ fmap (const []) struct - fmap shiftRoomTree $ mapM annoToRoom t - lev1' :: RandomGen g => State g (Tree Room) lev1' = do firstWeapon <- takeOne $ [[branchRectWith weaponRoom,blockedCorridor]] ++ replicate 5 [weaponRoom] @@ -105,34 +87,3 @@ lev1' = do ] ) $ (fmap connectRoom . randomiseOutLinks) corridor - -roomToLevel2 :: RandomGen g => State g (Tree (Either Room Room)) -roomToLevel2 = join $ takeOne - [ portalRoom1 - ] - -portalRoom1 :: RandomGen g => State g (Tree (Either Room Room)) -portalRoom1 = return $ connectRoom $ (roomRectAutoLinks 300 300) { _rmPS = plmnts} - where plmnts = [PS (0,0) (0-pi/2) $ PutPressPlate (levelPortalAt (200,120) 1) - ,PS (60,100) pi $ PutCrit autoCrit - ] - -generateLevel :: Int -> World -> World -generateLevel i w = - do haltSound $ ((generateFromTree $ levelTree i) w) - -levelTree :: Int -> State StdGen (Tree Room) -levelTree 1 = lev1 - -levelPortalAt :: Point2 -> Int -> PressPlate -levelPortalAt p x - = PressPlate - { _ppPict = onLayer PressPlateLayer $ color blue $ circle 10 - , _ppPos = p - , _ppRot = 0 - , _ppEvent = \pp w -> if dist (_crPos (you w)) (_ppPos pp) < 10 - then generateLevel x w - else w - , _ppID = -1 - , _ppText = "Portal to level "++ show x - } diff --git a/src/Dodge/Layout/Tree/Annotate.hs b/src/Dodge/Layout/Tree/Annotate.hs index ef7fe56ba..07b788a9e 100644 --- a/src/Dodge/Layout/Tree/Annotate.hs +++ b/src/Dodge/Layout/Tree/Annotate.hs @@ -10,6 +10,8 @@ import Dodge.Room.Procedural import Dodge.Room.Link import Dodge.Room.Data import Dodge.Room +import Dodge.Room.Teleport +--import Dodge.Floor import Data.Tree import Control.Monad.State @@ -21,6 +23,7 @@ data Annotation | Corridor | FirstWeapon | StartRoom + | EndRoom addLock :: RandomGen g => Int -> Tree [Annotation] -> State g (Tree [Annotation]) addLock i t = do @@ -40,24 +43,16 @@ randomPadCorridors (Node x xs) = do annoToRoomTree :: RandomGen g => [Annotation] -> State g (Tree (Either Room Room)) annoToRoomTree [Corridor] = fmap (pure . Right) $ randomiseOutLinks corridor annoToRoomTree [FirstWeapon] = do - --firstWeapon <- takeOne $ [[branchRectWith weaponRoom,blockedCorridor]] ++ replicate 5 [weaponRoom] branchWP <- branchRectWith weaponRoom blockedC <- blockedCorridor firstWeapon <- takeOne $ [return $ appendEitherTree branchWP [blockedC]] ++ replicate 5 weaponRoom - --firstWeapon <- takeOne $ replicate 5 weaponRoom firstWeapon +annoToRoomTree [EndRoom] = fmap (pure . Right) (telRoomLev 1) +annoToRoomTree [StartRoom] = do + w <- state $ randomR (100,400) + h <- state $ randomR (200,400) + fmap (pure . Right) $ return (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h) >>= randomiseOutLinks 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] = 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 -annoToRoom' _ = roomRectAutoLinks 200 200 diff --git a/src/Dodge/Layout/Tree/Polymorphic.hs b/src/Dodge/Layout/Tree/Polymorphic.hs index cd8f2f383..f8667f243 100644 --- a/src/Dodge/Layout/Tree/Polymorphic.hs +++ b/src/Dodge/Layout/Tree/Polymorphic.hs @@ -108,4 +108,3 @@ splitTrunk :: RandomGen g => Tree a -> State g (Tree a, [Tree a]) splitTrunk t = do i <- state $ randomR (0, trunkDepth t) return $ splitTrunkAt i t - diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 7fc6b254f..05c0c3ff6 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -6,28 +6,23 @@ module Dodge.Render where import Dodge.Data import Dodge.Base - import Dodge.Render.HUD import Dodge.Render.MenuScreen import Dodge.Render.Picture import Dodge.Render.PerspectiveMatrix - import Geometry import Picture -import Shader - import Picture.Render import Picture.Preload +import Shader import Data.Graph.Inductive.Query.DFS import Data.Graph.Inductive.Graph - import Control.Monad.State import Data.List import Data.Bifunctor - -import Foreign (Word32) import Data.Function +import Foreign (Word32) import Control.Applicative import Control.Lens import Data.Maybe @@ -35,7 +30,6 @@ import qualified Data.IntMap.Strict as IM import qualified Data.Map as M import qualified Data.Set as S import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate) - import qualified SDL doDrawing :: RenderData -> World -> IO (Word32) diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 3f95003db..52818a379 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -20,6 +20,7 @@ worldPictures w = pictures $ concat , map drawItem . IM.elems $ _floorItems w , map crDraw . IM.elems $ _creatures w , map clDraw . IM.elems $ _clouds w + , map ppDraw . IM.elems $ _pressPlates w , map btDraw (IM.elems (_buttons w)) , map (\pt -> _ptDraw pt pt) $ _particles' w , map drawWallFloor (wallFloorsToDraw w) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index c42cc8688..4044618ed 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -13,6 +13,9 @@ import Dodge.Update.Camera import Dodge.Update.UsingInput import Dodge.SoundLogic import Dodge.Inventory +import Dodge.Initialisation +import Dodge.Layout +import Dodge.Floor import Geometry import Data.List @@ -38,23 +41,26 @@ update' :: World -> World update' w = case _menuLayers w of (ConfigSaveScreen : ls) -> w & menuLayers .~ ls (_ : _) -> w - [] -> let w1 = updateParticles' . updateProjectiles - . updateLightSources - . zoneClouds - . updateClouds - . updateCreatures - . updateBlocks -- . zoning - . updateSeenWalls - . updateSoundQueue - $ updateCloseObjects w - in checkEndGame . ppEvents - . updateCamera - . colCrsWalls - . simpleCrSprings - . zoneCreatures - . wallEvents - . set worldEvents id - $ _worldEvents w1 w1 + [] -> let w1 = updateParticles' + . updateProjectiles + . updateLightSources + . zoneClouds + . updateClouds + . updateCreatures + . updateBlocks -- . zoning + . updateSeenWalls + . updateSoundQueue + $ updateCloseObjects w + in checkEndGame + . triggerUpdate + . ppEvents + . updateCamera + . colCrsWalls + . simpleCrSprings + . zoneCreatures + . wallEvents + . set worldEvents id + $ _worldEvents w1 w1 where zoneCreatures = set creaturesZone (IM.foldr creatureInZone IM.empty (_creatures w)) creatureInZone cr = insertIMInZone x y cid cr @@ -65,6 +71,18 @@ update' w = case _menuLayers w of where (x,y) = zoneOfPoint $ _clPos cr cid = _clID cr +triggerUpdate :: World -> World +triggerUpdate w + | ResetLevel 1 `S.member` _worldTriggers w + = generateFromList levx + $ initialWorld + & randGen .~ _randGen w + & windowX .~ _windowX w + & windowY .~ _windowY w + & menuLayers .~ [] + & creatures . ix 0 .~ (_creatures w IM.! 0 & crPos .~ (0,0)) + | otherwise = w + updateSoundQueue = set soundQueue [] . set sounds M.empty @@ -94,7 +112,7 @@ wallEvents w = IM.foldr (_doorMech) w ( IM.filter (\d -> case d of _ -> False) ( _walls w)) ppEvents :: World -> World -ppEvents w = IM.foldr' (\pp w -> _ppEvent pp pp w) w $ _pressPlates w +ppEvents w = IM.foldr (\pp w -> _ppEvent pp pp w) w $ _pressPlates w updateSeenWalls :: World -> World updateSeenWalls w = foldr markSeen w wallsToUpdate