Item.hs

-- | Weapons, treasure and all the other items in the game.
-- No operation in this module
-- involves the 'State' or 'Action' type.
-- TODO: Document after it's rethought and rewritten wrt separating
-- inventory manangement and items proper.
module Game.LambdaHack.Item
  ( -- * Teh @Item@ type
    Item(..), newItem, viewItem, itemPrice
    -- * Inventory search
  , strongestSearch, strongestSword, strongestRegen
    -- * Inventory management
  , joinItem, removeItemByLetter, equalItemIdentity, removeItemByIdentity
  , assignLetter
    -- * Inventory symbol operations
  , letterLabel, cmpLetterMaybe, maxLetter, letterRange
    -- * The @FlavourMap@ type
  , FlavourMap, getFlavour, dungeonFlavourMap
    -- * The @Discoveries@ type
  , Discoveries
  ) where

import Data.Binary
import qualified Data.Set as S
import qualified Data.List as L
import qualified Data.Map as M
import Data.Maybe
import Data.Char
import Data.Function
import Data.Ord
import Control.Monad
import Data.Text (Text)
import qualified Data.Text as T
import qualified NLP.Miniutter.English as MU

import Game.LambdaHack.Utils.Assert
import Game.LambdaHack.Random
import Game.LambdaHack.Content.ItemKind
import Game.LambdaHack.Content.RuleKind
import qualified Game.LambdaHack.Color as Color
import Game.LambdaHack.Flavour
import qualified Game.LambdaHack.Kind as Kind
import Game.LambdaHack.Effect
import Game.LambdaHack.Msg

-- TODO: see the TODO about ipower in ItemKind.
-- TODO: define type InvSymbol = Char and move all ops to another file.
-- TODO: perhaps remove jletter and jcount? Should inventory semantics
-- be separate from item semantics?
-- TODO: the list resulting from joinItem can contain items
-- with the same letter.
-- TODO: name [Item] Inventory and have some invariants, e.g. no equal letters.
-- | Game items in inventories or strewn around the dungeon.
data Item = Item
  { jkind   :: !(Kind.Id ItemKind)  -- ^ kind of the item
  , jpower  :: !Int                 -- ^ power of the item
  , jletter :: Maybe Char           -- ^ inventory symbol
  , jcount  :: !Int                 -- ^ inventory count
  }
  deriving Show

instance Binary Item where
  put (Item ik ip il ic ) =
    put ik >> put ip >> put il >> put ic
  get = liftM4 Item get get get get

-- | Generate an item.
newItem :: Kind.Ops ItemKind -> Int -> Int -> Rnd Item
newItem cops@Kind.Ops{opick, okind} lvl depth = do
  ikChosen <- opick (T.pack "dng") (const True)
  let kind = okind ikChosen
  count <- rollDeep lvl depth (icount kind)
  if count == 0
    then newItem cops lvl depth  -- Rare item; beware of inifite loops.
    else do
      power <- rollDeep lvl depth (ipower kind)
      return $ Item ikChosen power (itemLetter kind) count

-- | Represent an item on the map.
viewItem :: Kind.Ops ItemKind -> Kind.Id ItemKind -> FlavourMap
         -> (Char, Color.Color)
viewItem cops@Kind.Ops{osymbol} ik assocs =
  (osymbol ik, flavourToColor $ getFlavour cops assocs ik)

-- | Price an item, taking count into consideration.
itemPrice :: Kind.Ops ItemKind -> Item -> Int
itemPrice Kind.Ops{osymbol} i =
  case osymbol (jkind i) of
    '$' -> jcount i
    '*' -> jcount i * 100
    _   -> 0

-- | The type of already discovered items.
type Discoveries = S.Set (Kind.Id ItemKind)

-- TODO: rewrite and move elsewhere
-- Could be optimized to IntMap and IntSet, but won't ever be a bottleneck,
-- unless we have thousands of item kinds.
-- | Flavours assigned to items in this game.
type FlavourMap = M.Map (Kind.Id ItemKind) Flavour

-- | Assigns flavours to item kinds. Assures no flavor is repeated,
-- except for items with only one permitted flavour.
rollFlavourMap :: Kind.Id ItemKind -> ItemKind
               -> Rnd (FlavourMap, S.Set Flavour)
               -> Rnd (FlavourMap, S.Set Flavour)
rollFlavourMap key ik rnd =
  let flavours = iflavour ik
  in if L.length flavours == 1
     then rnd
     else do
       (assocs, available) <- rnd
       let proper = S.fromList flavours `S.intersection` available
       flavour <- oneOf (S.toList proper)
       return (M.insert key flavour assocs, S.delete flavour available)

-- | Randomly chooses flavour for all item kinds for this game.
dungeonFlavourMap :: Kind.Ops ItemKind -> Rnd FlavourMap
dungeonFlavourMap Kind.Ops{ofoldrWithKey} =
  liftM fst $
    ofoldrWithKey rollFlavourMap (return (M.empty, S.fromList stdFlav))

getFlavour :: Kind.Ops ItemKind -> FlavourMap -> Kind.Id ItemKind -> Flavour
getFlavour Kind.Ops{okind} assocs ik =
  let kind = okind ik
  in case iflavour kind of
    []  -> assert `failure` (assocs, ik, kind)
    [f] -> f
    _:_ -> assocs M.! ik

itemLetter :: ItemKind -> Maybe Char
itemLetter ik = if isymbol ik == '$' then Just '$' else Nothing

-- | Assigns a letter to an item, for inclusion
-- in the inventory of a hero. Takes a remembered
-- letter and a starting letter.
assignLetter :: Maybe Char -> Char -> [Item] -> Maybe Char
assignLetter r c is =
  case r of
    Just l | l `elem` allowed -> Just l
    _ -> listToMaybe free
 where
  current    = S.fromList (mapMaybe jletter is)
  allLetters = ['a'..'z'] ++ ['A'..'Z']
  candidates = take (length allLetters) $
                 drop (fromJust (L.findIndex (== c) allLetters)) $
                   cycle allLetters
  free       = L.filter (\x -> not (x `S.member` current)) candidates
  allowed    = '$' : free

cmpLetter :: Char -> Char -> Ordering
cmpLetter x y = compare (isUpper x, toLower x) (isUpper y, toLower y)

cmpLetterMaybe :: Maybe Char -> Maybe Char -> Ordering
cmpLetterMaybe Nothing  Nothing   = EQ
cmpLetterMaybe Nothing  (Just _)  = GT
cmpLetterMaybe (Just _) Nothing   = LT
cmpLetterMaybe (Just l) (Just l') = cmpLetter l l'

maxBy :: (a -> a -> Ordering) -> a -> a -> a
maxBy cmp x y = case cmp x y of
                  LT  ->  y
                  _   ->  x

maxLetter :: Char -> Char -> Char
maxLetter = maxBy cmpLetter

mergeLetter :: Maybe Char -> Maybe Char -> Maybe Char
mergeLetter = mplus

letterRange :: [Char] -> Text
letterRange ls =
  sectionBy (L.sortBy cmpLetter ls) Nothing
 where
  succLetter c d = ord d - ord c == 1

  sectionBy []     Nothing      = T.empty
  sectionBy []     (Just (c,d)) = finish (c,d)
  sectionBy (x:xs) Nothing      = sectionBy xs (Just (x,x))
  sectionBy (x:xs) (Just (c,d))
    | succLetter d x            = sectionBy xs (Just (c,x))
    | otherwise                 = finish (c,d) <> sectionBy xs (Just (x,x))

  finish (c,d) | c == d         = T.pack [c]
               | succLetter c d = T.pack $ [c, d]
               | otherwise      = T.pack $ [c, '-', d]

letterLabel :: Maybe Char -> MU.Part
letterLabel Nothing  = MU.Text $ T.pack "   "
letterLabel (Just c) = MU.Text $ T.pack $ c : " -"

-- | Adds an item to a list of items, joining equal items.
-- Also returns the joined item.
joinItem :: Item -> [Item] -> (Item, [Item])
joinItem i is =
  case findItem (equalItemIdentity i) is of
    Nothing     -> (i, i : is)
    Just (j,js) -> let n = i { jcount = jcount i + jcount j,
                               jletter = mergeLetter (jletter j) (jletter i) }
                   in (n, n : js)

-- | Removes an item from a list of items.
-- Takes an equality function (i.e., by letter or ny kind) as an argument.
removeItemBy :: (Item -> Item -> Bool) -> Item -> [Item] -> [Item]
removeItemBy eq i = concatMap $ \ x ->
  if eq i x
  then let remaining = jcount x - jcount i
       in if remaining > 0
          then [x { jcount = remaining }]
          else []
  else [x]

equalItemIdentity :: Item -> Item -> Bool
equalItemIdentity i1 i2 = jpower i1 == jpower i2 && jkind i1 == jkind i2

removeItemByIdentity :: Item -> [Item] -> [Item]
removeItemByIdentity = removeItemBy equalItemIdentity

equalItemLetter :: Item -> Item -> Bool
equalItemLetter = (==) `on` jletter

removeItemByLetter :: Item -> [Item] -> [Item]
removeItemByLetter = removeItemBy equalItemLetter

-- | Finds an item in a list of items.
findItem :: (Item -> Bool) -> [Item] -> Maybe (Item, [Item])
findItem p =
  findItem' []
 where
  findItem' _   []     = Nothing
  findItem' acc (i:is)
    | p i              = Just (i, reverse acc ++ is)
    | otherwise        = findItem' (i:acc) is

strongestItem :: [Item] -> (Item -> Bool) -> Maybe Item
strongestItem is p =
  let cmp = comparing jpower
      igs = L.filter p is
  in case igs of
    [] -> Nothing
    _  -> Just $ L.maximumBy cmp igs

strongestSearch :: Kind.Ops ItemKind -> [Item] -> Maybe Item
strongestSearch Kind.Ops{okind} bitems =
  strongestItem bitems $ \ i -> (ieffect $ okind $ jkind i) == Searching

-- TODO: generalise, in particular take base damage into account
strongestSword :: Kind.COps -> [Item] -> Maybe Item
strongestSword Kind.COps{coitem=Kind.Ops{osymbol}, corule} bitems =
  strongestItem bitems $ \ i -> (osymbol $ jkind i)
                                `elem` (ritemMelee $ Kind.stdRuleset corule)

strongestRegen :: Kind.Ops ItemKind -> [Item] -> Maybe Item
strongestRegen Kind.Ops{okind} bitems =
  strongestItem bitems $ \ i -> (ieffect $ okind $ jkind i) == Regeneration