Split out more data files

src/Dodge/Data.hs

@@ -10,6 +10,10 @@ circular imports are probably not a good idea.
 {-# LANGUAGE DerivingStrategies #-}
 module Dodge.Data 
     ( module Dodge.Data
+    , module Dodge.Data.Door
+    , module Dodge.Data.Item
+    , module Dodge.Data.HUD
+    , module Dodge.Data.Cloud
     , module Dodge.Data.RightButtonOptions
     , module Dodge.Data.Material
     , module Dodge.Data.LightSource
@@ -42,6 +46,10 @@ module Dodge.Data
     , module Dodge.Data.RadarBlip
     , module Dodge.Data.PathGraph
     ) where
+import Dodge.Data.Door
+import Dodge.Data.Item
+import Dodge.Data.HUD
+import Dodge.Data.Cloud
 import Dodge.Data.RadarBlip
 import Dodge.Data.RightButtonOptions
 import Dodge.Data.LightSource
@@ -208,26 +216,6 @@ newtype GenParams = GenParams
 data DecorationShape = PLUS | SQUARE | CIRCLE | THREELINES
   deriving (Eq,Ord,Enum,Show,Read)
 
-data HUDElement 
-    = DisplayInventory {_subInventory :: SubInventory}
-    | DisplayCarte
---  deriving (Eq,Ord,Show)
-
-data SubInventory 
-    = NoSubInventory
-    | TweakInventory
-    | CombineInventory {_combineInvSel :: Maybe Int}
-    | InspectInventory
-    | LockedInventory
-    | DisplayTerminal {_termID :: Int }
---  deriving (Eq,Ord,Show)
-
-data HUD = HUD
-    { _hudElement   :: HUDElement
-    , _carteCenter  :: Point2
-    , _carteZoom    :: Float
-    , _carteRot     :: Float
-    }
 data TimeFlowStatus
     = RewindingNow
     | RewindingLastFrame
@@ -304,19 +292,6 @@ data Gust = Gust
     , _guVel :: Point2
     , _guTime :: Int
     }
-data Cloud = Cloud
-    { _clPos :: Point3
-    , _clVel :: Point3
-    , _clPict :: Cloud -> Picture
-    , _clRad :: Float
-    , _clAlt :: Float
-    , _clTimer :: Int
-    , _clType :: CloudType
-    , _clEffect :: Cloud -> World -> World
-    }
-data CloudType
-    = SmokeCloud
-    | GasCloud
 data TempLightSource = TLS 
     { _tlsParam     :: LSParam
     , _tlsUpdate    :: World -> TempLightSource -> Maybe TempLightSource
@@ -354,7 +329,6 @@ data Creature = Creature
     , _crState          :: CreatureState
     , _crCorpse         :: Creature -> Corpse -> SPic
     , _crMaterial       :: Material
---    , _crApplyDamage    :: [Damage] -> Creature -> World -> World
     , _crPastDamage     :: Int
     , _crStance         :: Stance
     , _crActionPlan     :: ActionPlan
@@ -412,10 +386,6 @@ data PressPlate = PressPlate
     , _ppText :: String
     }
 data FloorItem = FlIt { _flIt :: Item , _flItPos :: Point2 , _flItRot :: Float, _flItID :: Int}
-data ItemPos 
-    = InInv   { _ipCrID :: Int , _ipInvID :: Int }
-    | OnFloor { _ipFlID :: Int }
-    | VoidItm
 data ItemUse
     = RightUse 
         { _rUse         :: Item -> Creature -> World -> World 
@@ -492,11 +462,6 @@ data Item = Item
     , _itValue      :: ItemValue
     , _itParams     :: ItemParams
     }
-data ItemValue = ItemValue
-    { _ivInt :: Int
-    , _ivType :: ItemValueType
-    }
-data ItemValueType = MundaneItem | ArtefactItem
 data Targeting
     = NoTargeting
     | Targeting
@@ -506,18 +471,6 @@ data Targeting
         , _tgID     :: Maybe Int
         , _tgActive :: Bool
         }
-data ItemDimension = ItemDimension
-    { _dimRad       :: Float
-    , _dimCenter    :: Point3
-    , _dimAttachPos :: Point3
-    }
-data ItemPortage 
-    = HeldItem
-        { _handlePos :: Float
-        , _muzPos    :: Float
-        }
-    | WornItem
-    | NoPortage
 
 -- I believe this is called every frame, not sure when though
 data ItEffect 
@@ -989,14 +942,6 @@ data MountedObject
     | MountedProp Int
   deriving (Eq,Ord,Show)
 
-data DoorStatus = DoorOpen | DoorClosed | DoorHalfway | DoorInt Int
-  deriving (Eq, Ord, Show)
-
-data PushSource = PushesItself
-    | PushedBy Int
-    | NotPushed
-  deriving (Eq,Ord,Show)
-
 data ActionPlan
     = Inanimate
     | ActionPlan
@@ -1332,9 +1277,6 @@ data TerminalCommand = TerminalCommand
     , _tcAlias  :: [String]
     , _tcHelp   :: String
     , _tcEffect :: Terminal -> World -> EffectArguments
---    , _tcArgumentType :: Maybe String
---    , _tcArguments :: Terminal -> World -> [String]
---    , _tcEffect :: [String] -> Terminal -> World -> Either String [TerminalLine]
     }
 
 ---- ROOM DATATYPES
@@ -1440,12 +1382,10 @@ makeLenses ''CreatureState
 makeLenses ''Damage
 makeLenses ''DamageEffect
 makeLenses ''World
-makeLenses ''Cloud
 makeLenses ''Creature
 makeLenses ''TempLightSource
 makeLenses ''Item
 makeLenses ''ItemUse
-makeLenses ''ItemPos
 makeLenses ''ItEffect
 makeLenses ''FloorItem
 makeLenses ''ItemConsumption
@@ -1465,21 +1405,15 @@ makeLenses ''Door
 makeLenses ''Terminal
 makeLenses ''Machine
 makeLenses ''MachineType
-makeLenses ''ItemDimension
 makeLenses ''Universe
 makeLenses ''ItemParams
 makeLenses ''ItemTweaks
-makeLenses ''ItemPortage
 makeLenses ''Magnet
 makeLenses ''Gust
 makeLenses ''GunBarrels
 makeLenses ''Targeting
 makeLenses ''Nozzle
-makeLenses ''HUD
-makeLenses ''HUDElement
-makeLenses ''SubInventory
 makeLenses ''TerminalLine
-makeLenses ''ItemValue
 makeLenses ''Equipment
 makeLenses ''ScreenLayer
 makeLenses ''Beam

src/Dodge/Data/Cloud.hs

@@ -0,0 +1,20 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.Cloud where
+import Geometry
+import Picture
+import Control.Lens
+data Cloud = Cloud
+    { _clPos :: Point3
+    , _clVel :: Point3
+    , _clPict :: Cloud -> Picture
+    , _clRad :: Float
+    , _clAlt :: Float
+    , _clTimer :: Int
+    , _clType :: CloudType
+--    , _clEffect :: Cloud -> World -> World
+    }
+data CloudType
+    = SmokeCloud
+    | GasCloud
+makeLenses ''Cloud

src/Dodge/Data/Door.hs

@@ -0,0 +1,11 @@
+--{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.Door where
+
+data DoorStatus = DoorOpen | DoorClosed | DoorHalfway | DoorInt Int
+  deriving (Eq, Ord, Show)
+
+data PushSource = PushesItself
+    | PushedBy Int
+    | NotPushed
+  deriving (Eq,Ord,Show)

src/Dodge/Data/HUD.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.HUD where
+import Geometry.Data
+import Control.Lens
+data HUDElement 
+    = DisplayInventory {_subInventory :: SubInventory}
+    | DisplayCarte
+--  deriving (Eq,Ord,Show)
+
+data SubInventory 
+    = NoSubInventory
+    | TweakInventory
+    | CombineInventory {_combineInvSel :: Maybe Int}
+    | InspectInventory
+    | LockedInventory
+    | DisplayTerminal {_termID :: Int }
+--  deriving (Eq,Ord,Show)
+
+data HUD = HUD
+    { _hudElement   :: HUDElement
+    , _carteCenter  :: Point2
+    , _carteZoom    :: Float
+    , _carteRot     :: Float
+    }
+makeLenses ''HUD
+makeLenses ''HUDElement
+makeLenses ''SubInventory

src/Dodge/Data/Item.hs

@@ -0,0 +1,32 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.Item where
+import Geometry.Data
+import Control.Lens
+
+data ItemDimension = ItemDimension
+    { _dimRad       :: Float
+    , _dimCenter    :: Point3
+    , _dimAttachPos :: Point3
+    }
+data ItemPortage 
+    = HeldItem
+        { _handlePos :: Float
+        , _muzPos    :: Float
+        }
+    | WornItem
+    | NoPortage
+
+data ItemValue = ItemValue
+    { _ivInt :: Int
+    , _ivType :: ItemValueType
+    }
+data ItemValueType = MundaneItem | ArtefactItem
+data ItemPos 
+    = InInv   { _ipCrID :: Int , _ipInvID :: Int }
+    | OnFloor { _ipFlID :: Int }
+    | VoidItm
+makeLenses ''ItemDimension
+makeLenses ''ItemPortage
+makeLenses ''ItemValue
+makeLenses ''ItemPos

src/Dodge/Update.hs

@@ -5,6 +5,7 @@ Description : Simulation update
 -}
 module Dodge.Update ( updateUniverse ) where
 import Dodge.Data
+import Dodge.Update.Cloud
 import Dodge.Machine.Update
 import Dodge.RadarBlip
 import Dodge.Flare
@@ -348,10 +349,15 @@ updateClouds w = w' & clouds .~ catMaybes mclouds
 --    cls = _clouds w
     (w',mclouds) = mapAccumR updateCloud w (_clouds w)
 
+cloudEffect :: Cloud -> World -> World
+cloudEffect cl = case _clType cl of
+    GasCloud -> cloudPoisonDamage cl
+    SmokeCloud -> id
+
 updateCloud :: World -> Cloud -> (World,Maybe Cloud)
 updateCloud w c
     | _clTimer c < 1 = (w, Nothing)
-    | otherwise = (_clEffect c c w, Just $ c
+    | otherwise = (cloudEffect c w, Just $ c
         & clPos .~ finalPos
         & clVel .~ finalVel
         & clTimer -~ 1

src/Dodge/Update/Cloud.hs

@@ -0,0 +1,16 @@
+module Dodge.Update.Cloud where
+import Dodge.Data
+import Dodge.Zone
+import Geometry.Vector3D
+import LensHelp
+import StreamingHelp
+import qualified Streaming.Prelude as S
+cloudPoisonDamage :: Cloud -> World -> World
+cloudPoisonDamage c w = w & dodamagesto (S.filter f $ crsNearPoint clpos w)
+  where 
+    dodamagesto :: StreamOf Creature -> World -> World
+    dodamagesto scrs mcrs = runIdentity $ S.fold_ (flip doDam) mcrs id scrs
+    doDam cr = creatures . ix (_crID cr) . crState . csDamage 
+        .:~ Damage POISONDAM 1 clpos clpos clpos NoDamageEffect
+    f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10
+    clpos = stripZ $ _clPos c

src/Dodge/WorldEvent/Cloud.hs

@@ -34,7 +34,6 @@ makeCloudAt drawFunc rad t alt p = clouds .:~ Cloud
     , _clAlt = alt
     , _clTimer = t
     , _clType = SmokeCloud
-    , _clEffect = const id
     }
 
 smokeCloudAt 

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -25,7 +25,6 @@ import LensHelp
 
 import Data.Foldable
 import Data.Tuple
-import StreamingHelp
 import qualified Streaming.Prelude as S
 aFlameParticle 
     :: Int      -- ^ Timer
@@ -190,19 +189,9 @@ makeGasCloud pos vel w = w
         , _clAlt = 25
         , _clTimer = 400
         , _clType = GasCloud
-        , _clEffect = cloudPoisonDamage
         }
     (col, g) = runState (takeOne [green,yellow]) $ _randGen w
 {- Attach poison cloud damage to creatures near cloud.  -}
-cloudPoisonDamage :: Cloud -> World -> World
-cloudPoisonDamage c w = w & dodamagesto (S.filter f $ crsNearPoint clpos w)
-  where 
-    dodamagesto :: StreamOf Creature -> World -> World
-    dodamagesto scrs mcrs = runIdentity $ S.fold_ (flip doDam) mcrs id scrs
-    doDam cr = creatures . ix (_crID cr) . crState . csDamage 
-        .:~ Damage POISONDAM 1 clpos clpos clpos NoDamageEffect
-    f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10
-    clpos = stripZ $ _clPos c
 
 incBall :: RandomGen g => Point2 -> State g Particle
 incBall p = do