-- | The type of game rules and assorted game data.
module Game.LambdaHack.Content.RuleKind
  ( RuleContent(..), emptyRuleContent, makeData
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , validateSingle
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.Ini as Ini
import qualified Data.Ini.Types as Ini
import           Data.Version

import Game.LambdaHack.Content.ItemKind
  (ItemSymbolsUsedInEngine, emptyItemSymbolsUsedInEngine)
import Game.LambdaHack.Definition.Defs

-- | The type of game rules and assorted game data.
data RuleContent = RuleContent
  { RuleContent -> String
rtitle            :: String    -- ^ title of the game (not lib)
  , RuleContent -> X
rWidthMax         :: X         -- ^ maximum level width; for now,
                                   --   keep equal to ScreenContent.rwidth
  , RuleContent -> X
rHeightMax        :: Y         -- ^ maximum level height; for now,
                                   --   keep equal to ScreenContent.rheight - 3
  , RuleContent -> Version
rexeVersion       :: Version   -- ^ version of the game
  , RuleContent -> String
rcfgUIName        :: FilePath  -- ^ name of the UI config file
  , RuleContent -> (String, Config)
rcfgUIDefault     :: (String, Ini.Config)
                                   -- ^ the default UI settings config file
  , RuleContent -> X
rwriteSaveClips   :: Int       -- ^ game saved that often (not on browser)
  , RuleContent -> X
rleadLevelClips   :: Int       -- ^ server switches leader level that often
  , RuleContent -> String
rscoresFile       :: FilePath  -- ^ name of the scores file
  , RuleContent -> X
rnearby           :: Int       -- ^ what is a close distance between actors
  , RuleContent -> [Text]
rstairWordCarried :: [Text]    -- ^ words that can't be dropped from stair
                                   --   name as it goes through levels
  , RuleContent -> ItemSymbolsUsedInEngine
ritemSymbols      :: ItemSymbolsUsedInEngine
                                   -- ^ item symbols treated specially in engine
  }

emptyRuleContent :: RuleContent
emptyRuleContent :: RuleContent
emptyRuleContent = RuleContent :: String
-> X
-> X
-> Version
-> String
-> (String, Config)
-> X
-> X
-> String
-> X
-> [Text]
-> ItemSymbolsUsedInEngine
-> RuleContent
RuleContent
  { rtitle :: String
rtitle = String
""
  , rWidthMax :: X
rWidthMax = X
0
  , rHeightMax :: X
rHeightMax = X
0
  , rexeVersion :: Version
rexeVersion = [X] -> Version
makeVersion []
  , rcfgUIName :: String
rcfgUIName = String
""
  , rcfgUIDefault :: (String, Config)
rcfgUIDefault = (String
"", Config
Ini.emptyConfig)
  , rwriteSaveClips :: X
rwriteSaveClips = X
0
  , rleadLevelClips :: X
rleadLevelClips = X
0
  , rscoresFile :: String
rscoresFile = String
""
  , rnearby :: X
rnearby = X
0
  , rstairWordCarried :: [Text]
rstairWordCarried = []
  , ritemSymbols :: ItemSymbolsUsedInEngine
ritemSymbols = ItemSymbolsUsedInEngine
emptyItemSymbolsUsedInEngine
  }

-- | Catch invalid rule kind definitions.
validateSingle :: RuleContent -> [Text]
validateSingle :: RuleContent -> [Text]
validateSingle RuleContent
_ = []

makeData :: RuleContent -> RuleContent
makeData :: RuleContent -> RuleContent
makeData RuleContent
rc =
  let singleOffenders :: [Text]
singleOffenders = RuleContent -> [Text]
validateSingle RuleContent
rc
  in Bool -> RuleContent -> RuleContent
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ([Text] -> Bool
forall a. [a] -> Bool
null [Text]
singleOffenders
             Bool -> (String, [Text]) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` String
"Rule Content not valid"
             String -> [Text] -> (String, [Text])
forall v. String -> v -> (String, v)
`swith` [Text]
singleOffenders)
     RuleContent
rc