From 9db091597dc3e2c3d91cb1acd7dc70f758e58123 Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 17 Nov 2021 11:24:40 +0000 Subject: [PATCH] Add indexed world modifications, example use in flicker lights --- src/Dodge/Data.hs | 11 +++ src/Dodge/Default/World.hs | 1 + src/Dodge/Initialisation.hs | 2 +- src/Dodge/LevelGen.hs | 8 +- src/Dodge/LevelGen/Data.hs | 5 +- src/Dodge/Placement/Instance/Button.hs | 6 +- src/Dodge/Placement/Instance/LightSource.hs | 6 ++ src/Dodge/Placement/PlaceSpot.hs | 1 + src/Dodge/Room/Start.hs | 96 +++++++++++++++------ src/Dodge/Update.hs | 6 ++ 10 files changed, 110 insertions(+), 32 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 64b76d14f..35468f9bd 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -70,6 +70,7 @@ data World = World , _randGen :: StdGen , _mousePos :: !Point2 , _testString :: World -> [String] + , _modifications :: IM.IntMap Modification , _yourID :: !Int , _worldEvents :: World -> World , _pressPlates :: IM.IntMap PressPlate @@ -484,6 +485,15 @@ data PjParam = PjParam , _pjMaxParam :: Int , _pjDisplayParam :: Int -> String } +data Modification + = ModIDTimerPoint3Bool + { _mdID :: Int + , _mdExternalID :: Int + , _mdUpdate :: Modification -> World -> World + , _mdTimer :: Int + , _mdPoint3 :: Point3 + , _mdBool :: Bool + } data Prop = Projectile { _pjPos :: Point2 @@ -792,6 +802,7 @@ makeLenses ''FloorItem makeLenses ''Ammo makeLenses ''PjParam makeLenses ''Prop +makeLenses ''Modification makeLenses ''Particle makeLenses ''Wall makeLenses ''WallStructure diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 9e896fae4..0b4ec2a32 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -26,6 +26,7 @@ defaultWorld = World , _cameraRot = 0 , _cameraZoom = 1 , _cameraViewFrom = V2 0 0 + , _modifications = IM.empty , _creatures = IM.empty , _creaturesZone = Zone IM.empty , _creatureGroups = IM.empty diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 41664ae83..8ce51679a 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -31,7 +31,7 @@ initialWorld = defaultWorld , _yourID = 0 , _worldEvents = saveWorldInEmptySlot LevelStartSlot . soundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing - . foldr ((.) . makeStartCloudAt) id [V3 x y 5 | x <- [-5,-3..5] , y <- [-5,-3..5]] + . foldr ((.) . makeStartCloudAt) id [V3 x y 5 | x <- [-5,-4..5] , y <- [-5,-4..5]] , _pressPlates = IM.empty , _buttons = IM.empty , _toPlaySounds = M.empty diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 3252c44b8..91cca547a 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -7,11 +7,17 @@ import Dodge.Data import Dodge.Floor import Dodge.Layout import Dodge.Initialisation +import Dodge.RandomHelp import System.Random +import Control.Lens +import Control.Monad.State generateWorldFromSeed :: Int -> IO World generateWorldFromSeed i = do roomList <- layoutLevelFromSeed 0 i - return $ generateLevelFromRoomList roomList + return $ randomCompass $ generateLevelFromRoomList roomList initialWorld{_randGen=mkStdGen i} + +randomCompass :: World -> World +randomCompass w = w & cameraRot .~ (takeOne [0,0.5*pi,pi,1.5*pi] & evalState $ _randGen w) diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index 13408591e..a6d329680 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -22,6 +22,7 @@ data PSType = PutCrit {_unPutCrit :: Creature} | PutPressPlate PressPlate | PutBlock [Int] Color [Point2] | PutCoordinate Point2 + | PutMod Modification | PutTrigger (World -> Bool) | PutLineBlock Wall Float Float Point2 Point2 | PutWall { _pwPoly :: [Point2] , _pwWall :: Wall } @@ -104,8 +105,8 @@ spNoID ps pst = Placement ps pst Nothing (const Nothing) pContID :: PlacementSpot -> PSType -> (Int -> Maybe Placement) -> Placement pContID ps pt = Placement ps pt Nothing . intPlPlPl -plCont :: PlacementSpot -> PSType -> (Placement -> Maybe Placement) -> Placement -plCont ps pt = Placement ps pt Nothing +psPtCont :: PlacementSpot -> PSType -> (Placement -> Maybe Placement) -> Placement +psPtCont ps pt = Placement ps pt Nothing sPS :: Point2 -> Float -> PSType -> Placement sPS p a pt = Placement (PS p a) pt Nothing (const Nothing) diff --git a/src/Dodge/Placement/Instance/Button.hs b/src/Dodge/Placement/Instance/Button.hs index 49cfdab9d..20a83ce67 100644 --- a/src/Dodge/Placement/Instance/Button.hs +++ b/src/Dodge/Placement/Instance/Button.hs @@ -14,7 +14,7 @@ import Data.Maybe import Control.Lens triggerSwitchSPic :: (Button -> SPic) -> PlacementSpot -> Placement -triggerSwitchSPic sdraw ps = plCont ps (PutTrigger (const False)) +triggerSwitchSPic sdraw ps = psPtCont ps (PutTrigger (const False)) $ \tp -> Just $ pContID ps (PutButton (makeSwitchSPic sdraw (oneff $ trigid tp) (offeff $ trigid tp))) (const Nothing) where @@ -23,7 +23,7 @@ triggerSwitchSPic sdraw ps = plCont ps (PutTrigger (const False)) offeff tid = triggers . ix tid .~ const False triggerSwitchSPicLight :: (Button -> SPic) -> PlacementSpot -> Placement -triggerSwitchSPicLight sdraw ps = plCont ps (PutTrigger (const False)) +triggerSwitchSPicLight sdraw ps = psPtCont ps (PutTrigger (const False)) $ \tp -> Just $ pContID fstLnkOut (PutLS thels) $ \lsid -> Just $ pContID ps (PutButton (makeSwitchSPic sdraw (oneff lsid $ trigid tp) (offeff lsid $ trigid tp))) @@ -37,7 +37,7 @@ triggerSwitchSPicLight sdraw ps = plCont ps (PutTrigger (const False)) offeff lsid tid = eff lsid tid False (V3 0.5 0 0) triggerSwitch :: Color -> PlacementSpot -> Placement -triggerSwitch col ps = plCont ps (PutTrigger (const False)) +triggerSwitch col ps = psPtCont ps (PutTrigger (const False)) $ \tp -> Just $ pContID ps (PutButton (makeSwitch col col (oneff $ trigid tp) (offeff $ trigid tp))) (const Nothing) where diff --git a/src/Dodge/Placement/Instance/LightSource.hs b/src/Dodge/Placement/Instance/LightSource.hs index c1e0619d3..315d7e9c6 100644 --- a/src/Dodge/Placement/Instance/LightSource.hs +++ b/src/Dodge/Placement/Instance/LightSource.hs @@ -101,6 +101,12 @@ unusedLnkToPS rp = case rp of UnusedLink p a -> Just $ PS p a _ -> Nothing +spanLSLightI :: LightSource -> Float -> Point2 -> Point2 -> Placement +spanLSLightI ls h a b = ps0j (PutLS ls {_lsPos = V3 x y h}) + $ sps0 $ PutForeground $ thinHighBar h a b + where + V2 x y = 0.5 *.* (a +.+ b) + spanColLightI :: Point3 -> Float -> Point2 -> Point2 -> Placement spanColLightI col h a b = ps0j (PutLS $ colorLightAt col (V3 x y (h-5)) 0) $ sps0 $ PutForeground $ thinHighBar h a b diff --git a/src/Dodge/Placement/PlaceSpot.hs b/src/Dodge/Placement/PlaceSpot.hs index dbfc7b97a..dad2a29da 100644 --- a/src/Dodge/Placement/PlaceSpot.hs +++ b/src/Dodge/Placement/PlaceSpot.hs @@ -90,6 +90,7 @@ shiftPSBy (pos,rot) ps = ps placeSpotID :: PlacementSpot -> PSType -> World -> (Int, World) placeSpotID ps pt w = case pt of PutTrigger cond -> placeNewInto triggers cond w + PutMod modi -> plNewUpID modifications mdID modi w PutProp prop -> plNewUpID props pjID (mvProp p rot prop) w PutButton bt -> plNewUpID buttons btID (mvButton p rot bt) w PutFlIt itm -> plNewUpID floorItems flItID (createFlIt p rot itm) w diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index 4686a70f8..c4cad4588 100644 --- a/src/Dodge/Room/Start.hs +++ b/src/Dodge/Room/Start.hs @@ -1,6 +1,7 @@ module Dodge.Room.Start where import Dodge.LevelGen.Data import Dodge.Data +import Dodge.Default import Dodge.Layout.Tree.Either import Dodge.RandomHelp import Dodge.Room.Door @@ -23,24 +24,63 @@ import Data.Tree import Control.Monad.State import Control.Lens import System.Random ---import qualified Data.IntMap.Strict as IM +import Data.Maybe +import qualified Data.IntMap.Strict as IM -rezBox :: Room -rezBox = roomRect 40 60 1 1 - & rmPmnts .~ [ spanColLightI rezcol 95 (V2 0 1) (V2 40 1) ] +rezBox :: LightSource -> Room +rezBox ls = roomRect 40 60 1 1 + & rmPmnts .~ [ sPS (V2 20 1) 0 $ PutLS ls] +rezColor :: RandomGen g => State g LightSource +rezColor = do + col <- takeOne [V3 0.0 0.1 0.5, V3 0.0 0.5 0.1] + h <- takeOne [30,50,80,90,90,90,90] + rad <- takeOne [150,200,200,250,250,300,300,300] + return defaultLS + { _lsPos = V3 0 0 h + , _lsIntensity = col + , _lsRad = rad + } -rezcol :: Point3 -rezcol = V3 0.0 0.1 0.5 +rezInvBox :: LightSource -> Room +rezInvBox = (rmLinks %~ reverse) . rezBox -rezInvBox :: Room -rezInvBox = roomRect 40 60 1 1 - & rmPmnts .~ [ spanColLightI rezcol 95 (V2 0 59) (V2 40 59) ] +crAdd :: Room -> Room +crAdd = rmPmnts %~ (sPS (V2 20 10) (0.5*pi) randC1 :) -crRezBox :: Room -crRezBox = rezInvBox & rmPmnts %~ (sPS (V2 20 50) (1.5*pi) randC1 :) +wpAdd :: Item -> Room -> Room +wpAdd wp = rmPmnts %~ f + where + f (x:xs) = sPS (V2 15 30) 1 (PutFlIt wp) : g x : xs + f _ = [sPS (V2 15 30) 1 (PutFlIt wp)] + g x = x & plIDCont .~ flickerMod -wpRezBox :: Item -> Room -wpRezBox wp = rezInvBox & rmPmnts %~ (sPS (V2 15 30) 1 (PutFlIt wp) :) +-- TODO move this to a sensible place +-- Supposes the orginal placement is a light source, adds a flickermod +flickerMod :: Placement -> Maybe Placement +flickerMod pl = Just $ sps0 $ PutMod $ ModIDTimerPoint3Bool + { _mdID = 0 + , _mdExternalID = fromJust $ _plMID pl + , _mdUpdate = flickerUpdate + , _mdTimer = 10 + , _mdPoint3 = 0.8 + , _mdBool = True + } + +flickerUpdate :: Modification -> World -> World +flickerUpdate md w + | _mdTimer md > 0 = w & modifications . ix mdid . mdTimer -~ 1 + | otherwise = w & lightSources . ix lsid . lsIntensity .~ mdcol + & modifications . ix mdid + %~ ( (mdTimer .~ newtime) . (mdPoint3 .~ lscol) . (mdBool %~ not) ) + where + mdcol = _mdPoint3 md + lscol = _lsIntensity $ _lightSources w IM.! lsid + lsid = _mdExternalID md + mdid = _mdID md + timerange + | _mdBool md = (2,10) + | otherwise = (2,30) + (newtime,_) = randomR timerange $ _randGen w rezBoxesThenWeaponRoom :: RandomGen g => State g (Tree (Either Room Room)) rezBoxesThenWeaponRoom = do @@ -49,7 +89,9 @@ rezBoxesThenWeaponRoom = do return $ rboxes `appendEitherTree` [wroom] rezBoxThenWeaponRoom :: RandomGen g => State g (Tree (Either Room Room)) -rezBoxThenWeaponRoom = treeFromTrunk [Left rezBox,Left door] <$> weaponRoom +rezBoxThenWeaponRoom = do + rcol <- rezColor + treeFromTrunk [Left $ rezBox rcol,Left door] <$> weaponRoom startRoom :: RandomGen g => State g (Tree (Either Room Room)) startRoom = join $ takeOne @@ -63,9 +105,11 @@ rezBoxesWpCrit :: RandomGen g => State g (Tree (Either Room Room)) rezBoxesWpCrit = do w <- state $ randomR (200,400) h <- state $ randomR (40,40) + thecol <- rezColor theweapon <- randBlockBreakWeapon let bottomEdgeTest (V2 _ y,_) = y < 1 bottomLeftTest (V2 x y,_) = y < 1 && x < 21 + aroom = rezInvBox thecol centralRoom <- filterSortOutLinksOn bottomEdgeTest ((\(V2 a b) -> (b,a)) . fst) <$> (randomiseOutLinks =<< changeLinkTo bottomLeftTest ((roomRectAutoLinks w h) {_rmPmnts = []})) @@ -74,10 +118,10 @@ rezBoxesWpCrit = do j <- state $ randomR (i,n-2) blcor <- blockedCorridor' let rezrooms = map adddoor - $ insertAt i (wpRezBox theweapon) - $ insertAt j crRezBox - $ replicate (n-3) rezInvBox - return $ treeFromTrunk [Left rezBox + $ insertAt i (wpAdd theweapon aroom) + $ insertAt j (crAdd aroom) + $ replicate (n-3) aroom + return $ treeFromTrunk [Left $ rezBox thecol , Left door ] (Node (Left centralRoom) (rezrooms ++ [onwardtree blcor])) @@ -90,20 +134,21 @@ rezBoxesWp = do w <- state $ randomR (100,400) h <- state $ randomR (40,40) theweapon <- randBlockBreakWeapon + thecol <- rezColor let bottomEdgeTest (V2 _ y,_) = y < 1 + aroom = rezInvBox thecol centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest ((roomRectAutoLinks w h) {_rmPmnts = []}) blcor <- blockedCorridor' let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom let rezrooms = map adddoor - $ wpRezBox theweapon : replicate (n-2) rezInvBox + $ wpAdd theweapon aroom : replicate (n-2) aroom centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom - return $ treeFromTrunk [Left rezBox + return $ treeFromTrunk [Left $ rezBox thecol , Left door ] (Node (Left centralRoom') (rezrooms ++ [onwardtree blcor])) where - --dbox = treeFromPost [Left door] (Left rezInvBox) adddoor rm = treeFromPost [Left door] (Left rm) onwardtree blcor = treeFromPost [Left door] (Right blcor) @@ -111,17 +156,17 @@ rezBoxes :: RandomGen g => State g (Tree (Either Room Room)) rezBoxes = do w <- state $ randomR (100,400) h <- state $ randomR (40,40) + thecol <- rezColor let bottomEdgeTest (V2 _ y,_) = y < 1 + dbox = treeFromPost [Left door] (Left $ rezInvBox thecol) centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest ((roomRectAutoLinks w h) {_rmPmnts = []}) let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom - return $ treeFromTrunk [Left rezBox + return $ treeFromTrunk [Left $ rezBox thecol , Left door ] (Node (Left centralRoom') (replicate (n-1) dbox ++ [Node (Right door) []])) - where - dbox = treeFromPost [Left door] (Left rezInvBox) startRoom' :: RandomGen g => State g (Tree (Either Room Room)) startRoom' = do @@ -137,7 +182,8 @@ startRoom' = do , putLasTurret & plSpot .~ PS (V2 (0.8*w) (0.8*h)) 0 , sps0 $ PutForeground $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25) ] - treeFromPost [Left rezBox, Left door] . Right + thecol <- rezColor + treeFromPost [Left $ rezBox thecol, Left door] . Right <$> randomiseOutLinks (shiftRoomBy (V2 (-20) (-20),0) ( roomRectAutoLinks w h & rmPmnts %~ (plmnts ++) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 00eb8fa8f..682123633 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -58,6 +58,7 @@ functionalUpdate w = case _menuLayers w of . updateDoors . resetWorldEvents . dbArg _worldEvents + . updateModifications . updateParticles . updateProjectiles . updateLightSources @@ -82,6 +83,11 @@ functionalUpdate w = case _menuLayers w of where (x,y) = cloudZoneOfPoint $ stripZ $ _clPos cl +updateModifications :: World -> World +updateModifications w = foldr f w (_modifications w) + where + f md = _mdUpdate md md + splinterBlock :: Block -> World -> World splinterBlock bl w = foldr unshadowBlock w (_blShadows bl) -- foldr shiftTowardCen w (_blWallIDs bl) & blocks . ix (_blID bl) . blHPs %~ tail