justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Split out more data files

Browse Source
This commit is contained in:
justin
2022-07-16 17:32:11 +01:00
parent e4a4766ddf
commit 11732358ed
9 changed files with 122 additions and 87 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+8 -74
View File
@@ -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
+20
View File
@@ -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
+11
View File
@@ -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
+28
View File
@@ -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
+32
View File
@@ -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
+7 -1
View File
@@ -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
+16
View File
@@ -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
-1
View File
@@ -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
-11
View File
@@ -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