Files
loop/src/Dodge/Data.hs
T
2022-07-24 20:55:44 +01:00

573 lines
19 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.CrGroupParams
, module Dodge.Data.Corpse
, module Dodge.Data.ActionPlan
, module Dodge.Data.CreatureEffect
, module Dodge.Data.WorldEffect
, module Dodge.Data.Button
, module Dodge.Data.Item.Params
, module Dodge.Data.Beam
, module Dodge.Data.Targeting
, module Dodge.Data.ItEffect
, module Dodge.Data.Hammer
, module Dodge.Data.Item.Use
, module Dodge.Data.Item.UseDelay
, module Dodge.Data.ArcStep
, module Dodge.Data.CrWlID
, module Dodge.Data.Item.HeldUse
, module Dodge.Data.Item.HeldScroll
, module Dodge.Data.Item.Consumption
, module Dodge.Data.Gas
, module Dodge.Data.Ammo
, module Dodge.Data.Payload
, module Dodge.Data.RadarSweep
, module Dodge.Data.PosEvent
, module Dodge.Data.EnergyBall
, module Dodge.Data.Flame
, module Dodge.Data.Magnet
, module Dodge.Data.Spark
, module Dodge.Data.Bullet
, 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.Damage
, 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
, module Dodge.Data.Gust
, module Dodge.Data.Projectile
, module Dodge.Data.Modification
, module Dodge.Data.PressPlate
, module Dodge.Data.Laser
, module Dodge.Data.TeslaArc
, module Dodge.Data.Shockwave
, module Dodge.Data.Prop
, module Dodge.Data.LinearShockwave
, module Dodge.Data.TractorBeam
, module Dodge.Data.MountedObject
, module Dodge.Data.Machine
, module Dodge.Data.GenParams
) where
import Dodge.Data.GenParams
import Dodge.Data.Machine
import Dodge.Data.MountedObject
import Dodge.Data.TractorBeam
import Dodge.Data.LinearShockwave
import Dodge.Data.Prop
import Dodge.Data.Shockwave
import Dodge.Data.TeslaArc
import Dodge.Data.Laser
import Dodge.Data.PressPlate
import Dodge.Data.Modification
import Dodge.Data.Projectile
import Dodge.Data.Gust
import Dodge.Data.CrGroupParams
import Dodge.Data.Corpse
import Dodge.Data.ActionPlan
import Dodge.Data.CreatureEffect
import Dodge.Data.WorldEffect
import Dodge.Data.Button
import Dodge.Data.Item.Params
import Dodge.Data.Beam
import Dodge.Data.Targeting
import Dodge.Data.ItEffect
import Dodge.Data.Hammer
import Dodge.Data.Item.Use
import Dodge.Data.Item.UseDelay
import Dodge.Data.CrWlID
import Dodge.Data.ArcStep
import Dodge.Data.Item.HeldUse
import Dodge.Data.Item.HeldScroll
import Dodge.Data.Item.Consumption
import Dodge.Data.Gas
import Dodge.Data.Ammo
import Dodge.Data.Payload
import Dodge.Data.RadarSweep
import Dodge.Data.PosEvent
import Dodge.Data.EnergyBall
import Dodge.Data.Flame
import Dodge.Data.Magnet
import Dodge.Data.Spark
import Dodge.Data.Bullet
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.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.Damage
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 Geometry.Data
import Geometry.ConvexPoly
import Sound.Data
import Dodge.GameRoom
import Color
import Data.Tile
import MaybeHelp
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 IntMapHelp 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
, _uvIOEffects :: Universe -> IO Universe
, _uvConfig :: Configuration
, _uvTestString :: Universe -> [String]
}
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 :: IM.IntMap (IM.IntMap IS.IntSet) --Zoning IM.IntMap Creature
, _creatureGroups :: IM.IntMap CrGroupParams
, _itemPositions :: IM.IntMap ItemPos
, _clouds :: [Cloud]
--, _clZoning :: Zoning [] Cloud
, _clZoning :: IM.IntMap (IM.IntMap [Cloud]) --Zoning IM.IntMap Creature
, _gusts :: IM.IntMap Gust
, _gsZoning :: IM.IntMap (IM.IntMap IS.IntSet)
, _props :: IM.IntMap Prop
, _projectiles :: IM.IntMap Proj
, _instantBullets :: [Bullet]
, _bullets :: [Bullet]
-- , _instantParticles :: [Particle]
-- , _particles :: [Particle]
, _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)]
, _randGen :: StdGen
, _modifications :: IM.IntMap Modification
, _yourID :: Int
, _worldEvents :: [WorldEffect]
, _delayedEvents :: [(Int,WorldEffect)]
, _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
--, _pnZoning :: Zoning [] (Int,Point2)
--, _peZoning :: Zoning [] (Int,Int,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]
, _rbOptions :: RightButtonOptions
, _seenLocations :: IM.IntMap (WdP2,String)
, _selLocation :: Int
, _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
}
--deriving (Eq,Show,Read)
data WorldHammer
= SubInvHam
| DoubleMouseHam
deriving (Eq,Ord,Show,Read,Enum,Bounded)
data TimeFlowStatus
= RewindingNow
| RewindingLastFrame
| NormalTimeFlow
deriving (Eq,Ord,Show,Read)
data SaveSlot = QuicksaveSlot | LevelStartSlot
deriving (Eq,Ord,Show,Read)
data OptionScreenFlag = NormalOptions | GameOverOptions
deriving (Eq,Ord,Show,Read)
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 TerminalLine
= TerminalLineDisplay
{_tlPause :: Int
,_tlString :: World -> (String, Color)
}
| TerminalLineTerminalEffect
{_tlPause :: Int
,_tlTermEffect :: Terminal -> Terminal
}
| TerminalLineEffect
{_tlPause :: Int
,_tlEffect :: Terminal -> World -> World
}
data FloorItem = FlIt { _flIt :: Item , _flItPos :: Point2 , _flItRot :: Float, _flItID :: Int}
deriving (Eq,Ord,Show,Read)
data IntID a = IntID Int a
data WorldBeams = WorldBeams
{_blockingBeams :: [Beam]
,_lightBeams :: [Beam]
,_positronBeams :: [Beam]
,_electronBeams :: [Beam]
}
deriving (Eq,Ord,Show,Read)
{- Objects without ids.
Update themselves, perhaps with side effects. -}
--data Particle = DPart
-- = 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' = Flame
-> Stream (Of (Point2, Either Creature Wall)) Identity ()
-> World
-> (World,Maybe Flame)
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 :: Bool -> Bool
}
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], _putMachineMachine :: Machine , _putMachineWall :: Wall}
| 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 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 WdBl [(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 ''World
makeLenses ''FloorItem
--makeLenses ''Particle
makeLenses ''Terminal
makeLenses ''Universe
makeLenses ''GunBarrels
makeLenses ''Nozzle
makeLenses ''TerminalLine
makeLenses ''Equipment
makeLenses ''ScreenLayer
makeLenses ''WorldBeams
makeLenses ''TerminalCommand
makeLenses ''TerminalInput
----- ROOM LENSES
makeLenses ''Room
makeLenses ''RoomType
makeLenses ''PSType
makeLenses ''PlacementSpot
makeLenses ''Placement
_itUseAimStance :: Item -> AimStance
_itUseAimStance = _aimStance . _useAim . _itUse
crSel :: Creature -> Int
crSel = _iselPos . _crInvSel