{-# LANGUAGE TupleSections #-}
-- | General content types and operations.
module Game.LambdaHack.Common.Kind
  ( ContentData  -- re-exported without some operations
  , COps(..)
  , emptyCOps
  , ItemSpeedup
  , getKindMean, speedupItem
  , okind, omemberGroup, oisSingletonGroup, ouniqGroup, opick
  , ofoldlWithKey', ofoldlGroup', omapVector, oimapVector
  , olength, linearInterpolation
#ifdef EXPOSE_INTERNAL
  , emptyMultiGroupItem, emptyUnknownTile
  , emptyUIFactionGroupName, emptyMultiGroupMode
#endif
    -- * Operations both internal and used in unit tests
  , emptyUIFaction
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.Vector as V

import qualified Game.LambdaHack.Common.ItemAspect as IA
import qualified Game.LambdaHack.Common.Tile as Tile
import qualified Game.LambdaHack.Content.CaveKind as CK
import qualified Game.LambdaHack.Content.FactionKind as FK
import qualified Game.LambdaHack.Content.ItemKind as IK
import qualified Game.LambdaHack.Content.ModeKind as MK
import qualified Game.LambdaHack.Content.PlaceKind as PK
import qualified Game.LambdaHack.Content.RuleKind as RK
import qualified Game.LambdaHack.Content.TileKind as TK
import qualified Game.LambdaHack.Definition.Ability as Ability
import qualified Game.LambdaHack.Definition.Color as Color
import           Game.LambdaHack.Definition.ContentData
import           Game.LambdaHack.Definition.Defs
import           Game.LambdaHack.Definition.DefsInternal
  (GroupName (GroupName), toContentSymbol)
import           Game.LambdaHack.Definition.Flavour (dummyFlavour)

-- | Operations for all content types, gathered together.
--
-- Warning: this type is not abstract, but its values should not be
-- created ad hoc, even for unit tests, but should be constructed
-- with @makeData@ for each particular content kind, which includes validation,
-- and with @speedupItem@, etc., to ensure internal consistency.
--
-- The @emptyCOps@ is one such valid by construction value of this type,
-- except for the @cocave@ field. It's suitable for bootstrapping
-- and for tests not involving dungeon generation from cave templates.
data COps = COps
  { COps -> ContentData CaveKind
cocave        :: ContentData CK.CaveKind   -- server only
  , COps -> ContentData FactionKind
cofact        :: ContentData FK.FactionKind
  , COps -> ContentData ItemKind
coitem        :: ContentData IK.ItemKind
  , COps -> ContentData ModeKind
comode        :: ContentData MK.ModeKind   -- server only
  , COps -> ContentData PlaceKind
coplace       :: ContentData PK.PlaceKind  -- server only, so far
  , COps -> RuleContent
corule        :: RK.RuleContent
  , COps -> ContentData TileKind
cotile        :: ContentData TK.TileKind
  , COps -> ItemSpeedup
coItemSpeedup :: ItemSpeedup
  , COps -> TileSpeedup
coTileSpeedup :: Tile.TileSpeedup
  }

instance Show COps where
  show :: COps -> String
show COps
_ = String
"game content"

instance Eq COps where
  == :: COps -> COps -> Bool
(==) COps
_ COps
_ = Bool
True

emptyMultiGroupItem :: IK.ItemKind
emptyMultiGroupItem :: ItemKind
emptyMultiGroupItem = ItemKind :: ContentSymbol ItemKind
-> Text
-> Freqs ItemKind
-> [Flavour]
-> Dice
-> Rarity
-> Text
-> Int
-> Dice
-> [Aspect]
-> [Effect]
-> [(GroupName ItemKind, CStore)]
-> Text
-> ItemKind
IK.ItemKind
  { isymbol :: ContentSymbol ItemKind
isymbol  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'E'
  , iname :: Text
iname    = Text
"emptyCOps item"
  , ifreq :: Freqs ItemKind
ifreq    = (GroupName ItemKind -> (GroupName ItemKind, Int))
-> [GroupName ItemKind] -> Freqs ItemKind
forall a b. (a -> b) -> [a] -> [b]
map (, Int
1) ([GroupName ItemKind] -> Freqs ItemKind)
-> [GroupName ItemKind] -> Freqs ItemKind
forall a b. (a -> b) -> a -> b
$ [GroupName ItemKind]
IK.mandatoryGroups [GroupName ItemKind]
-> [GroupName ItemKind] -> [GroupName ItemKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ItemKind]
IK.mandatoryGroupsSingleton
  , iflavour :: [Flavour]
iflavour = [Flavour
dummyFlavour]
  , icount :: Dice
icount   = Dice
0
  , irarity :: Rarity
irarity  = []
  , iverbHit :: Text
iverbHit = Text
""
  , iweight :: Int
iweight  = Int
0
  , idamage :: Dice
idamage  = Dice
0
  , iaspects :: [Aspect]
iaspects = []
  , ieffects :: [Effect]
ieffects = []
  , idesc :: Text
idesc    = Text
""
  , ikit :: [(GroupName ItemKind, CStore)]
ikit     = []
  }

emptyUnknownTile :: TK.TileKind
emptyUnknownTile :: TileKind
emptyUnknownTile = TileKind :: ContentSymbol ItemKind
-> Text
-> Freqs TileKind
-> Color
-> Color
-> Word8
-> [Feature]
-> TileKind
TK.TileKind  -- needs to have index 0 and alter 1
  { tsymbol :: ContentSymbol ItemKind
tsymbol  = ContentSymbol ItemKind
'E'
  , tname :: Text
tname    = Text
"unknown space"  -- name checked in validation
  , tfreq :: Freqs TileKind
tfreq    = (GroupName TileKind -> (GroupName TileKind, Int))
-> [GroupName TileKind] -> Freqs TileKind
forall a b. (a -> b) -> [a] -> [b]
map (, Int
1) ([GroupName TileKind] -> Freqs TileKind)
-> [GroupName TileKind] -> Freqs TileKind
forall a b. (a -> b) -> a -> b
$ [GroupName TileKind]
TK.mandatoryGroups [GroupName TileKind]
-> [GroupName TileKind] -> [GroupName TileKind]
forall a. [a] -> [a] -> [a]
++ [GroupName TileKind]
TK.mandatoryGroupsSingleton
  , tcolor :: Color
tcolor   = Color
Color.BrMagenta
  , tcolor2 :: Color
tcolor2  = Color
Color.BrMagenta
  , talter :: Word8
talter   = Word8
1
  , tfeature :: [Feature]
tfeature = []
  }

emptyUIFactionGroupName :: GroupName FK.FactionKind
emptyUIFactionGroupName :: GroupName FactionKind
emptyUIFactionGroupName = Text -> GroupName FactionKind
forall c. Text -> GroupName c
GroupName Text
"emptyUIFaction"

emptyUIFaction :: FK.FactionKind
emptyUIFaction :: FactionKind
emptyUIFaction = FactionKind :: Text
-> Freqs FactionKind
-> TeamContinuity
-> Freqs ItemKind
-> Skills
-> Bool
-> Bool
-> HiCondPoly
-> Bool
-> Doctrine
-> Bool
-> Bool
-> Bool
-> Bool
-> [TeamContinuity]
-> [TeamContinuity]
-> FactionKind
FK.FactionKind
  { fname :: Text
fname = Text
"emptyUIFaction"
  , ffreq :: Freqs FactionKind
ffreq = [(GroupName FactionKind
emptyUIFactionGroupName, Int
1)]
  , fteam :: TeamContinuity
fteam = Int -> TeamContinuity
FK.TeamContinuity Int
999  -- must be > 0
  , fgroups :: Freqs ItemKind
fgroups = []
  , fskillsOther :: Skills
fskillsOther = Skills
Ability.zeroSkills
  , fcanEscape :: Bool
fcanEscape = Bool
False
  , fneverEmpty :: Bool
fneverEmpty = Bool
True  -- to keep the dungeon alive
  , fhiCondPoly :: HiCondPoly
fhiCondPoly = []
  , fhasGender :: Bool
fhasGender = Bool
False
  , finitDoctrine :: Doctrine
finitDoctrine = Doctrine
Ability.TBlock
  , fspawnsFast :: Bool
fspawnsFast = Bool
False
  , fhasPointman :: Bool
fhasPointman = Bool
False
  , fhasUI :: Bool
fhasUI = Bool
True  -- to own the UI frontend
  , finitUnderAI :: Bool
finitUnderAI = Bool
False
  , fenemyTeams :: [TeamContinuity]
fenemyTeams = []
  , falliedTeams :: [TeamContinuity]
falliedTeams = []
  }

emptyMultiGroupMode :: MK.ModeKind
emptyMultiGroupMode :: ModeKind
emptyMultiGroupMode = ModeKind :: Text
-> Freqs ModeKind
-> Bool
-> Bool
-> Roster
-> Caves
-> [(Outcome, Text)]
-> Text
-> Text
-> Text
-> Text
-> ModeKind
MK.ModeKind
  { mname :: Text
mname   = Text
"emptyMultiGroupMode"
  , mfreq :: Freqs ModeKind
mfreq   = (GroupName ModeKind -> (GroupName ModeKind, Int))
-> [GroupName ModeKind] -> Freqs ModeKind
forall a b. (a -> b) -> [a] -> [b]
map (, Int
1) [GroupName ModeKind]
MK.mandatoryGroups
  , mtutorial :: Bool
mtutorial = Bool
False
  , mattract :: Bool
mattract = Bool
False
  , mroster :: Roster
mroster = [(GroupName FactionKind
emptyUIFactionGroupName, [])]
  , mcaves :: Caves
mcaves  = []
  , mendMsg :: [(Outcome, Text)]
mendMsg = []
  , mrules :: Text
mrules  = Text
""
  , mdesc :: Text
mdesc   = Text
""
  , mreason :: Text
mreason = Text
""
  , mhint :: Text
mhint   = Text
""
  }

-- | This is as empty, as possible, but still valid content, except for
-- @cocave@ which is empty and not valid (making it valid would require
-- bloating most other contents).
emptyCOps :: COps
emptyCOps :: COps
emptyCOps =
  let corule :: RuleContent
corule = RuleContent
RK.emptyRuleContent
      coitem :: ContentData ItemKind
coitem = ItemSymbolsUsedInEngine
-> [ItemKind]
-> [GroupName ItemKind]
-> [GroupName ItemKind]
-> ContentData ItemKind
IK.makeData (RuleContent -> ItemSymbolsUsedInEngine
RK.ritemSymbols RuleContent
corule) [ItemKind
emptyMultiGroupItem] [] []
      cotile :: ContentData TileKind
cotile = [TileKind]
-> [GroupName TileKind]
-> [GroupName TileKind]
-> ContentData TileKind
TK.makeData [TileKind
emptyUnknownTile] [] []
      cofact :: ContentData FactionKind
cofact = [FactionKind]
-> [GroupName FactionKind]
-> [GroupName FactionKind]
-> ContentData FactionKind
FK.makeData [FactionKind
emptyUIFaction] [GroupName FactionKind
emptyUIFactionGroupName] []
  in COps :: ContentData CaveKind
-> ContentData FactionKind
-> ContentData ItemKind
-> ContentData ModeKind
-> ContentData PlaceKind
-> RuleContent
-> ContentData TileKind
-> ItemSpeedup
-> TileSpeedup
-> COps
COps
    { cocave :: ContentData CaveKind
cocave = ContentData CaveKind
forall a. ContentData a
emptyContentData  -- not valid! beware when testing!
        -- to make valid cave content, we'd need to define a single cave kind,
        -- which involves creating and validating tile and place kinds, etc.
    , ContentData FactionKind
cofact :: ContentData FactionKind
cofact :: ContentData FactionKind
cofact
    , ContentData ItemKind
coitem :: ContentData ItemKind
coitem :: ContentData ItemKind
coitem
    , comode :: ContentData ModeKind
comode = ContentData FactionKind
-> [ModeKind]
-> [GroupName ModeKind]
-> [GroupName ModeKind]
-> ContentData ModeKind
MK.makeData ContentData FactionKind
cofact [ModeKind
emptyMultiGroupMode] [] []
    , coplace :: ContentData PlaceKind
coplace = ContentData TileKind
-> [PlaceKind]
-> [GroupName PlaceKind]
-> [GroupName PlaceKind]
-> ContentData PlaceKind
PK.makeData ContentData TileKind
cotile [] [] []
    , RuleContent
corule :: RuleContent
corule :: RuleContent
corule
    , ContentData TileKind
cotile :: ContentData TileKind
cotile :: ContentData TileKind
cotile
    , coItemSpeedup :: ItemSpeedup
coItemSpeedup = ContentData ItemKind -> ItemSpeedup
speedupItem ContentData ItemKind
coitem
    , coTileSpeedup :: TileSpeedup
coTileSpeedup = Bool -> ContentData TileKind -> TileSpeedup
Tile.speedupTile Bool
False ContentData TileKind
cotile
    }

-- | Map from an item kind identifier to the mean aspect value for the kind.
newtype ItemSpeedup = ItemSpeedup (V.Vector IA.KindMean)

getKindMean :: ContentId IK.ItemKind -> ItemSpeedup -> IA.KindMean
getKindMean :: ContentId ItemKind -> ItemSpeedup -> KindMean
getKindMean ContentId ItemKind
kindId (ItemSpeedup Vector KindMean
is) = Vector KindMean
is Vector KindMean -> Int -> KindMean
forall a. Vector a -> Int -> a
V.! ContentId ItemKind -> Int
forall c. ContentId c -> Int
contentIdIndex ContentId ItemKind
kindId

speedupItem :: ContentData IK.ItemKind -> ItemSpeedup
speedupItem :: ContentData ItemKind -> ItemSpeedup
speedupItem ContentData ItemKind
coitem =
  let f :: ItemKind -> KindMean
f !ItemKind
kind =
        let kmMean :: AspectRecord
kmMean = ItemKind -> AspectRecord
IA.meanAspect ItemKind
kind
            kmConst :: Bool
kmConst = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Aspect] -> Bool
IA.aspectsRandom (ItemKind -> [Aspect]
IK.iaspects ItemKind
kind)
        in KindMean :: Bool -> AspectRecord -> KindMean
IA.KindMean{Bool
AspectRecord
kmMean :: AspectRecord
kmConst :: Bool
kmConst :: Bool
kmMean :: AspectRecord
..}
  in Vector KindMean -> ItemSpeedup
ItemSpeedup (Vector KindMean -> ItemSpeedup) -> Vector KindMean -> ItemSpeedup
forall a b. (a -> b) -> a -> b
$ ContentData ItemKind -> (ItemKind -> KindMean) -> Vector KindMean
forall a b. ContentData a -> (a -> b) -> Vector b
omapVector ContentData ItemKind
coitem ItemKind -> KindMean
f