Reify modifications

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

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

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)
 

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)

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

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
 

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

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