module ItemAction where

import Control.Monad
import Control.Monad.State hiding (State, state)
import qualified Data.List as L
import qualified Data.IntMap as IM
import Data.Maybe
import qualified Data.Set as S

import Utils.Assert
import Action
import Display hiding (display)
import Loc
import Grammar
import Item
import Content.ItemKind
import qualified Keys as K
import Level
import Actor
import ActorState
import ActorAdd
import Perception
import State
import EffectAction
import qualified Kind

-- Item UI code with the Action type and everything it depends on
-- that is not already in Action.hs and EffectAction.hs.
-- This file should not depend on Action.hs.

-- | Display inventory
inventory :: Action a
inventory = do
  items <- gets (bitems . getPlayerBody)
  if L.null items
    then abortWith "Not carrying anything."
    else do
           displayItems "Carrying:" True items
           session getConfirm
           abortWith ""

-- | Let the player choose any item with a given group name.
-- Note that this does not guarantee an item from the group to be chosen,
-- as the player can override the choice.
-- TODO: There should be a datatype for item groups instead of strings
-- or perhaps the functionality should be implemented differently,
-- e.g., based on equipment slot, as soon as it's specified for item kinds.
getGroupItem :: [Item] ->  -- all objects in question
                String ->  -- name of the group
                String ->  -- prompt
                String ->  -- how to refer to the collection of objects
                Action (Maybe Item)
getGroupItem is groupName prompt packName =
  let choice i = groupName == iname (Kind.getKind (jkind i))
      header = capitalize $ suffixS groupName
  in  getItem prompt choice header is packName

applyGroupItem :: ActorId ->  -- actor applying the item; on current level
                  String ->   -- how the "applying" is called
                  Item ->     -- the item to be applied
                  Action ()
applyGroupItem actor verb item = do
  state <- get
  body  <- gets (getActor actor)
  per   <- currentPerception
  -- only one item consumed, even if several in inventory
  let consumed = item { jcount = 1 }
      msg = subjectVerbIObject state body verb consumed ""
      loc = bloc body
  removeFromInventory actor consumed loc
  when (loc `S.member` ptvisible per) $ messageAdd msg
  itemEffectAction 5 actor actor consumed
  advanceTime actor

playerApplyGroupItem :: String -> Action ()
playerApplyGroupItem groupName = do
  is   <- gets (bitems . getPlayerBody)
  iOpt <- getGroupItem is groupName
            ("What to " ++ applyToVerb groupName ++ "?") "in inventory"
  pl   <- gets splayer
  case iOpt of
    Just i  ->
      let verb = applyToVerb (iname (Kind.getKind (jkind i)))
      in  applyGroupItem pl verb i
    Nothing -> neverMind True

applyToVerb :: String -> String
applyToVerb "potion" = "quaff"
applyToVerb "scroll" = "read"
applyToVerb _ = "destructively apply"

quaffPotion :: Action ()
quaffPotion = playerApplyGroupItem "potion"

readScroll :: Action ()
readScroll = playerApplyGroupItem "scroll"

zapGroupItem :: ActorId ->  -- actor zapping the item; on current level
                Loc ->      -- target location for the zapping
                String ->   -- how the "zapping" is called
                Item ->     -- the item to be zapped
                Action ()
zapGroupItem source loc verb item = do
  state <- get
  sm    <- gets (getActor source)
  per   <- currentPerception
  let consumed = item { jcount = 1 }
      sloc = bloc sm
      subject =
        if sloc `S.member` ptvisible per
        then sm
        else template Actor.heroKindId (Just "somebody") Nothing 99 sloc
      msg = subjectVerbIObject state subject verb consumed ""
  removeFromInventory source consumed sloc
  case locToActor loc state of
    Just ta -> do
      -- The message describes the source part of the action.
      when (sloc `S.member` ptvisible per || isAHero ta) $ messageAdd msg
      -- Messages inside itemEffectAction describe the target part.
      b <- itemEffectAction 10 source ta consumed
      unless b $ modify (updateLevel (dropItemsAt [consumed] loc))
    Nothing -> do
      when (sloc `S.member` ptvisible per) $ messageAdd msg
      modify (updateLevel (dropItemsAt [consumed] loc))
  advanceTime source

playerZapGroupItem :: String -> Action ()
playerZapGroupItem groupName = do
  state <- get
  is    <- gets (bitems . getPlayerBody)
  iOpt  <- getGroupItem is groupName
             ("What to " ++ zapToVerb groupName ++ "?") "in inventory"
  pl    <- gets splayer
  per   <- currentPerception
  case iOpt of
    Just i  ->
      case targetToLoc (ptvisible per) state of
        Nothing  -> abortWith "target invalid"
        Just loc ->
          -- TODO: draw digital line and see if obstacles prevent firing
          if actorReachesLoc pl loc per (Just pl)
          then let verb = zapToVerb (iname (Kind.getKind (jkind i)))
               in  zapGroupItem pl loc verb i
          else abortWith "target not reachable"
    Nothing -> neverMind True

zapToVerb :: String -> String
zapToVerb "wand" = "aim"
zapToVerb "dart" = "throw"
zapToVerb _ = "furiously zap"

aimItem :: Action ()
aimItem = playerZapGroupItem "wand"

throwItem :: Action ()
throwItem = playerZapGroupItem "dart"

-- | Drop a single item.
-- TODO: allow dropping a given number of identical items.
dropItem :: Action ()
dropItem = do
  pl    <- gets splayer
  state <- get
  pbody <- gets getPlayerBody
  ploc  <- gets (bloc . getPlayerBody)
  items <- gets (bitems . getPlayerBody)
  iOpt  <- getAnyItem "What to drop?" items "inventory"
  case iOpt of
    Just stack -> do
      let i = stack { jcount = 1 }
      removeOnlyFromInventory pl i (bloc pbody)
      messageAdd (subjectVerbIObject state pbody "drop" i "")
      modify (updateLevel (dropItemsAt [i] ploc))
    Nothing -> neverMind True
  playerAdvanceTime

-- TODO: this is a hack for dropItem, because removeFromInventory
-- makes it impossible to drop items if the floor not empty.
removeOnlyFromInventory :: ActorId -> Item -> Loc -> Action ()
removeOnlyFromInventory actor i _loc =
  updateAnyActor actor (\ m -> m { bitems = removeItemByLetter i (bitems m) })

-- | Remove given item from an actor's inventory or floor.
-- TODO: this is subtly wrong: if identical items are on the floor and in
-- inventory, the floor one will be chosen, regardless of player intention.
-- TODO: right now it ugly hacks (with the ploc) around removing items
-- of dead heros/monsters. The subtle incorrectness helps here a lot,
-- because items of dead heroes land on the floor, so we use them up
-- in inventory, but remove them after use from the floor.
removeFromInventory :: ActorId -> Item -> Loc -> Action ()
removeFromInventory actor i loc = do
  b <- removeFromLoc i loc
  unless b $
    updateAnyActor actor (\ m -> m { bitems = removeItemByLetter i (bitems m) })

-- | Remove given item from the given location. Tell if successful.
removeFromLoc :: Item -> Loc -> Action Bool
removeFromLoc i loc = do
  lvl <- gets slevel
  if not $ L.any (equalItemIdentity i) (lvl `iat` loc)
    then return False
    else
      modify (updateLevel (updateIMap adj)) >>
      return True
        where
          rib Nothing = assert `failure` (i, loc)
          rib (Just (is, irs)) =
            case (removeItemByIdentity i is, irs) of
              ([], []) -> Nothing
              iss -> Just iss
          adj = IM.alter rib loc

actorPickupItem :: ActorId -> Action ()
actorPickupItem actor = do
  state <- get
  pl    <- gets splayer
  per   <- currentPerception
  lvl   <- gets slevel
  body  <- gets (getActor actor)
  let loc       = bloc body
      perceived = loc `S.member` ptvisible per
      isPlayer  = actor == pl
  -- check if something is here to pick up
  case lvl `iat` loc of
    []   -> abortIfWith isPlayer "nothing here"
    i:is -> -- pick up first item; TODO: let player select item; not for monsters
      case assignLetter (jletter i) (bletter body) (bitems body) of
        Just l -> do
          let (ni, nitems) = joinItem (i { jletter = Just l }) (bitems body)
          -- message depends on who picks up and if a hero can perceive it
          if isPlayer
            then messageAdd (letterLabel (jletter ni) ++ objectItem state ni)
            else when perceived $
                   messageAdd $ subjCompoundVerbIObj state body "pick" "up" i ""
          removeFromLoc i loc
            >>= assert `trueM` (i, is, loc, "item is stuck")
          -- add item to actor's inventory:
          updateAnyActor actor $ \ m ->
            m { bitems = nitems, bletter = maxLetter l (bletter body) }
        Nothing -> abortIfWith isPlayer "cannot carry any more"
  advanceTime actor

pickupItem :: Action ()
pickupItem = do
  pl <- gets splayer
  actorPickupItem pl

-- TODO: I think that player handlers should be wrappers
-- around more general actor handlers, but
-- the actor handlers should be performing
-- specific actions, i.e., already specify the item to be
-- picked up. It doesn't make sense to invoke dialogues
-- for arbitrary actors, and most likely the
-- decision for a monster is based on perceiving
-- a particular item to be present, so it's already
-- known. In actor handlers we should make sure
-- that messages are printed to the player only if the
-- hero can perceive the action.
-- Perhaps this means half of this code should be split and moved
-- to ItemState, to be independent of any IO code from Action/Display. Actually, not, since the message display depends on Display. Unless we return a string to be displayed.

-- | Let the player choose any item from a list of items.
-- TODO: you can drop an item on the floor, which works correctly,
-- but is weird and useless.
getAnyItem :: String ->  -- prompt
              [Item] ->  -- all objects in question
              String ->  -- how to refer to the collection of objects
              Action (Maybe Item)
getAnyItem prompt = getItem prompt (const True) "Objects"

-- | Let the player choose a single item from a list of items.
getItem :: String ->              -- prompt message
           (Item -> Bool) ->      -- which items to consider suitable
           String ->              -- how to describe suitable objects
           [Item] ->              -- all objects in question
           String ->              -- how to refer to the collection of objects
           Action (Maybe Item)
getItem prompt p ptext is0 isn = do
  lvl  <- gets slevel
  body <- gets getPlayerBody
  let loc       = bloc body
      tis       = lvl `iat` loc
      floorMsg  = if L.null tis then "" else " -,"
      is = L.filter p is0
      choice = if L.null is
               then "[*," ++ floorMsg ++ " ESC]"
               else let r = letterRange $ mapMaybe jletter is
                    in  "[" ++ r ++ ", ?, *," ++ floorMsg ++ " RET, ESC]"
      ask = do
        when (L.null is0 && L.null tis) $
          abortWith "Not carrying anything."
        messageReset (prompt ++ " " ++ choice)
        display
        session nextCommand >>= perform
      perform command = do
        messageClear
        case command of
          K.Char '?' -> do
            -- filter for supposedly suitable objects
            b <- displayItems (ptext ++ " " ++ isn) True is
            if b then session (getOptionalConfirm (const ask) perform)
                 else ask
          K.Char '*' -> do
            -- show all objects
            b <- displayItems ("Objects " ++ isn) True is0
            if b then session (getOptionalConfirm (const ask) perform)
                 else ask
          K.Char '-' ->
            case tis of
              []   -> return Nothing
              i:_rs -> -- use first item; TODO: let player select item
                      return $ Just i
          K.Char l   ->
            return (L.find (maybe False (== l) . jletter) is0)
          K.Return   ->  -- TODO: it should be the first displayed (except $)
            return (case is of [] -> Nothing ; i : _ -> Just i)
          _          -> return Nothing
  ask