From 11732358edcb208459cc8f837e261e9c224f7308 Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 16 Jul 2022 17:32:11 +0100 Subject: [PATCH] Split out more data files --- src/Dodge/Data.hs | 82 +++------------------------ src/Dodge/Data/Cloud.hs | 20 +++++++ src/Dodge/Data/Door.hs | 11 ++++ src/Dodge/Data/HUD.hs | 28 +++++++++ src/Dodge/Data/Item.hs | 32 +++++++++++ src/Dodge/Update.hs | 8 ++- src/Dodge/Update/Cloud.hs | 16 ++++++ src/Dodge/WorldEvent/Cloud.hs | 1 - src/Dodge/WorldEvent/SpawnParticle.hs | 11 ---- 9 files changed, 122 insertions(+), 87 deletions(-) create mode 100644 src/Dodge/Data/Cloud.hs create mode 100644 src/Dodge/Data/Door.hs create mode 100644 src/Dodge/Data/HUD.hs create mode 100644 src/Dodge/Data/Item.hs create mode 100644 src/Dodge/Update/Cloud.hs diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 8b56f32bf..d832787ff 100644 --- a/src/Dodge/Data.hs +++ b/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 diff --git a/src/Dodge/Data/Cloud.hs b/src/Dodge/Data/Cloud.hs new file mode 100644 index 000000000..7a7f3c1b7 --- /dev/null +++ b/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 diff --git a/src/Dodge/Data/Door.hs b/src/Dodge/Data/Door.hs new file mode 100644 index 000000000..edc17646d --- /dev/null +++ b/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) diff --git a/src/Dodge/Data/HUD.hs b/src/Dodge/Data/HUD.hs new file mode 100644 index 000000000..cf1a88cc2 --- /dev/null +++ b/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 diff --git a/src/Dodge/Data/Item.hs b/src/Dodge/Data/Item.hs new file mode 100644 index 000000000..431fe75a2 --- /dev/null +++ b/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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index f63ee2a73..0dd4e71c0 100644 --- a/src/Dodge/Update.hs +++ b/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 diff --git a/src/Dodge/Update/Cloud.hs b/src/Dodge/Update/Cloud.hs new file mode 100644 index 000000000..4c613fd2b --- /dev/null +++ b/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 diff --git a/src/Dodge/WorldEvent/Cloud.hs b/src/Dodge/WorldEvent/Cloud.hs index f5c0d53f2..029acdc3d 100644 --- a/src/Dodge/WorldEvent/Cloud.hs +++ b/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 diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 1e4fc6bcb..5d75ac471 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/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