From 43e7d20b21125f9d5a9a002bade83ce380b43313 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 22 Jul 2022 14:30:53 +0100 Subject: [PATCH] Refactor world events --- src/Dodge/Data.hs | 12 +++++++----- src/Dodge/Data/WorldEffect.hs | 8 ++++++++ src/Dodge/Default/World.hs | 10 +++------- src/Dodge/Event/Keyboard.hs | 3 ++- src/Dodge/HeldUse.hs | 2 +- src/Dodge/Initialisation.hs | 6 ++---- src/Dodge/Item/Weapon/TriggerType.hs | 23 ++++++++++------------- src/Dodge/Render/HUD.hs | 3 ++- src/Dodge/Update.hs | 15 +++++++-------- src/Dodge/WorldEffect.hs | 15 +++++++++++++++ src/Dodge/WorldPos.hs | 9 +++++++++ src/Dodge/Zoning.hs | 2 ++ src/Dodge/Zoning/Base.hs | 20 ++++++++++++++++++++ src/Dodge/Zoning/Creature.hs | 7 +++++++ 14 files changed, 95 insertions(+), 40 deletions(-) create mode 100644 src/Dodge/WorldPos.hs create mode 100644 src/Dodge/Zoning.hs create mode 100644 src/Dodge/Zoning/Base.hs create mode 100644 src/Dodge/Zoning/Creature.hs diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index b6dd91509..dbb8de46c 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -223,8 +223,8 @@ data World = World , _randGen :: StdGen , _modifications :: IM.IntMap Modification , _yourID :: Int - , _worldEvents :: World -> World - , _delayedEvents :: [(Int,World -> World)] + , _worldEvents :: [WorldEffect] + , _delayedEvents :: [(Int,WorldEffect)] , _pressPlates :: IM.IntMap PressPlate , _buttons :: IM.IntMap Button , _toPlaySounds :: M.Map SoundOrigin Sound @@ -241,7 +241,7 @@ data World = World , _tempLightSources :: [TempLightSource] , _closeObjects :: [Either FloorItem Button] , _rbOptions :: RightButtonOptions - , _seenLocations :: IM.IntMap (World -> Point2,String) + , _seenLocations :: IM.IntMap (WdP2,String) , _selLocation :: Int , _sideEffects :: Universe -> IO Universe , _distortions :: [Distortion] @@ -272,6 +272,7 @@ data WorldHammer newtype GenParams = GenParams { _sensorCoding :: M.Map DamageType (PaletteColor,DecorationShape) } + deriving (Eq,Ord,Show,Read) data DecorationShape = PLUS | SQUARE | CIRCLE | THREELINES deriving (Eq,Ord,Enum,Show,Read) @@ -279,12 +280,13 @@ data TimeFlowStatus = RewindingNow | RewindingLastFrame | NormalTimeFlow - deriving (Eq,Ord) + deriving (Eq,Ord,Show,Read) data SaveSlot = QuicksaveSlot | LevelStartSlot - deriving (Eq,Ord) + deriving (Eq,Ord,Show,Read) data OptionScreenFlag = NormalOptions | GameOverOptions + deriving (Eq,Ord,Show,Read) data ScreenLayer = OptionScreen { _scTitle :: Universe -> String diff --git a/src/Dodge/Data/WorldEffect.hs b/src/Dodge/Data/WorldEffect.hs index c844d7254..236db65dc 100644 --- a/src/Dodge/Data/WorldEffect.hs +++ b/src/Dodge/Data/WorldEffect.hs @@ -1,8 +1,16 @@ module Dodge.Data.WorldEffect where +import Sound.Data import Geometry.Data +import Dodge.Data.SoundOrigin data WorldEffect = NoWorldEffect | SetTrigger Bool Int | WorldEffects [WorldEffect] | SetLSCol Point3 Int | AccessTerminal (Maybe Int) + | UnlockInv Int + | SoundStart SoundOrigin Point2 SoundID (Maybe Int) + | MakeStartCloudAt Point3 + | TorqueCr Float Int +data WdP2 = WdP2Const Point2 + | WdYouPos diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index a91d4dc37..770b74621 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -2,12 +2,8 @@ module Dodge.Default.World where import Dodge.Data import Dodge.Zone.Size import Dodge.Zone.Object -import Dodge.Base import Geometry.Vector3D import Geometry.Zone ---import Dodge.Config.KeyConfig ---import Dodge.Menu ---import Picture import Geometry.Data import Geometry.Polygon @@ -67,7 +63,7 @@ defaultWorld = World , _randGen = mkStdGen 2 , _mousePos = V2 0 0 , _yourID = 0 - , _worldEvents = id + , _worldEvents = [] , _delayedEvents = [] , _pressPlates = IM.empty , _buttons = IM.empty @@ -93,8 +89,8 @@ defaultWorld = World , _closeObjects = [] , _rbOptions = NoRightButtonOptions , _seenLocations = IM.fromList - [(0, (_crPos . you, "CURRENT POSITION")) - ,(1, (const (V2 0 0) , "START POSITION")) + [(0, (WdYouPos, "CURRENT POSITION")) + ,(1, (WdP2Const (V2 0 0) , "START POSITION")) ] , _selLocation = 0 --, _keyConfig = defaultKeyConfigSDL diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index e2dfe7f8c..370c3a2ed 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -4,6 +4,7 @@ module Dodge.Event.Keyboard , handleTextInput , guardDisconnectedID ) where +import Dodge.WorldPos import Dodge.Button.Event import Dodge.Terminal import Dodge.InputFocus @@ -134,7 +135,7 @@ spaceAction w = case _hudElement $ _hud w of DisplayInventory DisplayTerminal {} -> w & hud . hudElement .~ DisplayInventory NoSubInventory _ -> w & hud . hudElement .~ DisplayInventory NoSubInventory where - theLoc = fst (_seenLocations w IM.! _selLocation w) w + theLoc = doWorldPos (fst (_seenLocations w IM.! _selLocation w)) w -- updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail pauseGame :: World -> World diff --git a/src/Dodge/HeldUse.hs b/src/Dodge/HeldUse.hs index fca5b2a98..a8207d07f 100644 --- a/src/Dodge/HeldUse.hs +++ b/src/Dodge/HeldUse.hs @@ -238,7 +238,7 @@ useMod hm = case hm of BurstRifleMod -> [ ammoHammerCheck , useTimeCheck - , sideEffectOnFrame 7 (torqueSideEffect 0.2) + , sideEffectOnFrame 7 (\_ cr -> TorqueCr 0.2 (_crID cr)) --(torqueSideEffect 0.2) , lockInvFor 7 , \f' it -> repeatOnFrames (take (_laLoaded (_itConsumption it) - 1) [3,6]) f' it , withSoundStart tap3S diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 0c8ecccfa..ca3c53210 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -6,8 +6,6 @@ import Dodge.Default.World --import Dodge.Save import Dodge.Data import Dodge.Creature ---import Dodge.Story -import Dodge.WorldEvent.Cloud import Dodge.SoundLogic import Geometry.Data @@ -30,8 +28,8 @@ initialWorld = defaultWorld , _mousePos = V2 0 0 , _yourID = 0 , _sideEffects = return - , _worldEvents = soundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing - . foldr ((.) . makeStartCloudAt) id [V3 x y 5 | x <- [-5,-4..5] , y <- [-5,-4..5]] + , _worldEvents = SoundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing + : [MakeStartCloudAt (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/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 04d7569fc..6eb5da6e2 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -94,7 +94,7 @@ type ChainEffect -> World lockInvFor :: Int -> ChainEffect -lockInvFor i f it cr = f it cr . (delayedEvents .:~ (i, unlockInv (_crID cr))) +lockInvFor i f it cr = f it cr . (delayedEvents .:~ (i, UnlockInv (_crID cr))) . lockInv (_crID cr) trigDoAlso' @@ -543,14 +543,10 @@ spreadLoaded eff item cr w = foldr f w dirs numBulLoaded = _laLoaded $ _itConsumption item sideEffectOnFrame :: Int - -> (Item -> Creature -> World -> World) + -> (Item -> Creature -> WorldEffect) -> ChainEffect sideEffectOnFrame i sf f it cr w = f it cr w - & delayedEvents .:~ (i, f') - where - f' w' = fromMaybe w' $ do - cr' <- w' ^? creatures . ix (_crID cr) - return $ sf it cr' w' + & delayedEvents .:~ (i, sf it cr) torqueSideEffect :: Float -> Item -> Creature -> World -> World torqueSideEffect torque _ cr w @@ -562,12 +558,13 @@ torqueSideEffect torque _ cr w -- pump the updated creature into the chain in later frames repeatOnFrames :: [Int] -> ChainEffect -repeatOnFrames is f it cr w = f it cr w - & delayedEvents .++~ (is <&> (, f')) - where - f' w' = fromMaybe w' $ do - cr' <- w' ^? creatures . ix (_crID cr) - return $ f it cr' w' +repeatOnFrames = const id +--repeatOnFrames is f it cr w = f it cr w +-- & delayedEvents .++~ (is <&> (, f')) +-- where +-- f' w' = fromMaybe w' $ do +-- cr' <- w' ^? creatures . ix (_crID cr) +-- return $ f it cr' w' duplicateLoaded :: ChainEffect duplicateLoaded eff it cr w = foldr f w [1..numBul] diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 17c716f4f..18efb1c0d 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -2,6 +2,7 @@ module Dodge.Render.HUD ( hudDrawings ) where +import Dodge.WorldPos import Dodge.Data import Dodge.Tweak.Show import Dodge.Item.Display @@ -310,7 +311,7 @@ drawCarte cfig w = pictures $ where iPos = _selLocation w locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ w - locPoss = map (cartePosToScreen cfig w . ($ w) . fst) . IM.elems . _seenLocations $ w + locPoss = map (cartePosToScreen cfig w . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations $ w locTexts = map fst locs displayListEndCoords :: Configuration -> [String] -> [Point2] diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 2dc025371..789ee9990 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -4,6 +4,7 @@ Module : Dodge.Update Description : Simulation update -} module Dodge.Update ( updateUniverse ) where +import Dodge.WorldEffect import Dodge.Data import Dodge.Beam import Dodge.LightSource.Update @@ -47,7 +48,7 @@ import SDL updateUniverse :: Universe -> Universe updateUniverse u = case _menuLayers u of (WaitScreen s i : _) - | i < 1 -> u & over uvWorld (dbArg _worldEvents) + | i < 1 -> u & over uvWorld doWorldEvents | otherwise -> u & menuLayers %~ ( (WaitScreen s (i-1) :) . tail ) (OptionScreen {_scOptionFlag = GameOverOptions} : _) -> u & uvWorld %~ ( updateParticles @@ -75,9 +76,8 @@ functionalUpdate w = over uvWorld checkEndGame . over uvWorld (simpleCrSprings ) . over uvWorld (zoneCreatures ) . over uvWorld (updateIMl _doors _drMech ) + . over uvWorld doWorldEvents . over uvWorld (updateDelayedEvents ) - . over uvWorld (resetWorldEvents ) - . over uvWorld (dbArg _worldEvents ) . over uvWorld (updateIMl _modifications _mdUpdate ) . over uvWorld (updateSparks ) . over uvWorld (updateRadarSweeps ) @@ -110,6 +110,9 @@ functionalUpdate w = over uvWorld checkEndGame . updateBounds -- where should this go? next to update camera? $ over uvWorld updateCloseObjects w +doWorldEvents :: World -> World +doWorldEvents w = foldr doWorldEffect (w & worldEvents .~ []) (_worldEvents w) + zoneClouds :: World -> World zoneClouds w = w & clZoning . znObjects .~ mempty @@ -194,10 +197,6 @@ updateIMl fim fup w = foldl' (flip $ dbArg fup) w (fim w) updateIMl' :: (World -> IM.IntMap a) -> (a -> World -> World) -> World -> World updateIMl' fim fup w = foldl' (flip fup) w (fim w) --- | Note the explict use of record syntax. Using lens created a space leak. -resetWorldEvents :: World -> World -resetWorldEvents w = w {_worldEvents = id} - updateCreatureGroups :: World -> World updateCreatureGroups w = w & creatureGroups %~ IM.mapMaybe (\cgp -> _crGroupUpdate cgp w cgp) @@ -457,5 +456,5 @@ updateDelayedEvents w = let (neww,newde) = mapAccumR f w (_delayedEvents w) in neww & delayedEvents .~ catMaybes newde where f w' (i,g) - | i <= 0 = (g w', Nothing) + | i <= 0 = (w' & worldEvents .:~ g, Nothing) | otherwise = (w', Just (i-1,g)) diff --git a/src/Dodge/WorldEffect.hs b/src/Dodge/WorldEffect.hs index 6a20e2821..0e7ac8fd2 100644 --- a/src/Dodge/WorldEffect.hs +++ b/src/Dodge/WorldEffect.hs @@ -1,7 +1,11 @@ module Dodge.WorldEffect where +import Dodge.SoundLogic +import Dodge.WorldEvent.Cloud import Dodge.Data +import Dodge.Inventory.Lock import Dodge.Placement.Instance.Terminal +import System.Random import Control.Lens doWorldEffect :: WorldEffect -> World -> World @@ -11,3 +15,14 @@ doWorldEffect we = case we of SetLSCol col lsid -> lightSources . ix lsid . lsParam . lsCol .~ col AccessTerminal mtmid -> accessTerminal mtmid WorldEffects wes -> \w -> foldr doWorldEffect w wes + UnlockInv cid -> unlockInv cid + MakeStartCloudAt p -> makeStartCloudAt p + TorqueCr x cid -> torqueCr x cid + SoundStart so p sid mi -> soundStart so p sid mi + +torqueCr :: Float -> Int -> World -> World +torqueCr x cid w + | cid == 0 = set randGen g $ over cameraRot (+rot) w + | otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) w + where + (rot, g) = randomR (-x,x) $ _randGen w diff --git a/src/Dodge/WorldPos.hs b/src/Dodge/WorldPos.hs new file mode 100644 index 000000000..0a9f212a8 --- /dev/null +++ b/src/Dodge/WorldPos.hs @@ -0,0 +1,9 @@ +module Dodge.WorldPos where +import Dodge.Data +import Dodge.Base.You +import Geometry + +doWorldPos :: WdP2 -> World -> Point2 +doWorldPos wp2 = case wp2 of + WdP2Const p -> const p + WdYouPos -> _crPos . you diff --git a/src/Dodge/Zoning.hs b/src/Dodge/Zoning.hs new file mode 100644 index 000000000..e9b6f88f8 --- /dev/null +++ b/src/Dodge/Zoning.hs @@ -0,0 +1,2 @@ +module Dodge.Zoning where + diff --git a/src/Dodge/Zoning/Base.hs b/src/Dodge/Zoning/Base.hs new file mode 100644 index 000000000..bc1f10143 --- /dev/null +++ b/src/Dodge/Zoning/Base.hs @@ -0,0 +1,20 @@ +module Dodge.Zoning.Base where + +--zoneOfCirc :: Float -> Point2 -> Float -> [Int2] +--zoneOfCirc zsize p r = zoneOfRect' x (p +.+ V2 r r) (p -.- V2 r r) +-- +--zoneOfRect' :: Float -> Point2 -> Point2 -> [Int2] +--zoneOfRect' s sp ep = [V2 x y | x <- makeInterval sx ex, y <- makeInterval sy ey] +-- where +-- V2 sx sy = zoneOfPoint s sp +-- V2 ex ey = zoneOfPoint s ep +-- +--zoneOfPoint :: Float -> Point2 -> Int2 +--{-# INLINE zoneOfPoint #-} +--zoneOfPoint s = fmap (divTo s) +-- +--zoneExtract :: Monoid m => Int2 -> IM.IntMap (IM.IntMap m) -> m +--zoneExtract (x,y) = ix x . ix y +-- +--zonesExtract :: Monoid m => [Int2] -> IM.IntMap (IM.IntMap m) -> m +--zonesExtract xs = fold (flip zoneExtract xs) diff --git a/src/Dodge/Zoning/Creature.hs b/src/Dodge/Zoning/Creature.hs new file mode 100644 index 000000000..80e9e96f8 --- /dev/null +++ b/src/Dodge/Zoning/Creature.hs @@ -0,0 +1,7 @@ +module Dodge.Zoning.Creature where + +--zoneOfCr :: Creature -> [Int2] +--zoneOfCr cr = zoneOfCirc crZoneSize (_crPos cr) (_crRad cr) + +--crsInZones :: [Int2] -> CrZoning -> IS.IntSet +--crsInZones is