ModeKind.hs

-- | The type of game modes.
module Game.LambdaHack.Content.ModeKind
  ( pattern CAMPAIGN_SCENARIO, pattern INSERT_COIN
  , ModeKind(..), makeData
  , Caves, Roster
  , mandatoryGroups
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , validateSingle, validateAll, validateSingleRoster
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.Text as T

import           Game.LambdaHack.Content.CaveKind (CaveKind)
import           Game.LambdaHack.Content.FactionKind
  (FactionKind (..), Outcome (..))
import           Game.LambdaHack.Content.ItemKind (ItemKind)
import qualified Game.LambdaHack.Core.Dice as Dice
import           Game.LambdaHack.Definition.ContentData
import           Game.LambdaHack.Definition.Defs
import           Game.LambdaHack.Definition.DefsInternal

-- | Game mode specification.
data ModeKind = ModeKind
  { mname     :: Text            -- ^ short description
  , mfreq     :: Freqs ModeKind  -- ^ frequency within groups
  , mtutorial :: Bool            -- ^ whether to show tutorial messages, etc.
  , mattract  :: Bool            -- ^ whether this is an attract mode
  , mroster   :: Roster          -- ^ factions taking part in the game
  , mcaves    :: Caves           -- ^ arena of the game
  , mendMsg   :: [(Outcome, Text)]
      -- ^ messages displayed at each particular game ends; if message empty,
      --   the screen is skipped
  , mrules    :: Text            -- ^ rules note
  , mdesc     :: Text            -- ^ description
  , mreason   :: Text            -- ^ why/when the mode should be played
  , mhint     :: Text            -- ^ hints in case player faces difficulties
  }
  deriving Show

-- | Requested cave groups for particular level intervals.
type Caves = [([Int], [GroupName CaveKind])]

-- | The specification of factions and of levels, numbers and groups
-- of their initial members.
type Roster = [( GroupName FactionKind
               , [(Int, Dice.Dice, GroupName ItemKind)] )]

-- | Catch invalid game mode kind definitions.
validateSingle :: ContentData FactionKind -> ModeKind -> [Text]
validateSingle cofact ModeKind{..} =
  [ "mname longer than 22" | T.length mname > 22 ]
  ++ let f cave@(ns, l) =
           [ "not enough or too many levels for required cave groups:"
             <+> tshow cave
           | length ns /= length l ]
     in concatMap f mcaves
  ++ validateSingleRoster cofact mcaves mroster

-- | Checks, in particular, that there is at least one faction with fneverEmpty
-- or the game would get stuck as soon as the dungeon is devoid of actors.
validateSingleRoster :: ContentData FactionKind -> Caves -> Roster -> [Text]
validateSingleRoster cofact caves roster =
  let emptyGroups = filter (not . oexistsGroup cofact) $ map fst roster
  in [ "the following faction kind groups have no representative with non-zero frequency:"
       <+> T.intercalate ", " (map displayGroupName emptyGroups)
     | not $ null emptyGroups ]
  ++ let fkKeepsAlive acc _ _ fk = acc && fneverEmpty fk
           -- all of group elements have to keep level alive, hence conjunction
         fkGroupKeepsAlive (fkGroup, _) =
           ofoldlGroup' cofact fkGroup fkKeepsAlive True
     in [ "potentially no faction keeps the dungeon alive"
        | not $ any fkGroupKeepsAlive roster ]
  ++ let fkHasUIor acc _ _ fk = acc || fhasUI fk
           -- single group element having UI already incurs the risk
           -- of duplication, hence disjunction
         fkGroupHasUIor (fkGroup, _) =
           ofoldlGroup' cofact fkGroup fkHasUIor False
     in [ "potentially more than one UI client"
        | length (filter fkGroupHasUIor roster) > 1 ]
  ++ let fkHasUIand acc _ _ fk = acc && fhasUI fk
           -- single group element missing UI already incurs the risk
           -- of no UI in the whole game, hence disjunction
         fkGroupHasUIand (fkGroup, _) =
           ofoldlGroup' cofact fkGroup fkHasUIand True
     in [ "potentially less than one UI client"
        | not (any fkGroupHasUIand roster) ]
  ++ let fkTokens acc _ _ fk = fteam fk : acc
         fkGroupTokens (fkGroup, _) = ofoldlGroup' cofact fkGroup fkTokens []
         tokens = concatMap (nub . sort . fkGroupTokens) roster
         nubTokens = nub . sort $ tokens
     in [ "potentially duplicate team continuity token"
        | length tokens /= length nubTokens ]
  ++ let keys = concatMap fst caves  -- permitted to be empty, for tests
         minD = minimum keys
         maxD = maximum keys
         f (_, l) = concatMap g l
         g i3@(ln, _, _) =
           [ "initial actor levels not among caves:" <+> tshow i3
           | ln `notElem` keys ]
     in concatMap f roster
        ++ [ "player is confused by both positive and negative level numbers"
           | not (null keys) && signum minD /= signum maxD ]
        ++ [ "player is confused by level numer zero"
           | 0 `elem` keys ]

-- | Validate game mode kinds together.
validateAll :: [ModeKind] -> ContentData ModeKind -> [Text]
validateAll _ _ = []  -- so far, always valid

-- * Mandatory item groups

mandatoryGroups :: [GroupName ModeKind]
mandatoryGroups =
       [CAMPAIGN_SCENARIO, INSERT_COIN]

pattern CAMPAIGN_SCENARIO, INSERT_COIN :: GroupName ModeKind

pattern CAMPAIGN_SCENARIO = GroupName "campaign scenario"
pattern INSERT_COIN = GroupName "insert coin"

makeData :: ContentData FactionKind
         -> [ModeKind] -> [GroupName ModeKind] -> [GroupName ModeKind]
         -> ContentData ModeKind
makeData cofact content groupNamesSingleton groupNames =
  makeContentData "ModeKind" mname mfreq (validateSingle cofact) validateAll
                  content
                  groupNamesSingleton
                  (mandatoryGroups ++ groupNames)