From 5de837c8cf6c2120e937f50cd8f3892a50e0a2ce Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 23 Jul 2022 20:53:00 +0100 Subject: [PATCH] Reify modifications --- src/Dodge/Data.hs | 18 ++----------- src/Dodge/Data/Modification.hs | 25 +++++++++++++++++++ src/Dodge/Data/SoundOrigin.hs | 2 +- src/Dodge/Data/WorldEffect.hs | 7 ++++++ src/Dodge/ModificationEffect.hs | 17 +++++++++++++ src/Dodge/Placement/Instance/Button.hs | 4 +-- .../Placement/Instance/LightSource/Flicker.hs | 2 +- src/Dodge/Update.hs | 3 ++- 8 files changed, 56 insertions(+), 22 deletions(-) create mode 100644 src/Dodge/Data/Modification.hs create mode 100644 src/Dodge/ModificationEffect.hs diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 5572b2dff..991d686f2 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -75,7 +75,9 @@ module Dodge.Data , module Dodge.Data.PathGraph , module Dodge.Data.Gust , module Dodge.Data.Projectile + , module Dodge.Data.Modification ) where +import Dodge.Data.Modification import Dodge.Data.Projectile import Dodge.Data.Gust import Dodge.Data.CrGroupParams @@ -427,21 +429,6 @@ type HitEffect' = Flame -> World -> (World,Maybe Flame) -data Modification - = ModIDTimerPoint3Bool - { _mdID :: Int - , _mdExternalID :: Int - , _mdUpdate :: Modification -> World -> World - , _mdTimer :: Int - , _mdPoint3 :: Point3 - , _mdBool :: Bool - } - | ModIDID - { _mdID :: Int - , _mdExternalID1 :: Int - , _mdExternalID2 :: Int - , _mdUpdate :: Modification -> World -> World - } data Prop = PropZ { _prPos :: Point2 @@ -700,7 +687,6 @@ data InPlacement = InPlacement makeLenses ''World makeLenses ''FloorItem makeLenses ''Prop -makeLenses ''Modification makeLenses ''Particle makeLenses ''PressPlate makeLenses ''Door diff --git a/src/Dodge/Data/Modification.hs b/src/Dodge/Data/Modification.hs new file mode 100644 index 000000000..0882feef9 --- /dev/null +++ b/src/Dodge/Data/Modification.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +module Dodge.Data.Modification + where +-- this naming is not good, parameterized world effect? +import Dodge.Data.WorldEffect +import Geometry.Data +import Control.Lens + +data Modification + = ModIDTimerPoint3Bool + { _mdID :: Int + , _mdExternalID :: Int + , _mdUpdate :: MdWdWd + , _mdTimer :: Int + , _mdPoint3 :: Point3 + , _mdBool :: Bool + } + | ModIDID + { _mdID :: Int + , _mdExternalID1 :: Int + , _mdExternalID2 :: Int + , _mdUpdate :: MdWdWd + } +makeLenses ''Modification diff --git a/src/Dodge/Data/SoundOrigin.hs b/src/Dodge/Data/SoundOrigin.hs index 8612d643c..f5c5ba7a3 100644 --- a/src/Dodge/Data/SoundOrigin.hs +++ b/src/Dodge/Data/SoundOrigin.hs @@ -26,5 +26,5 @@ data SoundOrigin = InventorySound | LeverSound Int | Explosion Int | Tap Int - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Read) diff --git a/src/Dodge/Data/WorldEffect.hs b/src/Dodge/Data/WorldEffect.hs index 236db65dc..62e2a96ff 100644 --- a/src/Dodge/Data/WorldEffect.hs +++ b/src/Dodge/Data/WorldEffect.hs @@ -12,5 +12,12 @@ data WorldEffect = NoWorldEffect | SoundStart SoundOrigin Point2 SoundID (Maybe Int) | MakeStartCloudAt Point3 | TorqueCr Float Int + deriving (Eq,Ord,Show,Read) data WdP2 = WdP2Const Point2 | WdYouPos + deriving (Eq,Ord,Show,Read) +data MdWdWd = MdWdId + | MdTrigIf MdWdWd MdWdWd + | MdSetLSCol Point3 + | MdFlickerUpdate + deriving (Eq,Ord,Show,Read) diff --git a/src/Dodge/ModificationEffect.hs b/src/Dodge/ModificationEffect.hs new file mode 100644 index 000000000..87fd72abb --- /dev/null +++ b/src/Dodge/ModificationEffect.hs @@ -0,0 +1,17 @@ +module Dodge.ModificationEffect + where +import Dodge.Placement.Instance.LightSource.Flicker +import Dodge.Data +import Control.Lens + +doModificationEffect :: MdWdWd -> Modification -> World -> World +doModificationEffect mww = case mww of + MdWdId -> const id + MdTrigIf ftrue ffalse -> \md w -> if w ^?! triggers . ix (_mdExternalID2 md) + then w & doModificationEffect ftrue md + else w & doModificationEffect ffalse md + -- note this uses the second external ix + MdSetLSCol col -> \md w -> w & lightSources . ix (_mdExternalID1 md) . lsParam . lsCol .~ col + -- note this uses the first external ix, this should be made more + -- transparent + MdFlickerUpdate -> flickerUpdate diff --git a/src/Dodge/Placement/Instance/Button.hs b/src/Dodge/Placement/Instance/Button.hs index b4463d52f..220bbd641 100644 --- a/src/Dodge/Placement/Instance/Button.hs +++ b/src/Dodge/Placement/Instance/Button.hs @@ -62,9 +62,7 @@ extTrigLitPos ps f = psPtCont ps (PutTrigger False) {_mdID = 0 ,_mdExternalID1 = lsid ,_mdExternalID2 = fromJust $ _plMID tp - ,_mdUpdate = \md w -> if w ^?! triggers . ix (_mdExternalID2 md) - then w & lightSources . ix (_mdExternalID1 md) . lsParam . lsCol .~ V3 0 0.5 0 - else w & lightSources . ix (_mdExternalID1 md) . lsParam . lsCol .~ V3 0.5 0 0 + ,_mdUpdate = MdTrigIf (MdSetLSCol (V3 0 0.5 0)) (MdSetLSCol (V3 0.5 0 0)) } thels = lsColPosRad (V3 0.5 0 0) (V3 0 0 78) 75 diff --git a/src/Dodge/Placement/Instance/LightSource/Flicker.hs b/src/Dodge/Placement/Instance/LightSource/Flicker.hs index 04d0c43f9..04865b062 100644 --- a/src/Dodge/Placement/Instance/LightSource/Flicker.hs +++ b/src/Dodge/Placement/Instance/LightSource/Flicker.hs @@ -10,7 +10,7 @@ flickerMod :: Placement -> Maybe Placement flickerMod pl = Just $ sps0 $ PutMod $ ModIDTimerPoint3Bool { _mdID = 0 , _mdExternalID = fromJust $ _plMID pl - , _mdUpdate = flickerUpdate + , _mdUpdate = MdFlickerUpdate , _mdTimer = 10 , _mdPoint3 = 0.8 , _mdBool = True diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index ec977e11c..a0108549a 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.ModificationEffect import Dodge.CrGroupUpdate import Dodge.Zoning.Cloud import Dodge.Zoning.Creature @@ -81,7 +82,7 @@ functionalUpdate w = checkEndGame . over uvWorld (updateIMl _doors _drMech ) . over uvWorld doWorldEvents . over uvWorld updateDelayedEvents - . over uvWorld (updateIMl _modifications _mdUpdate ) + . over uvWorld (updateIMl _modifications (doModificationEffect . _mdUpdate) ) . over uvWorld updateSparks . over uvWorld updateRadarSweeps . over uvWorld updatePosEvents