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

Refactor world events

Browse Source
This commit is contained in:
justin
2022-07-22 14:30:53 +01:00
parent 7fdb70dd1c
commit 43e7d20b21
14 changed files with 95 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+7 -5
View File
@@ -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
src/Dodge/Data/WorldEffect.hs
+8
View File
@@ -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
src/Dodge/Default/World.hs
+3 -7
View File
@@ -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
src/Dodge/Event/Keyboard.hs
+2 -1
View File
@@ -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
src/Dodge/HeldUse.hs
+1 -1
View File
@@ -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
src/Dodge/Initialisation.hs
+2 -4
View File
@@ -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
src/Dodge/Item/Weapon/TriggerType.hs
+10 -13
View File
@@ -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]
src/Dodge/Render/HUD.hs
+2 -1
View File
@@ -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]
src/Dodge/Update.hs
+7 -8
View File
@@ -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))
src/Dodge/WorldEffect.hs
+15
View File
@@ -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
src/Dodge/WorldPos.hs
+9
View File
@@ -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
src/Dodge/Zoning.hs
+2
View File
@@ -0,0 +1,2 @@
module Dodge.Zoning where
src/Dodge/Zoning/Base.hs
+20
View File
@@ -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)
src/Dodge/Zoning/Creature.hs
+7
View File
@@ -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