{-# LANGUAGE TemplateHaskell #-}
-- | Game rules and assorted game setup data.
module Content.RuleKind
  ( standardRules
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.Ini.Reader as Ini
import           Instances.TH.Lift ()
import           Language.Haskell.TH.Syntax
import           System.FilePath
import           System.IO
  (IOMode (ReadMode), hGetContents, hSetEncoding, openFile, utf8)

-- Cabal
import qualified Paths_LambdaHack as Self (version)

import Game.LambdaHack.Content.ItemKind (ItemSymbolsUsedInEngine (..))
import Game.LambdaHack.Content.RuleKind
import Game.LambdaHack.Definition.DefsInternal

standardRules :: RuleContent
standardRules :: RuleContent
standardRules = RuleContent :: String
-> X
-> X
-> Version
-> String
-> (Text, Config)
-> X
-> X
-> String
-> X
-> [Text]
-> ItemSymbolsUsedInEngine
-> RuleContent
RuleContent
  { rtitle :: String
rtitle = String
"LambdaHack"
  , rWidthMax :: X
rWidthMax = X
80
  , rHeightMax :: X
rHeightMax = X
21
  , rexeVersion :: Version
rexeVersion = Version
Self.version
  -- The strings containing the default configuration file
  -- included from config.ui.default.
  , rcfgUIName :: String
rcfgUIName = String
"config.ui" String -> String -> String
<.> String
"ini"
  , rcfgUIDefault :: (Text, Config)
rcfgUIDefault = $(do
      let path = "GameDefinition" </> "config.ui" <.> "default"
      qAddDependentFile path
      !s <- qRunIO $ do
        inputHandle <- openFile path ReadMode
        hSetEncoding inputHandle utf8
        hGetContents inputHandle
      let !cfgUIDefault =
            either (error . ("Ini.parse of default config" `showFailure`)) id
            $ Ini.parse s
      lift (s, cfgUIDefault))
  , rwriteSaveClips :: X
rwriteSaveClips = X
1000
  , rleadLevelClips :: X
rleadLevelClips = X
50
  , rscoresFileName :: String
rscoresFileName = String
"LambdaHack.scores"
  , rnearby :: X
rnearby = X
20
  , rstairWordCarried :: [Text]
rstairWordCarried = [Text
"staircase"]  -- only one, so inert
  , ritemSymbols :: ItemSymbolsUsedInEngine
ritemSymbols = ItemSymbolsUsedInEngine :: ContentSymbol ItemKind
-> ContentSymbol ItemKind
-> ContentSymbol ItemKind
-> ContentSymbol ItemKind
-> ContentSymbol ItemKind
-> ContentSymbol ItemKind
-> ContentSymbol ItemKind
-> ContentSymbol ItemKind
-> ContentSymbol ItemKind
-> ContentSymbol ItemKind
-> ContentSymbol ItemKind
-> ContentSymbol ItemKind
-> ContentSymbol ItemKind
-> ContentSymbol ItemKind
-> ContentSymbol ItemKind
-> ContentSymbol ItemKind
-> ContentSymbol ItemKind
-> ContentSymbol ItemKind
-> ContentSymbol ItemKind
-> ItemSymbolsUsedInEngine
ItemSymbolsUsedInEngine
      { rsymbolProjectile :: ContentSymbol ItemKind
rsymbolProjectile = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'|'
      , rsymbolLight :: ContentSymbol ItemKind
rsymbolLight      = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'('
      , rsymbolTool :: ContentSymbol ItemKind
rsymbolTool       = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'('
      , rsymbolSpecial :: ContentSymbol ItemKind
rsymbolSpecial    = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'*'
                              -- don't overuse; it clashes with projectiles
      , rsymbolGold :: ContentSymbol ItemKind
rsymbolGold       = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'$'
                              -- also gems
      , rsymbolNecklace :: ContentSymbol ItemKind
rsymbolNecklace   = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'"'
      , rsymbolRing :: ContentSymbol ItemKind
rsymbolRing       = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'='
      , rsymbolPotion :: ContentSymbol ItemKind
rsymbolPotion     = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'!'
                              -- also concoction, bottle, jar, vial
      , rsymbolFlask :: ContentSymbol ItemKind
rsymbolFlask      = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'!'
      , rsymbolScroll :: ContentSymbol ItemKind
rsymbolScroll     = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'?'
                              -- also book, note, tablet, card
      , rsymbolTorsoArmor :: ContentSymbol ItemKind
rsymbolTorsoArmor = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'['
      , rsymbolMiscArmor :: ContentSymbol ItemKind
rsymbolMiscArmor  = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'['
      , rsymbolClothes :: ContentSymbol ItemKind
rsymbolClothes    = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'['
      , rsymbolShield :: ContentSymbol ItemKind
rsymbolShield     = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
']'
      , rsymbolPolearm :: ContentSymbol ItemKind
rsymbolPolearm    = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
')'
      , rsymbolEdged :: ContentSymbol ItemKind
rsymbolEdged      = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
')'
      , rsymbolHafted :: ContentSymbol ItemKind
rsymbolHafted     = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
')'
      , rsymbolWand :: ContentSymbol ItemKind
rsymbolWand       = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
'/'
                              -- also magical rod, pistol, instrument
      , rsymbolFood :: ContentSymbol ItemKind
rsymbolFood       = ContentSymbol ItemKind -> ContentSymbol ItemKind
forall c. ContentSymbol ItemKind -> ContentSymbol ItemKind
toContentSymbol ContentSymbol ItemKind
','
          -- also body part; distinct enough from floor, which is middle dot
      }
  }