-- | The type of definitions of screen layout and features.
module Game.LambdaHack.Client.UI.Content.Screen
  ( ScreenContent(..), emptyScreenContent, makeData
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , emptyScreenContentRaw, validateSingle
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.ByteString as BS
import qualified Data.EnumMap.Strict as EM
import qualified Data.Text as T

import           Game.LambdaHack.Content.ItemKind (ItemKind)
import qualified Game.LambdaHack.Content.RuleKind as RK
import           Game.LambdaHack.Definition.Defs

-- | Screen layout and features definition.
--
-- 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@, which includes validation,
--
-- The @emptyScreenContent@ is one such valid by construction value
-- of this type. It's suitable for bootstrapping and for testing.
data ScreenContent = ScreenContent
  { ScreenContent -> Int
rwidth        :: X         -- ^ screen width
  , ScreenContent -> Int
rheight       :: Y         -- ^ screen height
  , ScreenContent -> String
rwebAddress   :: String    -- ^ an extra blurb line for the main menu
  , ScreenContent -> ([String], [[String]])
rintroScreen  :: ([String], [[String]])
                               -- ^ the intro screen (first help screen) text
                               --   and the rest of the manual
  , ScreenContent -> EnumMap Char Text
rapplyVerbMap :: EM.EnumMap (ContentSymbol ItemKind) T.Text
                               -- ^ verbs to use for apply actions
  , ScreenContent -> [(String, ByteString)]
rFontFiles    :: [(FilePath, BS.ByteString)]
                               -- ^ embedded game-supplied font files
  }

emptyScreenContentRaw :: ScreenContent
emptyScreenContentRaw :: ScreenContent
emptyScreenContentRaw = ScreenContent { rwidth :: Int
rwidth = Int
5
                                      , rheight :: Int
rheight = Int
5
                                      , rwebAddress :: String
rwebAddress = String
""
                                      , rintroScreen :: ([String], [[String]])
rintroScreen = ([], [])
                                      , rapplyVerbMap :: EnumMap Char Text
rapplyVerbMap = EnumMap Char Text
forall k a. EnumMap k a
EM.empty
                                      , rFontFiles :: [(String, ByteString)]
rFontFiles = []
                                      }

emptyScreenContent :: ScreenContent
emptyScreenContent :: ScreenContent
emptyScreenContent =
  Bool -> ScreenContent -> ScreenContent
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ([Text] -> Bool
forall a. [a] -> Bool
null ([Text] -> Bool) -> [Text] -> Bool
forall a b. (a -> b) -> a -> b
$ RuleContent -> ScreenContent -> [Text]
validateSingle RuleContent
RK.emptyRuleContent ScreenContent
emptyScreenContentRaw)
         ScreenContent
emptyScreenContentRaw

-- | Catch invalid rule kind definitions.
validateSingle :: RK.RuleContent -> ScreenContent -> [Text]
validateSingle :: RuleContent -> ScreenContent -> [Text]
validateSingle RuleContent
corule ScreenContent{Int
String
[(String, ByteString)]
([String], [[String]])
EnumMap Char Text
rwidth :: ScreenContent -> Int
rheight :: ScreenContent -> Int
rwebAddress :: ScreenContent -> String
rintroScreen :: ScreenContent -> ([String], [[String]])
rapplyVerbMap :: ScreenContent -> EnumMap Char Text
rFontFiles :: ScreenContent -> [(String, ByteString)]
rwidth :: Int
rheight :: Int
rwebAddress :: String
rintroScreen :: ([String], [[String]])
rapplyVerbMap :: EnumMap Char Text
rFontFiles :: [(String, ByteString)]
..} =
  (let tsGt80 :: [Text]
tsGt80 = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
80) (Int -> Bool) -> (Text -> Int) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String
rwebAddress]
   in case [Text]
tsGt80 of
      [] -> []
      Text
tGt80 : [Text]
_ -> [Text
"rwebAddress's length is over 80:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tGt80])
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (let tsGt41 :: [Text]
tsGt41 = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
41) (Int -> Bool) -> (Text -> Int) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ ([String], [[String]]) -> [String]
forall a b. (a, b) -> a
fst ([String], [[String]])
rintroScreen
      in case [Text]
tsGt41 of
         [] -> []
         Text
tGt41 : [Text]
_ -> [Text
"intro screen has a line with length over 41:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tGt41])
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (let tsGt80 :: [Text]
tsGt80 = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
80) (Int -> Bool) -> (Text -> Int) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ [String] -> [[String]] -> [String]
forall a. [a] -> [[a]] -> [a]
intercalate [String
""]
                   ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ ([String], [[String]]) -> [[String]]
forall a b. (a, b) -> b
snd ([String], [[String]])
rintroScreen
      in case [Text]
tsGt80 of
         [] -> []
         Text
tGt80 : [Text]
_ -> [Text
"manual has a line with length over 80:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tGt80])
  -- The following reflect the only current UI implementation.
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"rwidth /= RK.rWidthMax" | Int
rwidth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= RuleContent -> Int
RK.rWidthMax RuleContent
corule ]
  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"rheight /= RK.rHeightMax + 3" | Int
rheight Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= RuleContent -> Int
RK.rHeightMax RuleContent
corule Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3]

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