Files
loop/src/Dodge/Data.hs
T
2021-09-12 17:52:34 +01:00

756 lines
23 KiB
Haskell

{- |
Contains base datatypes that cannot be seperated into
different modules because they are interdependent;
circular imports are probably not a good idea.
-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
module Dodge.Data
where
import Dodge.Creature.State.Data
import Dodge.Creature.Stance.Data
import Dodge.Creature.Perception.Data
import Dodge.Creature.Memory.Data
import Dodge.Debug.Flag.Data
import Dodge.Data.SoundOrigin
import Dodge.Data.DamageType
import Dodge.Zone.Data
import Dodge.Config.Data
import Dodge.Config.KeyConfig
import Dodge.Item.Attachment.Data
import Dodge.Item.Data
import Dodge.World.Trigger.Data
import Dodge.Bounds
import Data.Preload
import Picture.Data
import Geometry.Data
import Polyhedra.Data
import Sound.Data
import qualified DoubleStack as DS
import Dodge.GameRoom
import GHC.Generics
import Control.Lens
import System.Random
import Data.Graph.Inductive
import qualified Data.Set as S
import qualified Data.IntSet as IS
import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M
import SDL (Scancode, MouseButton)
import Data.Monoid
type CRUpdate = Creature -> World -> (Endo World, Maybe Creature)
data World = World
{ _keys :: !(S.Set Scancode)
, _mouseButtons :: !(S.Set MouseButton)
, _cameraCenter :: !Point2
, _cameraRot :: !Float
, _cameraZoom :: !Float
, _cameraViewFrom :: !Point2
, _creatures :: IM.IntMap Creature
, _creaturesZone :: Zone (IM.IntMap Creature)
, _creatureGroups :: IM.IntMap CrGroupParams
, _itemPositions :: IM.IntMap ItemPos
, _clouds :: [Cloud]
, _cloudsZone :: Zone [Cloud]
, _projectiles :: IM.IntMap Projectile
, _particles :: ![Particle]
, _walls :: !(IM.IntMap Wall)
, _wallsZone :: Zone (IM.IntMap Wall)
, _forceFields :: IM.IntMap ForceField
, _floorItems :: IM.IntMap FloorItem
, _floorTiles :: [(Point3,Point3)]
, _randGen :: StdGen
, _mousePos :: !Point2
, _testString :: World -> [String]
, _yourID :: !Int
, _worldEvents :: World -> World
, _pressPlates :: IM.IntMap PressPlate
, _buttons :: IM.IntMap Button
, _sounds :: M.Map SoundOrigin Sound
, _playingSounds :: M.Map SoundOrigin Sound
, _decorations :: IM.IntMap Picture
, _foregroundDecorations :: [Polyhedra]
, _foregroundEdgeVerx :: [Point3]
, _corpses :: Zone [Corpse]
, _clickMousePos :: !Point2
, _pathGraph :: ~(Gr Point2 Float)
, _pathGraph' :: ~[(Point2,Point2)]
, _pathPoints :: ~(IM.IntMap (IM.IntMap [(Int,Point2)]))
, _storedLevel :: Maybe World
, _menuLayers :: [ScreenLayer]
, _worldState :: M.Map WorldState Bool
, _worldTriggers :: S.Set WorldTrigger
, _carteDisplay :: !Bool
, _carteCenter :: !Point2
, _carteZoom :: !Float
, _carteRot :: !Float
, _lightSources :: !(IM.IntMap LightSource)
, _tempLightSources :: ![TempLightSource]
, _closeActiveObjects :: [Either FloorItem Button]
, _seenLocations :: IM.IntMap (World -> Point2,String)
, _selLocation :: Int
, _keyConfig :: KeyConfigSDL
, _config :: Configuration
, _sideEffects :: World -> IO World
, _debugFlags :: DebugFlags
, _inventoryMode :: InventoryMode
, _lClickHammer :: HammerPosition
, _radDistortion :: [(Point2,Point2,Point2,Float)]
, _gameRooms :: [GameRoom]
, _preloadData :: PreloadData
, _frameClock :: Int
, _worldBounds :: Bounds
}
data OptionScreenFlag = NormalOptions | GameOverOptions
data ScreenLayer
= OptionScreen
{ _scTitle :: World -> String
, _scOptions :: [MenuOption]
, _scDefaultEff :: World -> Maybe World
, _scOptionFlag :: OptionScreenFlag
}
| InputScreen String
| TerminalScreen Int [(Int,String)]
| WaitScreen
{ _scWaitMessage :: World -> String
, _scWaitTime :: Int
}
| DisplayScreen
{ _scDisplay :: World -> Picture
}
data MenuOption
= Toggle
{ _moKey :: Scancode
, _moEff :: World -> Maybe World
, _moString :: World -> String
}
| Toggle2
{ _moKey1 :: Scancode
, _moEff1 :: World -> Maybe World
, _moKey2 :: Scancode
, _moEff2 :: World -> Maybe World
, _moString :: World -> String
}
| InvisibleToggle
{ _moKey :: Scancode
, _moEff :: World -> Maybe World
}
data InventoryMode
= TopInventory
| TweakInventory
| CombineInventory
| InspectInventory
deriving (Eq, Ord, Show)
data CrGroupParams = CrGroupParams
{ _crGroupParamID :: Int
, _crGroupIDs :: IS.IntSet
, _crGroupCenter :: Point2
, _crGroupUpdate :: World -> CrGroupParams -> Maybe CrGroupParams
}
data Corpse = Corpse
{ _cpPos :: Point2
, _cpPict :: Picture
, _cpRes :: Creature
}
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 LightSource = LS
{ _lsID :: !Int
, _lsPos :: !Point3
, _lsDir :: !Float
, _lsRad :: !Float
, _lsIntensity :: !Point3
}
data TempLightSource = TLS
{ _tlsPos :: !Point3
, _tlsRad :: !Float
, _tlsIntensity :: !Point3
, _tlsUpdate :: World -> TempLightSource -> (World, Maybe TempLightSource)
, _tlsTime :: !Int
}
data Creature = Creature
{ _crPos :: Point2
, _crOldPos :: Point2
, _crVel :: Point2
, _crDir :: Float
, _crOldDir :: Float
, _crMvDir :: Float
, _crID :: Int
, _crPict :: Creature -> World -> Picture
, _crSilhouette :: Creature -> [Point3]
, _crUpdate
:: Creature
-> World
-> (Endo World, Maybe Creature)
, _crRad :: Float
, _crMass :: Float
, _crHP :: Int
, _crMaxHP :: Int
, _crInv :: IM.IntMap Item
, _crInvSel :: Int
, _crLeftInvSel :: Maybe Int
, _crState :: CreatureState
, _crCorpse :: Picture
, _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature)
, _crStance :: Stance
, _crActionPlan :: ActionPlan
, _crMeleeCooldown :: !Int
, _crPerception :: PerceptionState
, _crMemory :: MemoryState
, _crFaction :: Faction
, _crGroup :: CrGroup
, _crIntention :: Intention
, _crMvType :: CrMvType
}
data Intention = Intention
{ _targetCr :: Maybe Creature
, _mvToPoint :: Maybe Point2
, _viewPoint :: Maybe Point2
}
data CrMvType
= NoMvType
| ChaseMvType
{ _mvSpeed :: Float
, _mvTurnRad :: Float -> Float
, _mvTurnJit :: Float
}
| AimMvType
{ _mvSpeed :: Float
, _mvTurnRad :: Float -> Float
, _mvTurnJit :: Float
, _mvAimSpeed :: Float -> Float
}
data WorldState
= DoorNumOpen Int
| CrNumAlive Int
deriving (Eq,Ord)
data Button = Button
{ _btPict :: Picture
, _btPos :: Point2
, _btRot :: Float
, _btEvent :: Button -> World -> World
, _btID :: Int
, _btText :: String
, _btState :: ButtonState
}
data ButtonState = BtOn | BtOff | BtNoLabel
deriving (Eq, Show)
data PressPlate = PressPlate
{ _ppPict :: Picture
, _ppPos :: Point2
, _ppRot :: Float
, _ppEvent :: PressPlate -> World -> World
, _ppID :: Int
, _ppText :: String
}
data FloorItem = FlIt { _flIt :: Item , _flItPos :: Point2 , _flItRot :: Float, _flItID :: Int}
data ItemPos
= InInv { _itCrId :: Int , _itInvId :: Int }
| OnFloor { _itFlID :: Int }
data Item
= Weapon
{ _itName :: String
, _wpMaxAmmo :: Int
, _wpLoadedAmmo :: Int
, _wpAmmo :: Ammo
, _wpReloadTime :: Int
, _wpReloadState :: Int
, _wpReloadType :: ReloadType
, _wpMaxWarmUp :: Int
, _wpCurWarmUp :: Int
, _wpMaxCoolDown :: Int
, _wpCurCoolDown :: Int
, _itUseRate :: Int
, _itUseTime :: Int
, _itUse :: Item -> Creature -> World -> World
, _itUseModifiers :: [(Item -> Creature -> World -> World) -> Item -> Creature -> World -> World]
, _itLeftClickUse :: Maybe (Creature -> Int -> World -> World)
, _wpSpread :: Float
, _wpRange :: Float
, _itHammer :: HammerPosition
, _itFloorPict :: Picture
, _itMaxStack :: Int
, _itAmount :: Int
, _itAimingSpeed :: Float
, _itAimingRange :: Float
, _itZoom :: ItZoom
, _itAimZoom :: ItZoom
, _itEquipPict :: Creature -> Int -> Picture
, _itScroll :: Float -> Creature -> Item -> Item
, _itIdentity :: ItemIdentity
, _itAttachment :: ItAttachment
, _itID :: Maybe Int
, _itEffect :: ItEffect
, _itInvDisplay :: Item -> String
, _itInvColor :: Color
, _itTargeting :: Maybe (World -> Maybe Point2, Int -> Item -> Creature -> World -> Picture)
, _itWorldTrigger :: Maybe (Int -> World -> Bool)
, _itAimStance :: AimStance
, _wpNumBarrels :: Int
}
| Consumable
{ _itName :: String
, _itMaxStack :: Int
, _itAmount :: Int
, _cnEffect :: Int -> World -> Maybe World
, _itFloorPict :: Picture
, _itEquipPict :: Creature -> Int -> Picture
, _itIdentity :: ItemIdentity
, _itID :: Maybe Int
, _itInvDisplay :: Item -> String
, _itInvColor :: Color
, _itEffect :: ItEffect
, _itHammer :: HammerPosition
, _itAimStance :: AimStance
}
| Craftable
{ _itName :: String
, _itMaxStack :: Int
, _itAmount :: Int
, _itFloorPict :: Picture
, _itEquipPict :: Creature -> Int -> Picture
, _itIdentity :: ItemIdentity
, _itID :: Maybe Int
, _itInvDisplay :: Item -> String
, _itInvColor :: Color
, _itAimStance :: AimStance
}
| Equipment
{ _itName :: String
, _itMaxStack :: Int
, _itAmount :: Int
, _itFloorPict :: Picture
, _itEquipPict :: Creature -> Int -> Picture
, _itIdentity :: ItemIdentity
, _itEffect :: ItEffect
, _itID :: Maybe Int
, _itAimingSpeed :: Float
, _itAimingRange :: Float
, _itZoom :: ItZoom
, _itAimZoom :: ItZoom
, _itInvDisplay :: Item -> String
, _itInvColor :: Color
, _itHammer :: HammerPosition
, _itAimStance :: AimStance
}
| Throwable
{ _itName :: String
, _itMaxStack :: Int
, _itAmount :: Int
, _itFloorPict :: Picture
, _twMaxRange :: Float
, _twAccuracy :: Float
, _itUse :: Item -> Creature -> World -> World
, _itUseRate :: Int
, _itUseTime :: Int
, _itUseModifiers :: [(Item -> Creature -> World -> World) -> Item -> Creature -> World -> World]
, _itAimingSpeed :: Float
, _itAimingRange :: Float
, _itZoom :: ItZoom
, _itAimZoom :: ItZoom
, _itEquipPict :: Creature -> Int -> Picture
, _itIdentity :: ItemIdentity
, _itID :: Maybe Int
, _itAttachment :: ItAttachment
, _itInvDisplay :: Item -> String
, _itInvColor :: Color
, _itEffect :: ItEffect
, _itHammer :: HammerPosition
, _itScroll :: Float -> Creature -> Item -> Item
-- , _itScrollUp :: Int -> World -> World
-- , _itScrollDown :: Int -> World -> World
, _itAimStance :: AimStance
}
| NoItem
data ReloadType = ActiveReload | PassiveReload SoundID
data ItEffect = NoItEffect
| ItInvEffect
{_itInvEffect :: ItEffect -> Creature -> Int -> World -> World
-- the Int is the items inventory position
,_itEffectCounter :: Int
}
| ItEffect
{_itInvEffect :: ItEffect -> Creature -> Int -> World -> World
,_itFloorEffect :: Int -> World -> World
,_itEffectCounter :: Int
}
data ItZoom = ItZoom
{ _itZoomMax :: Float
, _itZoomMin :: Float
, _itZoomFac :: Float
}
data IntID a = IntID Int a
{- Objects without ids.
Update themselves, perhaps with side effects. -}
data Particle
= Particle
{ _ptDraw :: Particle -> Picture
, _ptUpdate' :: World -> Particle -> (World, Maybe Particle)
}
| LinearParticle
{ _ptDraw :: Particle -> Picture
, _ptUpdate' :: World -> Particle -> (World, Maybe Particle)
, _ptPoints :: [Point2]
, _ptTimer :: Int
, _ptColor :: Color
}
| BulletPt
{ _ptDraw :: Particle -> Picture
, _ptUpdate' :: World -> Particle -> (World, Maybe Particle)
, _btVel' :: Point2
, _btColor' :: Color
, _btTrail' :: [Point2]
, _btPassThrough' :: Maybe Int
, _btWidth' :: Float
, _btTimer' :: Int
, _btHitEffect' :: HitEffect
}
| PtZ
{ _ptDraw :: Particle -> Picture
, _ptUpdate' :: World -> Particle -> (World, Maybe Particle)
, _btVel' :: Point2
, _btColor' :: Color
, _btPos' :: Point2
, _btPassThrough' :: Maybe Int
, _btWidth' :: Float
, _btTimer' :: Int
, _btHitEffect' :: HitEffect
, _ptZ :: Float
}
| Shockwave'
{ _ptDraw :: Particle -> Picture
, _ptUpdate' :: World -> Particle -> (World, Maybe Particle)
, _btColor' :: Color
, _btPos' :: Point2
, _btRad' :: Float
, _btDam' :: Int
, _btPush' :: Float
, _btMaxTime' :: Int
, _btTimer' :: Int
}
type HitEffect = Particle
-> [(Point2, Either3 Creature Wall ForceField)]
-> World
-> (World,Maybe Particle)
data Ammo
= ShellAmmo
{ _amPayload :: Point2 -> World -> World
, _amString :: String
, _amPjParams :: [PjParam]
, _amPjDraw :: Projectile -> Picture
, _amParamSel :: Int
}
| BulletAmmo
{ _amString :: String
, _amBulEff :: HitEffect
, _amBulWth :: Float
, _amBulVel :: Point2
}
| GenericAmmo
data PjParam = PjParam
{ _pjMoveParam :: Int -> Item -> Creature -> Projectile -> World -> World
, _pjIntParam :: Int
, _pjMaxParam :: Int
, _pjDisplayParam :: Int -> String
}
data Projectile
= Projectile
{ _pjPos :: Point2
, _pjStartPos :: Point2
, _pjVel :: Point2
, _pjDraw :: Projectile -> Picture
, _pjID :: Int
, _pjUpdate :: Projectile -> World -> World
}
| Shell
{ _pjPos :: Point2
, _pjStartPos :: Point2
, _pjVel :: Point2
, _pjAcc :: Point2
, _pjDir :: Float
, _pjSpin :: Float
, _pjDraw :: Projectile -> Picture
, _pjID :: Int
, _pjUpdate :: Projectile -> World -> World
, _pjPayload :: Point2 -> World -> World
, _pjTimer :: Int
}
| LinearShockwave
{ _pjDraw :: Projectile -> Picture
, _pjID :: Int
, _pjUpdate :: Projectile -> World -> World
, _pjPoints :: [(Point2,Point2)]
, _pjTimer :: Int
}
data Either3 a b c = E3x1 a | E3x2 b | E3x3 c
data Wall' = Wall'
{ _wlLine' :: (Point2,Point2)
, _wlColor' :: Color
}
data Wall
= Wall
{ _wlLine :: (Point2,Point2)
, _wlID :: Int
, _wlColor :: Color
, _wlSeen :: Bool
, _wlIsSeeThrough :: Bool
}
| BlockAutoDoor
{ _wlLine :: (Point2,Point2)
, _wlID :: Int
, _doorMech :: World -> World
, _wlColor :: Color
, _wlSeen :: Bool
, _blIDs :: [Int]
, _blHP :: Int
, _wlIsSeeThrough :: Bool
}
| Door
{ _wlLine :: (Point2,Point2)
, _wlID :: Int
, _doorMech :: World -> World
, _wlColor :: Color
, _wlSeen :: Bool
, _wlIsSeeThrough :: Bool
, _doorPathable :: Bool
, _drPositions :: DS.DS (Point2,Point2)
}
| Block
{ _wlLine :: (Point2,Point2)
, _wlID :: Int
, _wlColor :: Color
, _wlSeen :: Bool
, _blIDs :: [Int]
, _blHP :: Int
, _wlIsSeeThrough :: Bool
, _blVisible :: Bool
, _blDegrades :: [Int]
, _blShadows :: [Int]
}
data ForceField = FF
{ _ffLine :: [Point2] , _ffID :: Int
, _ffColor :: Color
, _ffDeflect :: Maybe (StdGen -> Point2 -> ForceField -> (Point2,StdGen))
, _ffState :: FFState
}
newtype FFState = FFDestroyable { _ffsHP :: Int }
data ActionPlan
= Inanimate
| ActionPlan
{_crImpulse :: [Impulse]
,_crAction :: [Action]
,_crStrategy :: Strategy
,_crGoal :: [Goal]
}
data Impulse
= Move Point2
| MoveForward Float
| Turn Float
| RandomTurn Float
| TurnToward Point2 Float
| MvTurnToward Point2
| MvForward
| TurnTo Point2
| UseItem
| SwitchToItem Int
| DropItem
-- | PickupNearby Int
-- | UseWorldObject Int
-- | Bark -- placeholder for various communication types
-- | UseIntrinsicAbility
| Melee Int
| ChangePosture Posture
| MakeSound SoundID
| ChangeStrategy Strategy
| AddGoal Goal
| ArbitraryImpulseFunction (World -> Creature -> Creature)
| ArbitraryImpulse (Creature -> World -> Impulse)
| ImpulseUseTargetCID
{_impulseUseTargetCID :: Int -> Impulse
}
| ImpulseUseTarget
{_impulseUseTarget :: Creature -> Impulse
}
| ImpulseUseAheadPos
{_impulseUseAheadPos :: Point2 -> Impulse
}
-- deriving (Eq,Ord,Show)
infixr 9 `WaitThen`
infixr 9 `DoActionThen`
infixr 9 `DoActionWhile`
infixr 9 `DoReplicate`
infixr 9 `DoImpulsesAlongside`
data Action
= AimAt
{_targetID :: Int
,_targetSeenAt :: Point2
}
| PathTo
{_pathToPoint :: Point2
}
| TurnToA
{_turnToAPoint :: Point2
}
-- | PickupItem
-- {_pickupItemID :: Int
-- }
| ImpulsesList
{_impulsesListList :: [[Impulse]]
}
| DoImpulses
{_doImpulsesList :: [Impulse]
}
| WaitThen
{_waitThenTimer :: Int
,_waitThenAction :: Action
}
| DoActionWhile
{_doActionWhileCondition :: (World, Creature) -> Bool
,_doActionWhileAction :: Action
}
| DoActionWhilePartial
{_doActionWhilePartial :: Action
,_doActionWhileCondition :: (World, Creature) -> Bool
,_doActionWhileAction :: Action
}
| DoActionIf
{_doActionIfCondition :: (World, Creature) -> Bool
,_doActionIfAction :: Action
}
| DoActionIfElse
{_doActionIfElseIfAction :: Action
,_doActionIfElseCondition :: (World, Creature) -> Bool
,_doActionIfElseElseAction :: Action
}
| DoActionWhileInterrupt
{_doActionWhileThenDo :: Action
,_doActionWhileThenCondition :: (World, Creature) -> Bool
,_doActionWhileThenThen :: Action
}
| DoActions
{_doActionsList :: [Action]
}
| DoActionThen
{_doActionThenFirst :: Action
,_doActionThenSecond :: Action
}
-- | DoGuardActions
-- {_doGuardActionsList :: [( (World, Creature) -> Bool, Action, Maybe Action)]
-- }
| DoReplicate
{_doReplicateTimes :: Int
,_doReplicateAction :: Action
}
| DoReplicatePartial
{_partialAction :: Action
,_doReplicateTimes :: Int
,_doReplicateAction :: Action
}
| LeadTarget
{_leadTargetBy :: Point2
}
| NoAction
| StartSentinelPost
| UseTarget
{_useTarget :: Maybe Creature -> Action
}
| UseSelf
{_useSelf :: Creature -> Action
}
| UseAheadPos
{_useAheadPos :: Point2 -> Action
}
| UseMvTargetPos
{_useMvTargetPos :: Maybe Point2 -> Action
}
| ArbitraryAction
{ _arbitraryAction :: Creature -> World -> Action }
| DoImpulsesAlongside
-- ^ Repeatedly perform impulses alongside a main action until the main action terminates
{_sideImpulses :: [Impulse]
,_mainAction :: Action
}
deriving (Generic)
-- deriving (Eq,Ord,Show)
data Strategy
= Flank Int
| Ambush Int
| Lure Int Point2
| Patrol [Point2]
| ShootAt Int
| FollowImpulses
| WatchAndWait
| StrategyActions Strategy [Action]
| GetTo Point2
| Reload
| Flee
| MeleeStrike
deriving (Generic)
-- deriving (Eq,Ord,Show)
data Goal
= LiveLongAndProsper
| Kill Int
| SentinelAt Point2 Float
makeLenses ''World
makeLenses ''Cloud
makeLenses ''Creature
makeLenses ''LightSource
makeLenses ''TempLightSource
makeLenses ''Item
makeLenses ''ItemPos
makeLenses ''ItEffect
makeLenses ''ItZoom
makeLenses ''FloorItem
makeLenses ''Ammo
makeLenses ''PjParam
makeLenses ''Projectile
makeLenses ''Particle
makeLenses ''Wall
makeLenses ''ForceField
makeLenses ''FFState
makeLenses ''PressPlate
makeLenses ''Button
makeLenses ''ActionPlan
makeLenses ''Impulse
makeLenses ''Action
makeLenses ''CrGroupParams
makeLenses ''CrMvType
makeLenses ''Intention
numColor :: Int -> Color
numColor 0 = toV4 (1,0,0,1)
numColor 1 = toV4 (0,1,0,1)
numColor 2 = toV4 (0,0,1,1)
numColor 3 = toV4 (1,1,0,1)
numColor 4 = toV4 (0,1,1,1)
numColor 5 = toV4 (1,0,1,1)
numColor 6 = toV4 (1,0,0.5,1)
numColor 7 = toV4 (0.5,0,1,1)
numColor 8 = toV4 (0,0.5,1,1)
numColor 9 = toV4 (0,1,0.5,1)
numColor 10 = toV4 (0.5,1,0,1)
numColor 11 = toV4 (1,0.5,0,1)
numColor 12 = toV4 (1,1,1,1)
numColor _ = toV4 (1,1,1,1)