Reify CrGroupUpdate

src/Dodge/CrGroupUpdate.hs

@@ -0,0 +1,8 @@
+module Dodge.CrGroupUpdate
+    where
+import Dodge.Data
+
+doCrGroupUpdate :: CrGroupUpdate -> World -> CrGroupParams -> Maybe CrGroupParams
+doCrGroupUpdate cgu = case cgu of
+    DefaultCrGroupUpdate -> const Just
+

src/Dodge/Data.hs

@@ -10,6 +10,7 @@ circular imports are probably not a good idea.
 {-# LANGUAGE DerivingStrategies #-}
 module Dodge.Data 
     ( module Dodge.Data
+    , module Dodge.Data.CrGroupParams
     , module Dodge.Data.Corpse
     , module Dodge.Data.ActionPlan
     , module Dodge.Data.CreatureEffect
@@ -73,6 +74,7 @@ module Dodge.Data
     , module Dodge.Data.RadarBlip
     , module Dodge.Data.PathGraph
     ) where
+import Dodge.Data.CrGroupParams
 import Dodge.Data.Corpse
 import Dodge.Data.ActionPlan
 import Dodge.Data.CreatureEffect
@@ -270,7 +272,7 @@ data World = World
 data WorldHammer
     = SubInvHam
     | DoubleMouseHam
-  deriving (Eq,Ord,Show,Enum,Bounded)
+  deriving (Eq,Ord,Show,Read,Enum,Bounded)
 
 newtype GenParams = GenParams
     { _sensorCoding :: M.Map DamageType (PaletteColor,DecorationShape)
@@ -330,12 +332,6 @@ data MenuOption
         { _moKey    :: Scancode
         , _moEff    :: Universe -> IO (Maybe Universe)
         }
-data CrGroupParams = CrGroupParams
-    { _crGroupParamID   :: Int
-    , _crGroupIDs       :: IS.IntSet
-    , _crGroupCenter    :: Point2
-    , _crGroupUpdate    :: World -> CrGroupParams -> Maybe CrGroupParams
-    }
 data Gust = Gust
     { _guID  :: Int
     , _guPos :: Point2
@@ -735,7 +731,6 @@ makeLenses ''Proj
 makeLenses ''Modification
 makeLenses ''Particle
 makeLenses ''PressPlate
-makeLenses ''CrGroupParams
 makeLenses ''Door
 makeLenses ''Terminal
 makeLenses ''Machine

src/Dodge/Data/CrGroupParams.hs

@@ -0,0 +1,20 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.CrGroupParams
+    where
+import Geometry.Data
+import qualified Data.IntSet as IS
+import Control.Lens
+
+data CrGroupParams = CrGroupParams
+    { _crGroupParamID   :: Int
+    , _crGroupIDs       :: IS.IntSet
+    , _crGroupCenter    :: Point2
+    , _crGroupUpdate    :: CrGroupUpdate --World -> CrGroupParams -> Maybe CrGroupParams
+    }
+  deriving (Eq,Ord,Show,Read)
+
+data CrGroupUpdate = DefaultCrGroupUpdate
+  deriving (Eq,Ord,Show,Read)
+
+makeLenses ''CrGroupParams

src/Dodge/GameRoom.hs

@@ -13,3 +13,4 @@ data GameRoom = GameRoom
     , _grLinkDirs :: [Float]
     , _grName :: String
     }
+  deriving (Eq,Ord,Show,Read)

src/Dodge/Update.hs

@@ -4,6 +4,7 @@ Module      : Dodge.Update
 Description : Simulation update
 -}
 module Dodge.Update ( updateUniverse ) where
+import Dodge.CrGroupUpdate
 import Dodge.Zoning.Cloud
 import Dodge.Zoning.Creature
 import Dodge.WorldEffect
@@ -201,7 +202,7 @@ updateIMl' fim fup w = foldl' (flip fup) w (fim w)
 
 updateCreatureGroups :: World -> World
 updateCreatureGroups w = w & creatureGroups %~ 
-    IM.mapMaybe (\cgp -> _crGroupUpdate cgp w cgp)
+    IM.mapMaybe (\cgp -> doCrGroupUpdate (_crGroupUpdate cgp) w cgp)
 
 updateDistortions :: World -> World
 updateDistortions = distortions %~ mapMaybe updateDistortion

src/Geometry/ConvexPoly.hs

@@ -23,6 +23,7 @@ data ConvexPoly = ConvexPoly
     , _cpCen    :: Point2
     , _cpRad    :: Float
     }
+  deriving (Eq,Ord,Show,Read)
 pointsToPoly :: [Point2] -> ConvexPoly
 pointsToPoly xs = ConvexPoly
     { _cpPoints = xs