{-# LANGUAGE DeriveGeneric #-}
-- | The type of kinds of terrain tiles.
module Game.LambdaHack.Content.TileKind
  ( TileKind(..), Feature(..)
  , validateSingleTileKind, validateAllTileKind, actionFeatures
  , TileSpeedup(..), Tab(..), isUknownSpace, unknownId
  , isSuspectKind, isOpenableKind, isClosableKind, talterForStairs, floorSymbol
  ) 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

  -- The following three are only used in dungeon generation.
  | 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@

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

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

-- | 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]

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

-- | 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 [] =  assert `failure` 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

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