-- | The type of definitions of screen layout and features.
module Game.LambdaHack.Client.UI.Content.Screen
  ( ScreenContent(..), makeData
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , 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.Definition.Defs

-- | Screen layout and features definition.
data ScreenContent = ScreenContent
  { ScreenContent -> X
rwidth        :: X         -- ^ screen width
  , ScreenContent -> X
rheight       :: Y         -- ^ screen height
  , ScreenContent -> X
rwrap         :: X         -- ^ wrap messages after this number of columns
  , 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 Char T.Text
                               -- ^ verbs to use for apply actions
  , ScreenContent -> [(String, ByteString)]
rFontFiles    :: [(FilePath, BS.ByteString)]
                               -- ^ embedded game-supplied font files
  }

-- | Catch invalid rule kind definitions.
validateSingle :: ScreenContent -> [Text]
validateSingle :: ScreenContent -> [Text]
validateSingle ScreenContent{String
rwebAddress :: String
rwebAddress :: ScreenContent -> String
rwebAddress, ([String], [[String]])
rintroScreen :: ([String], [[String]])
rintroScreen :: ScreenContent -> ([String], [[String]])
rintroScreen} =
  (let tsGt80 :: [Text]
tsGt80 = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter ((X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 80) (X -> Bool) -> (Text -> X) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> X
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
      [] -> []
      tGt80 :: Text
tGt80 : _ -> ["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 ((X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 41) (X -> Bool) -> (Text -> X) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> X
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
         [] -> []
         tGt41 :: Text
tGt41 : _ -> ["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 ((X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 80) (X -> Bool) -> (Text -> X) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> X
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]
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
         [] -> []
         tGt80 :: Text
tGt80 : _ -> ["manual has a line with length over 80:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tGt80])

makeData :: ScreenContent -> ScreenContent
makeData :: ScreenContent -> ScreenContent
makeData sc :: ScreenContent
sc =
  let singleOffenders :: [Text]
singleOffenders = ScreenContent -> [Text]
validateSingle 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 a. Show a => Bool -> a -> Bool
`blame` "Screen Content" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ": some content items not valid"
             String -> [Text] -> (String, [Text])
forall v. String -> v -> (String, v)
`swith` [Text]
singleOffenders)
     ScreenContent
sc