{-# LANGUAGE DeriveGeneric #-}
-- | The type of kinds of terrain tiles.
module Game.LambdaHack.Content.TileKind
  ( TileKind(..), makeData
  , Feature(..), TileSpeedup(..), Tab(..)
  , emptyTileSpeedup, emptyTab
  , actionFeatures, isUknownSpace, unknownId
  , isSuspectKind, isOpenableKind, isClosableKind
  , talterForStairs, floorSymbol
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , validateSingle, validateAll
  , 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.Text as T
import qualified Data.Vector.Unboxed as U
import           GHC.Generics (Generic)

import Game.LambdaHack.Common.Color
import Game.LambdaHack.Common.ContentData
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 @ContentId@ 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, Generic)  -- No Eq and Ord to make extending logically sound

instance NFData TileKind

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

-- | A lot of tabulated maps from tile kind identifier to a property
-- of the tile kind.
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
  }
  deriving Generic

instance NFData TileSpeedup

-- 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.
-- | A map morally indexed by @ContentId TileKind@.
newtype Tab a = Tab (U.Vector a)
  deriving Generic

instance NFData (Tab a)

emptyTileSpeedup :: TileSpeedup
emptyTileSpeedup = TileSpeedup emptyTab emptyTab emptyTab emptyTab emptyTab
                               emptyTab emptyTab emptyTab emptyTab emptyTab
                               emptyTab emptyTab emptyTab emptyTab emptyTab

emptyTab :: U.Unbox a => Tab a
emptyTab = Tab $! U.empty

-- | Validate a single tile kind.
validateSingle :: TileKind -> [Text]
validateSingle 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
       , 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.
--
-- We don't check it any more, but if tiles look the same on the map
-- (symbol and color), their substantial features should be the same, too,
-- unless there is a good reason they shouldn't. Otherwise the player has
-- to inspect manually all the tiles with this look to see if any is special.
-- This tends to be tedious. Note that tiles may freely differ wrt text blurb,
-- dungeon generation rules, AI preferences, etc., whithout causing the tedium.
validateAll :: ContentData ItemKind -> [TileKind] -> ContentData TileKind
            -> [Text]
validateAll coitem content cotile =
  let g :: Feature -> Maybe (GroupName TileKind)
      g (OpenTo grp) = Just grp
      g (CloseTo grp) = Just grp
      g (ChangeTo grp) = Just grp
      g (HideAs grp) = Just grp
      g (BuildAs grp) = Just grp
      g (RevealAs grp) = Just grp
      g (ObscureAs grp) = Just grp
      g _ = Nothing
      missingTileGroups =
        [ (tname k, absGroups)
        | k <- content
        , let grps = mapMaybe g $ tfeature k
              absGroups = filter (not . omemberGroup cotile) grps
        , not $ null absGroups
        ]
      h :: Feature -> Maybe (GroupName ItemKind)
      h (Embed grp) = Just grp
      h _ = Nothing
      missingItemGroups =
        [ (tname k, absGroups)
        | k <- content
        , let grps = mapMaybe h $ tfeature k
              absGroups = filter (not . omemberGroup coitem) grps
        , not $ null absGroups
        ]
      missingHardwiredGroups =
        filter (not . omemberGroup cotile) hardwiredTileGroups
  in [ "first tile should be the unknown one"
     | talter (head content) /= 1 || tname (head content) /= "unknown space" ]
     ++ [ "only unknown tile may have talter 1"
        | any ((== 1) . talter) $ tail content ]
     ++ [ "mentioned tile groups not in content:" <+> tshow missingTileGroups
        | not $ null missingTileGroups ]
     ++ [ "embedded item groups not in content:" <+> tshow missingItemGroups
        | not $ null missingItemGroups ]
     ++ [ "hardwired groups not in content:" <+> tshow missingHardwiredGroups
        | not $ null missingHardwiredGroups ]

hardwiredTileGroups :: [GroupName TileKind]
hardwiredTileGroups =
  [ "unknown space", "legendLit", "legendDark", "unknown outer fence"
  , "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
        ConsideredByAI -> Nothing
        Trail -> Just feat  -- doesn't affect tile behaviour, but important
        Spice -> Nothing
  in IS.fromList $ map hash $ mapMaybe f $ tfeature t

isUknownSpace :: ContentId TileKind -> Bool
{-# INLINE isUknownSpace #-}
isUknownSpace tt = ContentId 0 == tt

unknownId :: ContentId TileKind
{-# INLINE unknownId #-}
unknownId = ContentId 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

makeData :: ContentData ItemKind -> [TileKind] -> ContentData TileKind
makeData coitem =
  makeContentData "TileKind" tname tfreq validateSingle (validateAll coitem)