{-# LANGUAGE DeriveGeneric #-}
-- | The type of kinds of terrain tiles.
module Game.LambdaHack.Content.TileKind
  ( TileKind(..), Feature(..), TileSpeedup(..), Tab(..)
  , validateSingleTileKind, validateAllTileKind, actionFeatures
  , isUknownSpace, unknownId, isSuspectKind, isOpenableKind, isClosableKind
  , talterForStairs, floorSymbol
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , validateDups, hardwiredTileGroups
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Common.Prelude

import           Control.DeepSeq
import           Data.Binary
import qualified Data.Char as Char
import           Data.Hashable
import qualified Data.IntSet as IS
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Vector.Unboxed as U
import           GHC.Generics (Generic)

import           Game.LambdaHack.Common.Color
import qualified Game.LambdaHack.Common.KindOps as KindOps
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Content.ItemKind (ItemKind)

-- | The type of kinds of terrain tiles. See @Tile.hs@ for explanation
-- of the absence of a corresponding type @Tile@ that would hold
-- particular concrete tiles in the dungeon.
-- Note that tile names (and any other content names) should not be plural
-- (that would lead to "a stairs"), so "road with cobblestones" is fine,
-- but "granite cobblestones" is wrong.
--
-- Tile kind for unknown space has the minimal @KindOps.Id@ index.
-- The @talter@ for unknown space is @1@ and no other tile kind has that value.
data TileKind = TileKind
  { tsymbol  :: Char         -- ^ map symbol
  , tname    :: Text         -- ^ short description
  , tfreq    :: Freqs TileKind  -- ^ frequency within groups
  , tcolor   :: Color        -- ^ map color
  , tcolor2  :: Color        -- ^ map color when not in FOV
  , talter   :: Word8        -- ^ minimal skill needed to alter the tile
  , tfeature :: [Feature]    -- ^ properties
  }
  deriving Show  -- No Eq and Ord to make extending it logically sound

-- | All possible terrain tile features.
data Feature =
    Embed (GroupName ItemKind)
      -- ^ initially an item of this group is embedded;
      --   we assume the item has effects and is supposed to be triggered
  | OpenTo (GroupName TileKind)
      -- ^ goes from a closed to (randomly closed or) open tile when altered
  | CloseTo (GroupName TileKind)
      -- ^ goes from an open to (randomly opened or) closed tile when altered
  | ChangeTo (GroupName TileKind)
      -- ^ alters tile, but does not change walkability
  | HideAs (GroupName TileKind)
      -- ^ when hidden, looks as the unique tile of the group
  | BuildAs (GroupName TileKind)
      -- ^ when generating, may be transformed to the unique tile of the group
  | RevealAs (GroupName TileKind)
      -- ^ when generating in opening, can be revealed to belong to the group
  | ObscureAs (GroupName TileKind)
      -- ^ when generating in solid wall, can be revealed to belong to the group
  | Walkable             -- ^ actors can walk through
  | Clear                -- ^ actors can see through
  | Dark                 -- ^ is not lit with an ambient light
  | OftenItem            -- ^ initial items often generated there
  | OftenActor           -- ^ initial actors often generated there
  | NoItem               -- ^ no items ever generated there
  | NoActor              -- ^ no actors ever generated there
  | Indistinct           -- ^ is allowed to have the same look as another tile
  | ConsideredByAI       -- ^ even if otherwise uninteresting, taken into
                         --   account for triggering by AI
  | Trail                -- ^ used for visible trails throughout the level
  | Spice                -- ^ in place normal legend and in override,
                         --   don't roll a tile kind only once per place,
                         --   but roll for each position; one non-spicy and
                         --   at most one spicy is rolled per place and then
                         --   one of the two is rolled for each position
  deriving (Show, Eq, Ord, Generic)

instance Binary Feature

instance Hashable Feature

instance NFData Feature

data TileSpeedup = TileSpeedup
  { isClearTab        :: Tab Bool
  , isLitTab          :: Tab Bool
  , isWalkableTab     :: Tab Bool
  , isDoorTab         :: Tab Bool
  , isChangableTab    :: Tab Bool
  , isSuspectTab      :: Tab Bool
  , isHideAsTab       :: Tab Bool
  , consideredByAITab :: Tab Bool
  , isOftenItemTab    :: Tab Bool
  , isOftenActorTab   :: Tab Bool
  , isNoItemTab       :: Tab Bool
  , isNoActorTab      :: Tab Bool
  , isEasyOpenTab     :: Tab Bool
  , alterMinSkillTab  :: Tab Word8
  , alterMinWalkTab   :: Tab Word8
  }

-- Vectors of booleans can be slower than arrays, because they are not packed,
-- but with growing cache sizes they may as well turn out faster at some point.
-- The advantage of vectors are exposed internals, in particular unsafe
-- indexing. Also, in JS bool arrays are obviously not packed.
newtype Tab a = Tab (U.Vector a)  -- morally indexed by @Id a@

-- | Validate a single tile kind.
validateSingleTileKind :: TileKind -> [Text]
validateSingleTileKind t@TileKind{..} =
  [ "suspect tile is walkable" | Walkable `elem` tfeature
                                 && isSuspectKind t ]
  ++ [ "openable tile is open" | Walkable `elem` tfeature
                                 && isOpenableKind t ]
  ++ [ "closable tile is closed" | Walkable `notElem` tfeature
                                   && isClosableKind t ]
  ++ [ "walkable tile is considered for triggering by AI"
     | Walkable `elem` tfeature
       && ConsideredByAI `elem` tfeature ]
  ++ [ "trail tile not walkable" | Walkable `notElem` tfeature
                                   && Trail `elem` tfeature ]
  ++ [ "OftenItem and NoItem on a tile" | OftenItem `elem` tfeature
                                          && NoItem `elem` tfeature ]
  ++ [ "OftenActor and NoActor on a tile" | OftenItem `elem` tfeature
                                            && NoItem `elem` tfeature ]
  ++ (let f :: Feature -> Bool
          f OpenTo{} = True
          f CloseTo{} = True
          f ChangeTo{} = True
          f _ = False
          ts = filter f tfeature
      in [ "more than one OpenTo, CloseTo and ChangeTo specification"
         | length ts > 1 ])
  ++ (let f :: Feature -> Bool
          f HideAs{} = True
          f _ = False
          ts = filter f tfeature
      in ["more than one HideAs specification" | length ts > 1])
  ++ (let f :: Feature -> Bool
          f BuildAs{} = True
          f _ = False
          ts = filter f tfeature
      in ["more than one BuildAs specification" | length ts > 1])
  ++ concatMap (validateDups t)
       [ Walkable, Clear, Dark, OftenItem, OftenActor, NoItem, NoActor
       , Indistinct, ConsideredByAI, Trail, Spice ]

validateDups :: TileKind -> Feature -> [Text]
validateDups TileKind{..} feat =
  let ts = filter (== feat) tfeature
  in ["more than one" <+> tshow feat <+> "specification" | length ts > 1]

-- | Validate all tile kinds.
--
-- If tiles look the same on the map (symbol and color), their substantial
-- features should be the same, too. Otherwise, the player has to inspect
-- manually all the tiles of that kind, or even experiment with them,
-- to see if any is special. This would be tedious. Note that tiles may freely
-- differ wrt text blurb, dungeon generation, AI preferences, etc.
validateAllTileKind :: [TileKind] -> [Text]
validateAllTileKind lt =
  let kindFreq :: S.Set (GroupName TileKind)  -- cf. Kind.kindFreq
      kindFreq = let tuples = [ cgroup
                              | k <- lt
                              , (cgroup, n) <- tfreq k
                              , n > 0 ]
                 in S.fromList tuples
      listVis f = map (\kt -> ( (tsymbol kt, f kt)
                              , [(kt, actionFeatures True kt)] )) lt
      mapVis :: (TileKind -> Color)
             -> M.Map (Char, Color) [(TileKind, IS.IntSet)]
      mapVis f = M.fromListWith (++) $ listVis f
      isConfused [] = error $ "isConfused" `showFailure` lt
      isConfused [_] = False
      isConfused (hd : tl) =
        any ((Indistinct `notElem`) . tfeature . fst) (hd : tl)
        && any ((/= snd hd) . snd) tl
      confusions f = filter isConfused $ M.elems $ mapVis f
      hardwiredAbsent = filter (`S.notMember` kindFreq) hardwiredTileGroups
  in [ "first tile should be the unknown one"
     | talter (head lt) /= 1 || tname (head lt) /= "unknown space" ]
     ++ [ "only unknown tile may have talter 1"
        | any ((== 1) . talter) $ tail lt ]
     ++ case confusions tcolor ++ confusions tcolor2 of
       [] -> []
       cfs -> ["tile confusions detected:" <+> tshow cfs]
     ++ [ "Hardwired groups not in content:" <+> tshow hardwiredAbsent
        | not $ null hardwiredAbsent ]

hardwiredTileGroups :: [GroupName TileKind]
hardwiredTileGroups =
  [ "unknown space", "legendLit", "legendDark", "basic outer fence"
  , "stair terminal" ]

-- | Features of tiles that differentiate them substantially from one another.
-- The intention is the player can easily tell such tiles apart by their
-- behaviour and only looking at the map, not tile name nor description.
-- So if running uses this function, it won't stop at places that the player
-- can't himself tell from other places, and so running does not confer
-- any advantages, except UI convenience. Hashes are accurate enough
-- for our purpose, given that we use arbitrary heuristics anyway.
actionFeatures :: Bool -> TileKind -> IS.IntSet
actionFeatures markSuspect t =
  let stripLight grp = maybe grp toGroupName
                       $ maybe (T.stripSuffix "Dark" $ tshow grp) Just
                       $ T.stripSuffix "Lit" $ tshow grp
      f feat = case feat of
        Embed{} -> Just feat
        OpenTo grp -> Just $ OpenTo $ stripLight grp
        CloseTo grp -> Just $ CloseTo $ stripLight grp
        ChangeTo grp -> Just $ ChangeTo $ stripLight grp
        Walkable -> Just feat
        Clear -> Just feat
        HideAs{} -> Nothing
        BuildAs{} -> Nothing
        RevealAs{} -> if markSuspect then Just feat else Nothing
        ObscureAs{} -> if markSuspect then Just feat else Nothing
        Dark -> Nothing  -- not important any longer, after FOV computed
        OftenItem -> Nothing
        OftenActor -> Nothing
        NoItem -> Nothing
        NoActor -> Nothing
        Indistinct -> Nothing
        ConsideredByAI -> Nothing
        Trail -> Just feat  -- doesn't affect tile behaviour, but important
        Spice -> Nothing
  in IS.fromList $ map hash $ mapMaybe f $ tfeature t

isUknownSpace :: KindOps.Id TileKind -> Bool
{-# INLINE isUknownSpace #-}
isUknownSpace tt = KindOps.Id 0 == tt

unknownId :: KindOps.Id TileKind
{-# INLINE unknownId #-}
unknownId = KindOps.Id 0

isSuspectKind :: TileKind -> Bool
isSuspectKind t =
  let getTo RevealAs{} = True
      getTo ObscureAs{} = True
      getTo _ = False
  in any getTo $ tfeature t

isOpenableKind ::TileKind -> Bool
isOpenableKind t =
  let getTo OpenTo{} = True
      getTo _ = False
  in any getTo $ tfeature t

isClosableKind :: TileKind -> Bool
isClosableKind t =
  let getTo CloseTo{} = True
      getTo _ = False
  in any getTo $ tfeature t

talterForStairs :: Word8
talterForStairs = 3

floorSymbol :: Char.Char
floorSymbol = Char.chr 183

-- Alter skill schema:
-- 0  can be altered by everybody (escape)
-- 1  unknown only
-- 2  openable and suspect
-- 3  stairs
-- 4  closable
-- 5  changeable (e.g., caches)
-- 10  weak obstructions
-- 50  considerable obstructions
-- 100  walls
-- maxBound  impenetrable walls, etc., can never be altered