Files
loop/src/Dodge/Data.hs
T
2022-07-17 10:57:29 +01:00

1467 lines
45 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 #-}
{-# 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
, module Dodge.Data.Creature
, module Dodge.Data.Block
, module Dodge.Data.Flare
, module Dodge.Data.LoadAction
, module Dodge.Data.ForegroundShape
, module Dodge.Data.Wall
, module Dodge.Data.Object
, module Dodge.Data.Zoning
, module Dodge.Data.Bounds
, module Dodge.Data.Sensor
, module Dodge.Combine.Data
, module Dodge.Distortion.Data
, module Dodge.Data.DamageType
, module Dodge.Data.SoundOrigin
, module Dodge.Creature.State.Data
, module Dodge.Creature.Stance.Data
, module Dodge.Creature.Perception.Data
, module Dodge.Creature.Memory.Data
, module Dodge.Item.Attachment.Data
, module Dodge.Item.Data
, module Dodge.Config.Data
, module Dodge.Equipment.Data
, module MaybeHelp
, module Dodge.Data.ItemAmount
, module Dodge.RoomCluster.Data
, module Dodge.Data.Room
, 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
import Dodge.Data.Creature
import Dodge.Data.Room
import Dodge.Data.Block
import Dodge.Data.Sensor
import Dodge.Data.Flare
import Dodge.Data.PathGraph
import Dodge.Data.Object
import Dodge.Data.Zoning
import Dodge.Data.ForegroundShape
import Dodge.Data.LoadAction
import Dodge.Data.Material
import Dodge.Data.Wall
import Dodge.Data.Bounds
import Dodge.RoomCluster.Data
import Dodge.Data.ItemAmount
import Dodge.ShortShow
import Dodge.Creature.State.Data
import Dodge.Creature.Stance.Data
import Dodge.Creature.Perception.Data
import Dodge.Creature.Memory.Data
import Dodge.Distortion.Data
import Dodge.Equipment.Data
import Dodge.Data.SoundOrigin
import Dodge.Data.DamageType
import Dodge.Combine.Data
import Dodge.Config.Data
import Dodge.Config.KeyConfig
import Dodge.Item.Attachment.Data
import Dodge.Item.Data
import Data.Preload
import Picture.Data
import ShapePicture
import Geometry.Data
import Geometry.ConvexPoly
import Sound.Data
import Dodge.GameRoom
import Color
import Data.Tile
import MaybeHelp
--import StreamingHelp.Data
--import qualified Data.Vector as V
import qualified Linear.Quaternion as Q
import GHC.Generics
import Control.Lens
import Control.Monad.State
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 qualified Data.Text as T
import SDL (Scancode, MouseButton)
import Streaming
type CRUpdate = Creature -> World -> (World -> World, Maybe Creature)
type CRUpdate' = Creature -> World -> (World -> World, Creature)
data Universe = Universe
{ _uvWorld :: World
, _preloadData :: PreloadData
, _menuLayers :: [ScreenLayer]
, _savedWorlds :: M.Map SaveSlot World
, _keyConfig :: KeyConfigSDL
, _config :: Configuration
}
data World = World
{ _keys :: S.Set Scancode
, _mouseButtons :: M.Map MouseButton Bool
, _mousePos :: Point2
, _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 :: Zoning IM.IntMap Creature
, _creatureGroups :: IM.IntMap CrGroupParams
, _itemPositions :: IM.IntMap ItemPos
, _clouds :: [Cloud]
, _clZoning :: Zoning [] Cloud
, _gusts :: IM.IntMap Gust
, _gsZoning :: Zoning IM.IntMap Gust
, _props :: IM.IntMap Prop
, _instantBullets :: [Bullet]
, _bullets :: [Bullet]
, _instantParticles :: [Particle]
, _particles :: [Particle]
, _radarBlips :: [RadarBlip]
, _flares :: [Flare]
, _newBeams :: WorldBeams
, _beams :: WorldBeams
, _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 (World -> Bool)
, _wlZoning :: Zoning IM.IntMap Wall
, _floorItems :: IM.IntMap FloorItem
, _floorTiles :: [(Point3,Point3)]
, _randGen :: StdGen
, _testString :: Configuration -> World -> [String]
, _modifications :: IM.IntMap Modification
, _yourID :: Int
, _worldEvents :: World -> World
, _delayedEvents :: [(Int,World -> World)]
, _pressPlates :: IM.IntMap PressPlate
, _buttons :: IM.IntMap Button
, _toPlaySounds :: M.Map SoundOrigin Sound
, _playingSounds :: M.Map SoundOrigin Sound
, _decorations :: IM.IntMap Picture
, _foregroundShapes :: IM.IntMap ForegroundShape
, _corpses :: IM.IntMap Corpse
, _clickMousePos :: Point2
, _pathGraph :: Gr Point2 PathEdge
-- , _pathGraphP :: S.Set (Point2,Point2)
, _pnZoning :: Zoning [] (Int,Point2)
, _peZoning :: Zoning [] (Int,Int,PathEdge)
, _hud :: HUD
, _lightSources :: IM.IntMap LightSource
, _tempLightSources :: [TempLightSource]
, _closeObjects :: [Either FloorItem Button]
, _rbOptions :: RightButtonOptions
, _seenLocations :: IM.IntMap (World -> Point2,String)
, _selLocation :: Int
, _sideEffects :: Universe -> IO Universe
, _distortions :: [Distortion]
, _worldBounds :: Bounds
, _gameRooms :: [GameRoom] -- consider using an IntMap
, _roomClipping :: [ConvexPoly]
, _maybeWorld :: Maybe' World
, _rewindWorlds :: [World]
, _timeFlow :: TimeFlowStatus
, _worldClock :: Int
, _hammers :: M.Map WorldHammer HammerPosition
, _backspaceTimer :: Int
, _genParams :: GenParams
, _genPlacements :: IM.IntMap [(Placement,Int)]
, _genRooms :: IM.IntMap Room
, _deathDelay :: Maybe Int
, _testFloat :: Float
, _lLine :: (Point2,Point2)
, _rLine :: (Point2,Point2)
, _lSelect :: Point2
, _rSelect :: Point2
}
data WorldHammer
= SubInvHam
| DoubleMouseHam
deriving (Eq,Ord,Show,Enum,Bounded)
newtype GenParams = GenParams
{ _sensorCoding :: M.Map DamageType (PaletteColor,DecorationShape)
}
data DecorationShape = PLUS | SQUARE | CIRCLE | THREELINES
deriving (Eq,Ord,Enum,Show,Read)
data TimeFlowStatus
= RewindingNow
| RewindingLastFrame
| NormalTimeFlow
deriving (Eq,Ord)
data SaveSlot = QuicksaveSlot | LevelStartSlot
deriving (Eq,Ord)
data Magnet = Magnet
{ _mgID :: Int
, _mgUpdate :: Magnet -> Maybe Magnet
, _mgPos :: Point2
, _mgField :: Magnet -> Bullet -> Bullet
}
data OptionScreenFlag = NormalOptions | GameOverOptions
data ScreenLayer
= OptionScreen
{ _scTitle :: Universe -> String
, _scOptions :: [MenuOption]
, _scDefaultEff :: Universe -> IO (Maybe Universe)
, _scOptionFlag :: OptionScreenFlag
, _scOptionsOffset :: Int
}
| ColumnsScreen
{ _scTitle :: Universe -> String
, _scColumns :: [(String,String)]
}
| InputScreen
{ _scInput :: T.Text
, _scFooter :: String
}
| WaitScreen
{ _scWaitMessage :: Universe -> String
, _scWaitTime :: Int
}
| DisplayScreen
{ _scDisplay :: Universe -> Picture
}
data MenuOption
= Toggle
{ _moEff :: Universe -> IO (Maybe Universe)
, _moString :: Universe -> Either String (String,String)
, _moKey :: Scancode
}
| Toggle2
{ _moKey1 :: Scancode
, _moEff1 :: Universe -> IO (Maybe Universe)
, _moKey2 :: Scancode
, _moEff2 :: Universe -> IO (Maybe Universe)
, _moString :: Universe -> Either String (String,String)
}
| InvisibleToggle
{ _moKey :: Scancode
, _moEff :: Universe -> IO (Maybe Universe)
}
data CrGroupParams = CrGroupParams
{ _crGroupParamID :: Int
, _crGroupIDs :: IS.IntSet
, _crGroupCenter :: Point2
, _crGroupUpdate :: World -> CrGroupParams -> Maybe CrGroupParams
}
data Corpse = Corpse
{ _cpID :: Int
, _cpPos :: Point2
, _cpDir :: Float
, _cpPict :: Corpse -> SPic
, _cpRes :: Maybe Creature
}
data Gust = Gust
{ _guID :: Int
, _guPos :: Point2
, _guVel :: Point2
, _guTime :: Int
}
data CreatureType
= Humanoid
{ _skinHead :: Color
, _skinUpper :: Color
, _skinLower :: Color
}
| DrawnCreature { _cdDraw :: Creature -> SPic }
data Creature = Creature
{ _crPos :: Point2
, _crOldPos :: Point2
, _crVel :: Point2
, _crDir :: Float
, _crOldDir :: Float
, _crMvDir :: Float
, _crTwist :: Float
, _crType :: CreatureType
, _crID :: Int
, _crUpdate :: Creature -> World -> World
, _crRad :: Float
, _crMass :: Float
, _crHP :: Int
, _crMaxHP :: Int
, _crInv :: IM.IntMap Item
, _crInvSel :: InvSel
, _crInvCapacity :: Int
, _crInvLock :: Bool
, _crInvEquipped :: IM.IntMap EquipPosition
, _crEquipment :: M.Map EquipPosition Int
, _crLeftInvSel :: Maybe Int
, _crState :: CreatureState
, _crCorpse :: Creature -> Corpse -> SPic
, _crMaterial :: Material
, _crPastDamage :: Int
, _crStance :: Stance
, _crActionPlan :: ActionPlan
, _crMeleeCooldown :: Int
, _crPerception :: Perception
, _crMemory :: Memory
, _crVocalization :: Vocalization
, _crFaction :: Faction
, _crGroup :: CrGroup
, _crIntention :: Intention
, _crMvType :: CrMvType
, _crHammerPosition :: HammerPosition
, _crName :: String
, _crStatistics :: CreatureStatistics
, _crCamouflage :: CamouflageStatus
}
data Intention = Intention
{ _targetCr :: Maybe Creature
, _mvToPoint :: Maybe Point2
, _viewPoint :: Maybe Point2
}
data Button = Button
{ _btPict :: Button -> SPic
, _btPos :: Point2
, _btRot :: Float
, _btEvent :: Button -> World -> World
, _btID :: Int
, _btText :: String
, _btState :: ButtonState
, _btTermMID :: Maybe Int
, _btName :: String
, _btColor :: Color
}
data TerminalLine
= TerminalLineDisplay
{_tlPause :: Int
,_tlString :: World -> (String, Color)
}
| TerminalLineTerminalEffect
{_tlPause :: Int
,_tlTermEffect :: Terminal -> Terminal
}
| TerminalLineEffect
{_tlPause :: Int
,_tlEffect :: Terminal -> World -> World
}
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 ItemUse
= RightUse
{ _rUse :: Item -> Creature -> World -> World
, _useDelay :: UseDelay
, _useMods :: [(Item -> Creature -> World -> World) -> Item -> Creature -> World -> World]
, _useHammer :: HammerPosition
, _useAim :: AimParams
, _heldScroll :: Float -> Creature -> Item -> Item
}
| LeftUse
{ _lUse :: Item -> Creature -> World -> World
, _useDelay :: UseDelay
, _useHammer :: HammerPosition
, _eqEq :: Equipment
}
| ConsumeUse
{ _cUse :: Item -> Creature -> World -> World
}
| EquipUse
{ _eqEq :: Equipment
}
| NoUse
data Equipment = Equipment
{ _eqUse :: Item -> Creature -> World -> World
, _eqOnEquip :: Item -> Creature -> World -> World
, _eqOnRemove :: Item -> Creature -> World -> World
, _eqSite :: EquipSite
, _eqParams :: EquipParams
, _eqViewDist :: Maybe Float
}
_itUseAimStance :: Item -> AimStance
_itUseAimStance = _aimStance . _useAim . _itUse
data ItemConsumption
= LoadableAmmo
{ _laAmmoType :: AmmoType
, _laMax :: Int
, _laLoaded :: Int
, _laPrimed :: Bool
, _laCycle :: [LoadAction]
, _laProgress :: Maybe [LoadAction]
}
| AutoRecharging
{ _arLoaded :: Int
, _arMax :: Int
, _arTime :: Int
, _arProgress :: Int
}
| ChargeableAmmo
{ _wpMaxCharge :: Int
, _wpCharge :: Int
}
| ItemItselfConsumable
{ _icAmount :: IcAmount
}
| NoConsumption
data Item = Item
{ _itConsumption :: ItemConsumption
, _itUse :: ItemUse
, _itType :: ItemType
, _itAttachment :: ItAttachment
, _itID :: Maybe Int
, _itPos :: ItemPos
, _itIsHeld :: Bool
, _itEffect :: ItEffect
, _itInvSize :: Float
, _itInvColor :: Color
, _itTargeting :: Targeting
, _itDimension :: ItemDimension
, _itCurseStatus :: CurseStatus
, _itTweaks :: ItemTweaks
, _itScope :: Scope
, _itValue :: ItemValue
, _itParams :: ItemParams
}
data Targeting
= NoTargeting
| Targeting
{ _tgPos :: Maybe Point2
, _tgUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting)
, _tgDraw :: Item -> Creature -> Configuration -> World -> Picture
, _tgID :: Maybe Int
, _tgActive :: Bool
}
-- I believe this is called every frame, not sure when though
data ItEffect
= NoItEffect
| ItInvEffect
{_ieInv :: Item -> Creature -> World -> World
,_ieCounter :: Int
}
| ItRewindEffect
{_ieInv :: Item -> Creature -> World -> World
,_ieStoredWorlds :: [World]
}
| ItEffect
{_ieInv :: Item -> Creature -> World -> World
,_ieFloor :: Int -> World -> World
,_ieCounter :: Int
}
| ItInvEffectID
{_ieInv :: Item -> Creature -> World -> World
,_ieMID :: Maybe Int
} -- the duplication of ieMID may cause errors...
| ItInvEffectDrop
{ _ieInv :: Item -> Creature -> World -> World
, _ieDrop :: Item -> Creature -> World -> World
, _ieMID :: Maybe Int
}
data IntID a = IntID Int a
data WorldBeams = WorldBeams
{_blockingBeams :: [Beam]
,_lightBeams :: [Beam]
,_positronBeams :: [Beam]
,_electronBeams :: [Beam]
}
{- | Linear beams. Last only one frame.
- Can interact with one another in a limited manner
- can probably be moved to a separate file
-}
data Beam = Beam
{ _bmDraw :: Beam -> Picture
, _bmPos :: Point2
, _bmDir :: Float
, _bmDamage :: Int
, _bmColor :: Color
, _bmPoints :: [Point2]
, _bmFirstPoints :: [Point2]
, _bmRange :: Float
, _bmPhaseV :: Float
, _bmOrigin :: Maybe Int
, _bmType :: BeamType
}
data BeamType
= BeamCombine
{_beamCombine :: (Point2 , (Point2,Point2,Beam) , (Point2,Point2,Beam)) -> World -> World}
| BeamSimple
data BulletState = NormalBulletState
| DyingBulletState
| DelayedBullet Float
data BulletUpdateMod = NoBulletUpdateMod
data Bullet = Bullet
{ _buState :: BulletState
, _buUpdateMod :: BulletUpdateMod
, _buTrajectory :: BulletTrajectory
, _buVel :: Point2
, _buDrag :: Float
, _buPos :: Point2
, _buOldPos :: Point2
, _buWidth :: Float
, _buTimer :: Int
-- , _buEffect :: BulletEffect
, _buHitEff :: HitEffect'
}
data BulletEffect = BulletSpark
| BulletBounce
| BulletBall EnergyBall
data EnergyBall = IncBall | TeslaBall | ConcBall
{- Objects without ids.
Update themselves, perhaps with side effects. -}
data Particle
= RadarCircleParticle
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptTimer :: Int
, _ptRad :: Float
, _ptPos :: Point2
, _ptColor :: Color
}
| LaserParticle
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptRange :: Float
, _ptDamage :: Int
, _ptColor :: Color
, _ptPhaseV :: Float
, _ptPoints :: [Point2]
}
| PtSpark
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptVel :: Point2
, _ptDrag :: Float
, _ptColor :: Color
, _ptTrail :: [Point2]
, _ptWidth :: Float
, _ptTimer :: Int
, _ptHitEff :: HitEffect
}
| PtTeslaArc
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptPoints :: [Point2]
, _ptTimer :: Int
, _ptColor :: Color
}
| PtTargetLaser
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptPoints :: [Point2]
, _ptColor :: Color
}
| PtFlame
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptVel :: Point2
, _ptColor :: Color
, _ptPos :: Point2
, _ptWidth :: Float
, _ptTimer :: Int
, _ptHitEff :: HitEffect
, _ptZ :: Float
, _ptOriginalVel :: Point2
}
| PtIncBall
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptVel :: Point2
, _ptColor :: Color
, _ptPos :: Point2
, _ptWidth :: Float
, _ptTimer :: Int
, _ptHitEff :: HitEffect
, _ptZ :: Float
, _ptRot :: Float
}
| PtStaticBall
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptVel :: Point2
, _ptColor :: Color
, _ptPos :: Point2
, _ptWidth :: Float
, _ptTimer :: Int
, _ptHitEff :: HitEffect
, _ptZ :: Float
}
| Shockwave
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptColor :: Color
, _ptPos :: Point2
, _ptRad :: Float
, _ptDam :: Int
, _ptPush :: Float
, _ptMaxTime :: Int
, _ptTimer :: Int
}
| PtInvShockwave
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptColor :: Color
, _ptPos :: Point2
, _ptRad :: Float
, _ptDam :: Int
, _ptPush :: Float
, _ptMaxTime :: Int
, _ptTimer :: Int
}
| ShockLine
{ _ptUpdate :: World -> Particle -> (World, Maybe Particle)
, _ptPointDirs :: [[(Point2,Float)]]
, _ptTimer :: Int
, _ptColor :: Color
, _ptCenter :: Point2
}
type HitEffect = Particle
-> Stream (Of (Point2, Either Creature Wall)) Identity ()
-> World
-> (World,Maybe Particle)
type HitEffect' = Bullet
-> Stream (Of (Point2, Either Creature Wall)) Identity ()
-> World
-> (World,Maybe Bullet)
data BulletTrajectory
= BasicBulletTrajectory
| BezierTrajectory Point2 Point2 Point2
| FlechetteTrajectory Point2
| MagnetTrajectory Point2
data AmmoType
= ProjectileAmmo
{ _amPayload :: Point2 -> World -> World
, _amString :: String
, _amPjDraw :: Prop -> SPic
, _amPjCreation :: Item -> Creature -> World -> World
-- , _aProjectile :: Ammo -> Prop
}
| BulletAmmo
{ _amString :: String
, _amBulEff :: HitEffect'
, _amBulWth :: Float
, _amBulVel :: Point2
, _amBulTraj :: BulletTrajectory
}
| DroneAmmo
{ _amString :: String }
| GasAmmo
{ _amString :: String
, _amCreateGas :: Float -> Point2 -> Float -> Creature -> World -> World
}
| ForceFieldAmmo
{ _amForceFieldType :: Wall
}
| GenericAmmo
data ItemTweaks
= NoTweaks
| Tweakable
{ _tweakParams :: IM.IntMap TweakParam
, _tweakSel :: Int
}
data TweakParam = TweakParam
{ _doTweak :: Int -> Item -> Item
, _curTweak :: Int
, _maxTweak :: Int
, _showTweak :: Int -> String
, _nameTweak :: String
}
data Nozzle = Nozzle
{ _nzPressure :: Float
, _nzDir :: Float
, _nzMaxWalkAngle :: Float
, _nzCurrentWalkAngle :: Float
, _nzWalkSpeed :: Float
, _nzLength :: Float
}
data GunBarrels
= MultiBarrel
{ _brlSpread :: BarrelSpread
, _brlNum :: Int
, _brlInaccuracy :: Float
}
| RotBarrel
{ _brlNum :: Int
, _brlInaccuracy :: Float
}
| SingleBarrel {_brlInaccuracy :: Float}
data EquipParams
= NoEquipParams
| EquipID {_eparamID :: Int}
| EquipCounter {_eparamInt :: Int}
data ItemParams
= NoParams
| ShellLauncher
{ _shellSpinDrag :: Int
, _shellSpinAmount :: Int
, _shellThrustDelay :: Int
}
| Refracting
{ _phaseV :: Float
, _lasColor :: Color
, _lasColor2 :: Color
, _lasCycle :: Int
, _lasDamage :: Int
}
| DualBeam
{ _phaseV :: Float
, _lasColor :: Color
, _lasColor2 :: Color
, _lasCycle :: Int
, _lasDamage :: Int
, _lasBeam :: BeamType
, _subParams :: Maybe ItemParams
, _dbGap :: Float
}
| Attracting {_attractionPower :: Point2}
| BulletShooter
{ _muzVel :: Float
, _rifling :: Float
, _bore :: Float
, _gunBarrels :: GunBarrels
, _recoil :: Float
, _torqueAfter :: Float
, _randomOffset :: Float
}
| Sprayer { _sprayNozzles :: [Nozzle] }
| AngleWalk
{ _maxWalkAngle :: Float
, _currentWalkAngle :: Float
, _walkSpeed :: Float
}
| Arcing
{ _currentArc :: Maybe [ArcStep]
, _arcSize :: Float
, _arcNumber :: Int
, _newArcStep :: ItemParams -> World
-> ArcStep
-> State StdGen (Maybe ArcStep)
, _previousArcEffect :: PreviousArcEffect
}
| ParamMID {_paramMID :: Maybe Int}
data ArcStep = ArcStep
{ _asPos :: Point2
, _asDir :: Float
, _asObject :: Maybe (Either Creature Wall)
}
data PreviousArcEffect = NoPreviousArcEffect | PerturbTillBreakPreviousArc
data Modification
= ModIDTimerPoint3Bool
{ _mdID :: Int
, _mdExternalID :: Int
, _mdUpdate :: Modification -> World -> World
, _mdTimer :: Int
, _mdPoint3 :: Point3
, _mdBool :: Bool
}
| ModIDID
{ _mdID :: Int
, _mdExternalID1 :: Int
, _mdExternalID2 :: Int
, _mdUpdate :: Modification -> World -> World
}
data Prop
= Projectile
{ _prPos :: Point2
, _pjStartPos :: Point2
, _pjVel :: Point2
, _prDraw :: Prop -> SPic
, _pjID :: Int
, _pjUpdate :: Prop -> World -> World
}
| PropZ
{ _prPos :: Point2
, _pjStartPos :: Point2
, _pjVel :: Point2
, _prDraw :: Prop -> SPic
, _pjID :: Int
, _pjUpdate :: Prop -> World -> World
, _pjPosZ :: Float
, _pjVelZ :: Float
, _pjTimer :: Int
, _pjQuat :: Q.Quaternion Float
, _pjQuatSpin :: Q.Quaternion Float
, _pjColor :: Color
}
| Drone
{ _prPos :: Point2
, _pjStartPos :: Point2
, _pjVel :: Point2
, _prDraw :: Prop -> SPic
, _pjID :: Int
, _pjUpdate :: Prop -> World -> World
}
| RecursiveProp
{ _prPos :: Point2
, _pjID :: Int
, _pjDraw :: Prop -> SPic
, _pjUpdate :: Prop -> World -> World
, _pjProp :: Prop
}
| ProjectileTimed
{ _prPos :: Point2
, _pjStartPos :: Point2
, _pjVel :: Point2
, _prDraw :: Prop -> SPic
, _pjID :: Int
, _pjUpdate :: Prop -> World -> World
, _pjTime :: Int
}
| ShapeProp
{ _prPos :: Point2
, _pjID :: Int
, _pjRot :: Float
, _pjUpdate :: Prop -> World -> World
, _prDraw :: Prop -> SPic
, _prToggle :: Bool
}
| RemoteShell
{ _prPos :: Point2
, _pjStartPos :: Point2
, _pjVel :: Point2
, _prDraw :: Prop -> SPic
, _pjID :: Int
, _pjUpdate :: Prop -> World -> World
, _pjPayload :: Point2 -> World -> World
}
| Shell
{ _prPos :: Point2
, _pjStartPos :: Point2
, _pjVel :: Point2
, _pjAcc :: Point2
, _pjDir :: Float
, _pjSpin :: Float
, _prDraw :: Prop -> SPic
, _pjID :: Int
, _pjUpdate :: Prop -> World -> World
, _pjPayload :: Point2 -> World -> World
, _pjTimer :: Int
, _pjZ :: Float
}
| Bomb
{ _prPos :: Point2
, _pjVel :: Point2
, _pjZ :: Float
, _pjVelZ :: Float
, _prDraw :: Prop -> SPic
, _pjID :: Int
, _pjUpdate :: Prop -> World -> World
, _pjPayload :: Point2 -> World -> World
, _pjTimer :: Int
}
| LinearShockwave
{ _prDraw :: Prop -> SPic
, _prPos :: Point2
, _pjID :: Int
, _pjUpdate :: Prop -> World -> World
, _pjPoints :: [(Point2,Point2)]
, _pjTimer :: Int
}
data Either3 a b c = E3x1 a | E3x2 b | E3x3 c
data TerminalStatus = TerminalOff | TerminalBusy | TerminalReady
deriving (Eq,Ord,Show)
data TerminalInput = TerminalInput
{ _tiText :: T.Text
, _tiFocus :: Bool
, _tiSel :: (Int,Int)
}
data Terminal = Terminal
{ _tmID :: Int
, _tmBootProgram :: Terminal -> World -> [TerminalLine]
, _tmButtonID :: Int
, _tmMachineID :: Int
, _tmName :: String
, _tmDisplayedLines :: [(String,Color)]
, _tmFutureLines :: [TerminalLine]
, _tmMaxLines :: Int
, _tmTitle :: String
, _tmInput :: TerminalInput
, _tmScrollCommands :: [TerminalCommand]
, _tmWriteCommands :: [TerminalCommand]
, _tmDeathEffect :: Terminal -> World -> World
, _tmStatus :: TerminalStatus
, _tmCommandHistory :: [String]
, _tmToggles :: M.Map String TerminalToggle
}
data TerminalToggle = TerminalToggle
{ _ttTriggerID :: Int
, _ttDeathEffect :: (World -> Bool) -> (World -> Bool)
}
data Machine = Machine
{ _mcID :: Int
, _mcWallIDs :: IS.IntSet
, _mcDraw :: Machine -> SPic
, _mcMaterial :: Material
, _mcPos :: Point2
, _mcDir :: Float
, _mcColor :: Color
, _mcHP :: Int
, _mcSensor :: Sensor
, _mcDamage :: [Damage]
, _mcType :: MachineType
, _mcMounts :: M.Map Object Int
, _mcName :: String
, _mcCloseSound :: Maybe SoundID
}
data MachineType
= StaticMachine
| Turret
{ _tuWeapon :: Item
, _tuTurnSpeed :: Float
, _tuFireTime :: Int
, _tuMCrID :: Maybe Int
}
data Door = Door
{ _drID :: Int
, _drWallIDs :: IS.IntSet
, _drStatus :: DoorStatus
, _drTrigger :: World -> Bool
, _drMech :: Door -> World -> World
, _drPos :: (Point2,Point2)
, _drOpenPos :: (Point2,Point2)
, _drClosePos :: (Point2,Point2)
, _drHP :: Int
, _drDeath :: Door -> World -> World
, _drSpeed :: Float
, _drPushedBy :: PushSource
, _drPushes :: Maybe Int
, _drMounts :: [MountedObject]
, _drObstructs :: [(Int,Int,PathEdge)]
, _drObstacleType :: EdgeObstacle
}
data MountedObject
= MountedLS Int
| MountedProp Int
deriving (Eq,Ord,Show)
data ActionPlan
= Inanimate
| ActionPlan
{_apImpulse :: [Impulse]
,_apAction :: [Action]
,_apStrategy :: Strategy
,_apGoal :: [Goal]
}
data Impulse
= Move Point2
| MoveForward Float
| Turn Float
| RandomTurn Float
| RandomImpulse (State StdGen Impulse)
| TurnToward Point2 Float
| MvTurnToward Point2
| MvForward
| TurnTo Point2
| UseItem
| SwitchToItem Int
| DropItem
| Bark SoundID -- placeholder for various communication types
| Melee Int
| ChangePosture Posture
| MakeSound SoundID
| ChangeStrategy Strategy
| AddGoal Goal
| ArbitraryImpulseFunction (World -> Creature -> Creature)
| ArbitraryImpulse (Creature -> World -> Impulse)
| ArbitraryImpulseEffect (Creature -> World -> World)
| ImpulseUseTargetCID
{_impulseUseTargetCID :: Int -> Impulse
}
| ImpulseUseTarget
{_impulseUseTarget :: Creature -> Impulse
}
| ImpulseUseAheadPos
{_impulseUseAheadPos :: Point2 -> Impulse
}
instance Show Impulse where
show imp = case imp of
Move p -> "Move "++shortPoint2 p
MoveForward f -> "MoveForward "++ show f
Turn f -> "Turn "++show f
RandomTurn f -> "RandomTurn "++show f
TurnToward p f -> "TurnToward "++shortPoint2 p++show f
MvTurnToward p -> "MvTurnToward "++shortPoint2 p
MvForward -> "MvForward"
TurnTo p -> "TurnTo "++shortPoint2 p
UseItem -> "UseItem"
SwitchToItem i -> "SwitchToItem "++show i
DropItem -> "DropItem"
Bark sid -> "Bark "++show sid
Melee i -> "Melee "++show i
ChangePosture post -> "ChangePosture " ++ show post
MakeSound sid -> "MakeSound " ++ show sid
ChangeStrategy s -> "ChangeStrategy " ++ show s
AddGoal g -> "AddGoal " ++ show g
ArbitraryImpulseFunction {} -> "ArbitraryImpulseFunction"
ArbitraryImpulse {} -> "ArbitraryImpulse"
ArbitraryImpulseEffect {} -> "ArbitraryImpulseEffect"
ImpulseUseTargetCID {} -> "ImpulseUseTargetCID"
ImpulseUseTarget {} -> "ImpulseUseTarget"
ImpulseUseAheadPos {} -> "ImpulseUseAheadPos"
RandomImpulse {} -> "RandomImpulse"
-- deriving (Eq,Ord,Show)
infixr 9 `WaitThen`
infixr 9 `DoActionThen`
infixr 9 `DoActionWhile`
infixr 9 `DoReplicate`
infixr 9 `DoImpulsesAlongside`
data Action
= LabelAction
{_actLabel :: String
,_actAction :: Action
}
| AimAt
{_targetID :: Int
,_targetSeenAt :: Point2
}
| PathTo
{_pathToPoint :: Point2
}
| TurnToPoint
{_turnToPoint :: 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)
instance Show Action where
show act = case act of
LabelAction
{_actLabel = str
,_actAction = subAct
} -> str++":"++show subAct
AimAt
{_targetID = tid
,_targetSeenAt = p
} -> "AimAt tid:"++show tid++" seenAt:"++shortPoint2 p
PathTo
{_pathToPoint = p
} -> "PathTo:"++shortPoint2 p
TurnToPoint
{_turnToPoint = p
} -> "TurnToPoint:"++shortPoint2 p
---- | PickupItem
---- {_pickupItemID :: Int
---- }
ImpulsesList
{_impulsesListList = iss
} -> "ImpulsesList:"++show iss
DoImpulses
{_doImpulsesList = is
} -> "DoImpulses:"++show is
WaitThen
{_waitThenTimer = i
,_waitThenAction = a
} -> "WaitThen timer:"++show i++" act:"++show a
DoActionWhile
{_doActionWhileCondition = _
,_doActionWhileAction = a
} -> "DoActionWhile (function) act:"++show a
DoActionWhilePartial
{_doActionWhilePartial = partact
,_doActionWhileCondition = _
,_doActionWhileAction = a
} -> "DoActionWhilePartial partAct:"++show partact++" resetAct:"++show a
DoActionIf
{_doActionIfCondition = _
,_doActionIfAction = a
} -> "DoActionIf act:"++show a
DoActionIfElse
{_doActionIfElseIfAction = ifa
,_doActionIfElseCondition = _
,_doActionIfElseElseAction = elsea
} -> "DoActionIfElse ifa:"++show ifa++" elsea:"++show elsea
DoActionWhileInterrupt
{_doActionWhileThenDo = whilea
,_doActionWhileThenCondition = _
,_doActionWhileThenThen = thena
} -> "DoActionWhileInterrupt whilea:" ++show whilea++" interrupta:"++show thena
DoActions
{_doActionsList = as
} -> "DoActions " ++ foldMap show as
DoActionThen
{_doActionThenFirst = a1
,_doActionThenSecond = a2
} -> "DoActionThen " ++ show a1 ++ " then:" ++ show a2
---- | DoGuardActions
---- {_doGuardActionsList :: [( (World, Creature) -> Bool, Action, Maybe Action)]
---- }
DoReplicate
{_doReplicateTimes = i
,_doReplicateAction = a
} -> "DoReplicate times:" ++ show i ++ " act:"++ show a
DoReplicatePartial
{_partialAction = pa
,_doReplicateTimes = i
,_doReplicateAction = ra
} -> "DoReplicatePartial pa:" ++ show pa ++ " times:" ++ show i ++ " reset:"++ show ra
LeadTarget
{_leadTargetBy = p
} -> "LeadTarget by:"++ show p
NoAction -> "NoAction"
StartSentinelPost -> "StartSentinelPost"
UseTarget
{_useTarget = _
} -> "UseTarget func"
UseSelf
{_useSelf = _
} -> "UseSelf func"
UseAheadPos
{_useAheadPos = _
} -> "UseAheadPos func"
UseMvTargetPos
{_useMvTargetPos = _
} -> "UseMvTargetPos func"
ArbitraryAction {} -> "ArbitraryAction func"
DoImpulsesAlongside
{_sideImpulses = is
,_mainAction = a
} -> "DoImpulsesAlongside sideImpulses:"++show is ++ " mainA:"++show a
-- deriving (Eq,Ord,Show)
data Strategy
= Flank Int
| Ambush Int
| Lure Int Point2
| Patrol [Point2]
| ShootAt Int
| FollowImpulses
| WatchAndWait
| WarningCry
| LookAround
| CloseToMelee Int
| StrategyActions Strategy [Action]
| GetTo Point2
| Reload
| Flee
| MeleeStrike
deriving (Generic,Show)
-- deriving (Eq,Ord,Show)
data Goal
= LiveLongAndProsper
| Kill Int
| SentinelAt Point2 Float
deriving (Show)
data DamageEffect
= PushDamage
{ _dePush :: Float
, _dePushExp :: Float
, _dePushRadius :: Float
}
| TorqueDamage { _deTorque :: Float }
| PushBackDamage {_dePushBack :: Point2 }
| BounceBullet {_bulToBounce :: Bullet}
| DamageSpawn {_spawnFunc
:: Either Creature Wall -> Damage -> State StdGen Particle}
| DamageSpawn' {_spawnFunc'
:: Either Creature Wall -> Damage -> State StdGen Bullet}
| NoDamageEffect
-- deriving (Eq,Ord,Show)
data Damage = Damage
{ _dmType :: DamageType
, _dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2
, _dmEffect :: DamageEffect
}
-- deriving (Eq,Ord,Show)
isElectrical :: Damage -> Bool
isElectrical dm = case _dmType dm of
ELECTRICAL -> True
_ -> False
isMovementDam :: Damage -> Bool
isMovementDam dm = case _dmType dm of
TORQUEDAM -> True
PUSHDAM -> True
_ -> False
data CreatureState = CrSt
{ _csDamage :: [Damage]
, _csSpState :: CrSpState
, _csDropsOnDeath :: CreatureDropType
}
data EffectArguments
= NoArguments {_cmdEffect :: [TerminalLine]}
| OneArgument
{_argType :: String
,_argList :: M.Map String [TerminalLine]
}
data TerminalCommand = TerminalCommand
{ _tcString :: String
, _tcAlias :: [String]
, _tcHelp :: String
, _tcEffect :: Terminal -> World -> EffectArguments
}
---- ROOM DATATYPES
data PSType = PutCrit {_unPutCrit :: Creature}
| PutMachine { _putMachinePoly :: [Point2], _unPutMachine :: Machine }
| PutLS LightSource
| PutButton {_putButton :: Button}
| PutProp Prop
| PutTerminal {_unputTerminal :: Terminal}
| PutFlIt {_putItem :: Item}
| PutPPlate PressPlate
| PutBlock {_putBlock :: Block, _putWall :: Wall, _putPoly :: [Point2] }
| PutCoord Point2
| PutMod Modification
| PutTrigger (World -> Bool)
| PutLineBlock {_putWall :: Wall , _putWidth :: Float
, _putStartPoint :: Point2, _putEndPoint :: Point2}
| PutWall { _pwPoly :: [Point2] , _pwWall :: Wall }
| PutSlideDr Door Wall EdgeObstacle Float Point2 Point2
| PutDoor Color EdgeObstacle (World -> Bool) [(Point2,Point2)]
| RandPS (State StdGen PSType)
| PutForeground ForegroundShape
| PutDecoration Picture
| PutWorldUpdate (PlacementSpot -> World -> World)
| PutNothing
| PutUsingGenParams (World -> (World,PSType))
| PutID { _putID :: Int}
-- maybe there is a monadic implementation of this?
-- add room effect for any placement spot?
data PlacementSpot
= PS { _psPos :: Point2 , _psRot :: Float }
| PSNoShiftCont { _psPos :: Point2 , _psRot :: Float }
| PSPos
{ _psSelect :: RoomPos -> Room -> Maybe (PlacementSpot, RoomPos)
, _psRoomEff :: RoomPos -> Room -> Room
, _psFallback :: Maybe Placement
}
| PSRoomRand
{ _psRoomRandPointNum :: Int
, _psRandShift :: (Point2,Float) -> PlacementSpot
}
-- TODO attempt to unify/simplify this union type
data Placement
= Placement
{ _plOrder :: Int
, _plSpot :: PlacementSpot
, _plType :: PSType
, _plMID :: Maybe Int
, _plIDCont :: World -> Placement -> Maybe Placement
}
| PlacementUsingPos Point3 (Point3 -> Placement) -- allows a placement to use a shifted position
| RandomPlacement {_unRandomPlacement :: State StdGen Placement}
| PickOnePlacement Int Placement
{- The '_rmPolys' lists which polygons should be cut out to form the indestructible walls of the room.
Link pairs contain a position and rotation to attach to another room;
0 is for links going to another room to the north, pi/2 for links going to a room to the west, etc.
TODO : Explain path, does it need both directions?
Placement spots allow things to be put in the room during level generation.
Room bounds between a new room and previously placed rooms are checked during level generation,
assigning no bounds will allow rooms to overlap. -}
data Room = Room
{ _rmPolys :: [ [Point2] ]
, _rmLinks :: [RoomLink]
-- the Int is the number of previous outlinks that have been assigned
, _rmLinkEff
:: RoomLink -- ^ child link
-> Room -- ^ child room
-> Int -- ^ child number
-> RoomLink -- ^ parent link
-> Room -- ^ parent room
-> Room
, _rmPos :: [RoomPos]
, _rmPath :: S.Set (Point2, Point2)
, _rmPmnts :: [Placement]
, _rmInPmnt :: [InPlacement]
, _rmOutPmnt :: [OutPlacement]
, _rmBound :: [ [Point2] ]
, _rmFloor :: Floor
, _rmName :: String
, _rmShift :: (Point2, Float)
, _rmViewpoints :: [Point2]
, _rmRandPSs :: [State StdGen (Point2,Float)]
, _rmStartWires :: IM.IntMap RoomWire
, _rmEndWires :: IM.IntMap RoomWire
, _rmConnectsTo :: S.Set RoomLinkType -> Bool
, _rmMID :: Maybe Int
, _rmMParent :: Maybe Int
, _rmChildren :: [Int]
, _rmType :: RoomType
, _rmClusterStatus :: ClusterStatus
}
data OutPlacement = OutPlacement
{ _opPlacement :: Placement
, _opPlacementID :: Int
}
data InPlacement = InPlacement
{ _ipPlacement :: [Placement] -> Placement
, _ipPlacementID :: Int
}
makeLenses ''CreatureState
makeLenses ''Damage
makeLenses ''DamageEffect
makeLenses ''World
makeLenses ''Creature
makeLenses ''Item
makeLenses ''ItemUse
makeLenses ''ItEffect
makeLenses ''FloorItem
makeLenses ''ItemConsumption
makeLenses ''AmmoType
makeLenses ''TweakParam
makeLenses ''Prop
makeLenses ''Modification
makeLenses ''Particle
makeLenses ''Bullet
makeLenses ''PressPlate
makeLenses ''Button
makeLenses ''ActionPlan
makeLenses ''Impulse
makeLenses ''Action
makeLenses ''CrGroupParams
makeLenses ''Intention
makeLenses ''Door
makeLenses ''Terminal
makeLenses ''Machine
makeLenses ''MachineType
makeLenses ''Universe
makeLenses ''ItemParams
makeLenses ''ItemTweaks
makeLenses ''Magnet
makeLenses ''Gust
makeLenses ''GunBarrels
makeLenses ''Targeting
makeLenses ''Nozzle
makeLenses ''TerminalLine
makeLenses ''Equipment
makeLenses ''ScreenLayer
makeLenses ''Beam
makeLenses ''BeamType
makeLenses ''WorldBeams
makeLenses ''ArcStep
makeLenses ''EquipParams
makeLenses ''TerminalCommand
makeLenses ''TerminalInput
makeLenses ''GenParams
makeLenses ''CreatureType
makeLenses ''Corpse
----- ROOM LENSES
makeLenses ''Room
makeLenses ''RoomType
makeLenses ''PSType
makeLenses ''PlacementSpot
makeLenses ''Placement
crSel :: Creature -> Int
crSel = _iselPos . _crInvSel