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

Cleanup, split CWorld into separate file

Browse Source
This commit is contained in:
justin
2022-07-26 21:19:12 +01:00
parent c2707719fb
commit 6554d219dc
27 changed files with 1049 additions and 911 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/ActionPlan.hs
+108 -84
View File
@@ -1,36 +1,43 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
--{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE DeriveGeneric #-}
module Dodge.Data.ActionPlan where
import GHC.Generics
import Data.Aeson
import Dodge.Creature.Stance.Data
import Dodge.Data.CreatureEffect
--import Dodge.ShortShow
import Control.Lens
import Data.Aeson
import Dodge.Data.Creature.Stance
import Dodge.Data.CreatureEffect
import GHC.Generics
import Geometry.Data
import Sound.Data
--import GHC.Generics
data ActionPlan
= Inanimate
| ActionPlan
{_apImpulse :: [Impulse]
,_apAction :: [Action]
,_apStrategy :: Strategy
,_apGoal :: [Goal]
{ _apImpulse :: [Impulse]
, _apAction :: [Action]
, _apStrategy :: Strategy
, _apGoal :: [Goal]
}
deriving (Eq,Ord,Show,Read,Generic)
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON ActionPlan where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ActionPlan
data RandImpulse
data RandImpulse
= RandImpulseList [Impulse]
| RandImpulseCircMove Float
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON RandImpulse where
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON RandImpulse where
toEncoding = genericToEncoding defaultOptions
instance FromJSON RandImpulse
instance FromJSON RandImpulse
data Impulse
= Move Point2
| MoveForward Float
@@ -50,127 +57,138 @@ data Impulse
| MakeSound SoundID
| ChangeStrategy Strategy
| AddGoal Goal
| ArbitraryImpulseFunction WdCrCr
| ArbitraryImpulse CrWdImp
| ArbitraryImpulseEffect CrWdWd
| ArbitraryImpulseFunction WdCrCr
| ArbitraryImpulse CrWdImp
| ArbitraryImpulseEffect CrWdWd
| ImpulseUseTargetCID
{_impulseUseTargetCID :: IntImp
{ _impulseUseTargetCID :: IntImp
}
| ImpulseUseTarget
{_impulseUseTarget :: CrImp
{ _impulseUseTarget :: CrImp
}
| ImpulseUseAheadPos
{_impulseUseAheadPos :: P2Imp
{ _impulseUseAheadPos :: P2Imp
}
| ImpulseNothing
deriving (Eq,Ord,Show,Read,Generic)
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON Impulse where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Impulse
infixr 9 `WaitThen`
infixr 9 `DoActionThen`
infixr 9 `DoActionWhile`
infixr 9 `DoReplicate`
infixr 9 `DoImpulsesAlongside`
data Action
= LabelAction
{_actLabel :: String
,_actAction :: Action
{ _actLabel :: String
, _actAction :: Action
}
| ActionNothing
| AimAt
{_targetID :: Int
,_targetSeenAt :: Point2
{ _targetID :: Int
, _targetSeenAt :: Point2
}
| PathTo
{_pathToPoint :: Point2
| PathTo
{ _pathToPoint :: Point2
}
| TurnToPoint
{_turnToPoint :: Point2
{ _turnToPoint :: Point2
}
-- | PickupItem
-- {_pickupItemID :: Int
-- }
| ImpulsesList
{_impulsesListList :: [[Impulse]]
| -- | PickupItem
-- {_pickupItemID :: Int
-- }
ImpulsesList
{ _impulsesListList :: [[Impulse]]
}
| DoImpulses
{_doImpulsesList :: [Impulse]
| DoImpulses
{ _doImpulsesList :: [Impulse]
}
| WaitThen
{_waitThenTimer :: Int
,_waitThenAction :: Action
| WaitThen
{ _waitThenTimer :: Int
, _waitThenAction :: Action
}
| DoActionWhile
{_doActionWhileCondition :: WdCrBl
,_doActionWhileAction :: Action
| DoActionWhile
{ _doActionWhileCondition :: WdCrBl
, _doActionWhileAction :: Action
}
| DoActionWhilePartial
{_doActionWhilePartial :: Action
,_doActionWhileCondition :: WdCrBl
,_doActionWhileAction :: Action
{ _doActionWhilePartial :: Action
, _doActionWhileCondition :: WdCrBl
, _doActionWhileAction :: Action
}
| DoActionIf
{_doActionIfCondition :: WdCrBl
,_doActionIfAction :: Action
{ _doActionIfCondition :: WdCrBl
, _doActionIfAction :: Action
}
| DoActionIfElse
{_doActionIfElseIfAction :: Action
,_doActionIfElseCondition :: WdCrBl
,_doActionIfElseElseAction :: Action
| DoActionIfElse
{ _doActionIfElseIfAction :: Action
, _doActionIfElseCondition :: WdCrBl
, _doActionIfElseElseAction :: Action
}
| DoActionWhileInterrupt
{_doActionWhileThenDo :: Action
,_doActionWhileThenCondition :: WdCrBl
,_doActionWhileThenThen :: Action
| DoActionWhileInterrupt
{ _doActionWhileThenDo :: Action
, _doActionWhileThenCondition :: WdCrBl
, _doActionWhileThenThen :: Action
}
| DoActions
{_doActionsList :: [Action]
| DoActions
{ _doActionsList :: [Action]
}
| DoActionThen
{_doActionThenFirst :: Action
,_doActionThenSecond :: Action
| DoActionThen
{ _doActionThenFirst :: Action
, _doActionThenSecond :: Action
}
-- | DoGuardActions
-- {_doGuardActionsList :: [( (World, Creature) -> Bool, Action, Maybe Action)]
-- }
| DoReplicate
{_doReplicateTimes :: Int
,_doReplicateAction :: Action
| -- | DoGuardActions
-- {_doGuardActionsList :: [( (World, Creature) -> Bool, Action, Maybe Action)]
-- }
DoReplicate
{ _doReplicateTimes :: Int
, _doReplicateAction :: Action
}
| DoReplicatePartial
{_partialAction :: Action
,_doReplicateTimes :: Int
,_doReplicateAction :: Action
{ _partialAction :: Action
, _doReplicateTimes :: Int
, _doReplicateAction :: Action
}
| LeadTarget
{_leadTargetBy :: Point2
{ _leadTargetBy :: Point2
}
| NoAction
| StartSentinelPost
| UseTarget
{_useTarget :: MCrAc
{ _useTarget :: MCrAc
}
| UseSelf
{_useSelf :: CrAc
{ _useSelf :: CrAc
}
| UseAheadPos
{_useAheadPos :: P2Ac
{ _useAheadPos :: P2Ac
}
| UseMvTargetPos
{_useMvTargetPos :: MP2Ac
{ _useMvTargetPos :: MP2Ac
}
| ArbitraryAction
{ _arbitraryAction :: CrWdAc }
| DoImpulsesAlongside
-- ^ Repeatedly perform impulses alongside a main action until the main action terminates
{_sideImpulses :: [Impulse]
,_mainAction :: Action
{_arbitraryAction :: CrWdAc}
| -- | Repeatedly perform impulses alongside a main action until the main action terminates
DoImpulsesAlongside
{ _sideImpulses :: [Impulse]
, _mainAction :: Action
}
deriving (Eq,Ord,Show,Read,Generic)
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON Action where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Action
data Strategy
= Flank Int
| Ambush Int
@@ -187,18 +205,24 @@ data Strategy
| Reload
| Flee
| MeleeStrike
deriving (Eq,Ord,Show,Read,Generic)
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON Strategy where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Strategy
data Goal
= LiveLongAndProsper
| Kill Int
| SentinelAt Point2 Float
deriving (Eq,Ord,Show,Read,Generic)
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON Goal where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Goal
makeLenses ''ActionPlan
makeLenses ''Impulse
makeLenses ''Action
src/Dodge/Data/CWorld.hs
+159
View File
@@ -0,0 +1,159 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.CWorld where
import Control.Lens
import Data.Aeson
import Data.Graph.Inductive
import qualified Data.IntSet as IS
import Dodge.Data.Beam
import Dodge.Data.Block
import Dodge.Data.Bounds
import Dodge.Data.Bullet
import Dodge.Data.Button
import Dodge.Data.Cloud
import Dodge.Data.Corpse
import Dodge.Data.CrGroupParams
import Dodge.Data.Creature
import Dodge.Data.Damage
import Dodge.Data.Door
import Dodge.Data.EnergyBall
import Dodge.Data.Flame
import Dodge.Data.Flare
import Dodge.Data.FloorItem
import Dodge.Data.ForegroundShape
import Dodge.Data.GenParams
import Dodge.Data.Gust
import Dodge.Data.HUD
import Dodge.Data.Item
import Dodge.Data.Laser
import Dodge.Data.LightSource
import Dodge.Data.LinearShockwave
import Dodge.Data.Machine
import Dodge.Data.Magnet
import Dodge.Data.Modification
import Dodge.Data.PathGraph
import Dodge.Data.PosEvent
import Dodge.Data.PressPlate
import Dodge.Data.Projectile
import Dodge.Data.Prop
import Dodge.Data.RadarBlip
import Dodge.Data.RadarSweep
import Dodge.Data.Shockwave
import Dodge.Data.Spark
import Dodge.Data.Terminal
import Dodge.Data.TeslaArc
import Dodge.Data.TractorBeam
import Dodge.Data.Wall
import Dodge.Data.WorldEffect
import Dodge.Distortion.Data
import Dodge.GameRoom
import GHC.Generics
import Geometry.ConvexPoly
import Geometry.Data
import qualified IntMapHelp as IM
import MaybeHelp
import Picture.Data
data CWorld = CWorld
{ _cameraCenter :: Point2
, _cameraRot :: Float
, _cameraZoom :: Float -- smaller values zoom out
, _itemZoom :: Float
, _defaultZoom :: Float
, _cameraViewFrom :: Point2
, _viewDistance :: Float
, _boundBox :: [Point2]
, _boundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative
, _creatures :: IM.IntMap Creature
, _crZoning :: IM.IntMap (IM.IntMap IS.IntSet)
, _creatureGroups :: IM.IntMap CrGroupParams
, _itemPositions :: IM.IntMap ItemPos
, _clouds :: [Cloud]
, _clZoning :: IM.IntMap (IM.IntMap [Cloud])
, _gusts :: IM.IntMap Gust
, _gsZoning :: IM.IntMap (IM.IntMap IS.IntSet)
, _props :: IM.IntMap Prop
, _projectiles :: IM.IntMap Proj
, _instantBullets :: [Bullet]
, _bullets :: [Bullet]
, _radarSweeps :: [RadarSweep]
, _energyBalls :: [EnergyBall]
, _posEvents :: [PosEvent]
, _flames :: [Flame]
, _sparks :: [Spark]
, _radarBlips :: [RadarBlip]
, _flares :: [Flare]
, _newBeams :: WorldBeams
, _beams :: WorldBeams
, _teslaArcs :: [TeslaArc]
, _shockwaves :: [Shockwave]
, _lasers :: [LaserStart]
, _lasersToDraw :: [Laser]
, _linearShockwaves :: IM.IntMap LinearShockwave
, _tractorBeams :: [TractorBeam]
, _walls :: IM.IntMap Wall
, _wallDamages :: IM.IntMap [Damage]
, _doors :: IM.IntMap Door
, _machines :: IM.IntMap Machine
, _terminals :: IM.IntMap Terminal
, _magnets :: IM.IntMap Magnet
, _blocks :: IM.IntMap Block
, _coordinates :: IM.IntMap Point2
, _triggers :: IM.IntMap Bool
, _wlZoning :: IM.IntMap (IM.IntMap IS.IntSet) -- Zoning IM.IntMap Wall
, _floorItems :: IM.IntMap FloorItem
, _floorTiles :: [(Point3, Point3)]
, _modifications :: IM.IntMap Modification
, _yourID :: Int
, _worldEvents :: [WdWd]
, _delayedEvents :: [(Int, WdWd)]
, _pressPlates :: IM.IntMap PressPlate
, _buttons :: IM.IntMap Button
, _decorations :: IM.IntMap Picture
, _foregroundShapes :: IM.IntMap ForegroundShape
, _corpses :: IM.IntMap Corpse
, _clickMousePos :: Point2
, _pathGraph :: Gr Point2 PathEdge
, _pnZoning :: IM.IntMap (IM.IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature
, _peZoning :: IM.IntMap (IM.IntMap [(Int, Int, PathEdge)]) --Zoning IM.IntMap Creature
, _hud :: HUD
, _lightSources :: IM.IntMap LightSource
, _tempLightSources :: [TempLightSource]
, _closeObjects :: [Either FloorItem Button]
, _seenLocations :: IM.IntMap (WdP2, String)
, _selLocation :: Int
, _distortions :: [Distortion]
, _worldBounds :: Bounds
, _gameRooms :: [GameRoom] -- consider using an IntMap
, _roomClipping :: [ConvexPoly]
, _maybeWorld :: Maybe' CWorld
, _rewindWorlds :: [CWorld]
, _worldClock :: Int
, _genParams :: GenParams
, _deathDelay :: Maybe Int
}
deriving (Eq, Show, Read, Generic)
instance ToJSON CWorld where
toEncoding = genericToEncoding defaultOptions
instance FromJSON CWorld
data WorldBeams = WorldBeams
{ _blockingBeams :: [Beam]
, _lightBeams :: [Beam]
, _positronBeams :: [Beam]
, _electronBeams :: [Beam]
}
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON WorldBeams where
toEncoding = genericToEncoding defaultOptions
instance FromJSON WorldBeams
makeLenses ''CWorld
makeLenses ''WorldBeams
src/Dodge/Data/Creature.hs
+6 -3
View File
@@ -5,6 +5,9 @@ module Dodge.Data.Creature
( module Dodge.Data.Creature
, module Dodge.Data.Creature.Misc
, module Dodge.Data.Creature.State
, module Dodge.Data.Creature.Perception
, module Dodge.Data.Creature.Memory
, module Dodge.Data.Creature.Stance
) where
import GHC.Generics
import Data.Aeson
@@ -15,9 +18,9 @@ import Dodge.Data.LoadAction
import Dodge.Data.Material
import Dodge.Data.ActionPlan
import Dodge.Data.Hammer
import Dodge.Creature.Perception.Data
import Dodge.Creature.Memory.Data
import Dodge.Creature.Stance.Data
import Dodge.Data.Creature.Perception
import Dodge.Data.Creature.Memory
import Dodge.Data.Creature.Stance
import Geometry.Data
import qualified IntMapHelp as IM
import qualified Data.Map.Strict as M
src/Dodge/Data/Creature/Memory.hs
+18
View File
@@ -0,0 +1,18 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.Creature.Memory
where
import GHC.Generics
import Data.Aeson
import Geometry.Data
import Control.Lens
data Memory = Memory
{ _soundsToInvestigate :: [Point2]
, _nodesSearched :: [Int]
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Memory where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Memory
makeLenses ''Memory
src/Dodge/Data/Creature/Perception.hs
+82
View File
@@ -0,0 +1,82 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.Creature.Perception
( Perception (..)
, Vigilance (..)
, Attention (..)
, Awareness (..)
, Vision (..)
, Audition (..)
-- lenses
, getAttentiveTo
, getFixated
, cpAttention
, cpVigilance
, cpAwareness
, cpVision
, cpAudition
, viFOV
, viDist
, auDist
)
where
import GHC.Generics
import Data.Aeson
import Control.Lens
import Dodge.Data.FloatFunction
import qualified IntMapHelp as IM
data Perception = Perception
{ _cpVigilance :: Vigilance
, _cpAttention :: Attention
, _cpAwareness :: IM.IntMap Awareness
, _cpVision :: Vision
, _cpAudition :: Audition
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Perception where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Perception
data Vision = Eyes
{ _viFOV :: FloatFloat
, _viDist :: FloatFloat
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Vision where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Vision
newtype Audition = Ears
{ _auDist :: FloatFloat
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Audition where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Audition
data Vigilance
= Comatose
| Asleep
| Lethargic
| Vigilant
| Overstrung
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Vigilance where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Vigilance
data Attention
= AttentiveTo {_getAttentiveTo :: IM.IntMap Awareness }
| Fixated {_getFixated :: Int }
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Attention where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Attention
data Awareness
= Suspicious Float
| Cognizant Float
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Awareness where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Awareness
makeLenses ''Perception
makeLenses ''Vision
makeLenses ''Audition
makeLenses ''Attention
src/Dodge/Data/Creature/Stance.hs
+50
View File
@@ -0,0 +1,50 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.Creature.Stance
where
import GHC.Generics
import Data.Aeson
import Geometry.Data
import Control.Lens
data Stance = Stance
{_carriage :: Carriage
,_posture :: Posture
,_strideLength :: Int
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Stance where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Stance
data Carriage
= Walking
{ _strideAmount :: Int
, _currentFoot :: FootForward
}
| Standing
| Floating
| Flying
| Boosting Point2
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Carriage where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Carriage
data FootForward
= LeftForward
| RightForward
| WasLeftForward
| WasRightForward
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON FootForward where
toEncoding = genericToEncoding defaultOptions
instance FromJSON FootForward
data Posture = Aiming
| AtEase
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Posture where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Posture
makeLenses ''Stance
makeLenses ''Carriage
makeLenses ''Posture
src/Dodge/Data/Item/HeldUse.hs
+17
View File
@@ -25,16 +25,22 @@ data HeldUse
| HeldForceField
| HeldShatter
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON HeldUse where
toEncoding = genericToEncoding defaultOptions
instance FromJSON HeldUse
data Cuse
= CDoNothing
| CHeal Int
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON Cuse where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Cuse
data Euse
= EDoNothing
| EDetector Detector
@@ -45,9 +51,12 @@ data Euse
| EonWristShield
| EoffWristShield
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON Euse where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Euse
data Luse
= LDoNothing
| LRewind
@@ -56,13 +65,17 @@ data Luse
| LUnsafeBlink
| LBoost
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON Luse where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Luse
data HeldMod
= HeldModNothing
| PoisonSprayerMod
| FlameSpitterMod
| FlameSpitterRepeatMod
| FlameThrowerMod
| LauncherMod
| TeslaMod
@@ -88,11 +101,15 @@ data HeldMod
| AutoPistolMod
| MachinePistolMod
| BurstRifleMod
| BurstRifleRepeatMod
| MiniGunMod Int
| SmgMod
| RevolverXMod
| RevolverXRepeatMod
| BangConeMod
deriving (Eq, Ord, Show, Read, Generic)
instance ToJSON HeldMod where
toEncoding = genericToEncoding defaultOptions
instance FromJSON HeldMod
src/Dodge/Data/WorldEffect.hs
+10
View File
@@ -3,12 +3,20 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE DeriveGeneric #-}
module Dodge.Data.WorldEffect where
import Dodge.Data.Item
import Data.Aeson
import GHC.Generics
import Dodge.Data.CreatureEffect
import Sound.Data
import Geometry.Data
import Dodge.Data.SoundOrigin
data ItCrWdWd = ItCrWdId
| ItCrWdItemEffect
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ItCrWdWd where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItCrWdWd
data WdWd = NoWorldEffect
| SetTrigger Bool Int
| WorldEffects [WdWd]
@@ -19,6 +27,8 @@ data WdWd = NoWorldEffect
| MakeStartCloudAt Point3
| TorqueCr Float Int
| WdWdNegateTrig Int
| WdWdFromItixCrixWdWd Int Int ItCrWdWd
| WdWdFromItCrixWdWd Item Int ItCrWdWd
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON WdWd where
toEncoding = genericToEncoding defaultOptions