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

Implement level portal

Browse Source
This commit is contained in:
jgk
2021-04-22 13:06:39 +02:00
parent 60b2327909
commit 0e88544de2
9 changed files with 83 additions and 115 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature.hs
+23 -20
View File
@@ -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
src/Dodge/Data.hs
+8 -2
View File
@@ -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
src/Dodge/Default.hs
+1
View File
@@ -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' = []
src/Dodge/Floor.hs
+4 -53
View File
@@ -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
}
src/Dodge/Layout/Tree/Annotate.hs
+8 -13
View File
@@ -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
src/Dodge/Layout/Tree/Polymorphic.hs
-1
View File
@@ -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
src/Dodge/Render.hs
+2 -8
View File
@@ -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)
src/Dodge/Render/Picture.hs
+1
View File
@@ -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)
src/Dodge/Update.hs
+36 -18
View File
@@ -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