content: -- | The type of definitions of key-command mappings to be used for the UI
  -- and shorthands for specifying command triples in the content files.
  module Game.LambdaHack.Client.UI.Content.Input
    ( InputContentRaw(..), InputContent(..), makeData
    , evalKeyDef
    , addCmdCategory, replaceDesc, moveItemTriple, repeatTriple, repeatLastTriple
    , mouseLMB, mouseMMB, mouseMMBMute, mouseRMB
    , goToCmd, runToAllCmd, autoexploreCmd, autoexplore25Cmd
    , aimFlingCmd, projectI, projectA, flingTs, applyIK, applyI
    , grabItems, dropItems, descIs, defaultHeroSelect, macroRun25
    , memberCycle, memberCycleLevel
  #ifdef EXPOSE_INTERNAL
      -- * Internal operations
    , replaceCmd, projectICmd, grabCmd, dropCmd
  #endif
    ) where
  
  import Prelude ()
  
  import Game.LambdaHack.Core.Prelude
  
  import qualified Data.Char as Char
  import qualified Data.Map.Strict as M
  import qualified NLP.Miniutter.English as MU
  
  import           Game.LambdaHack.Client.UI.HumanCmd
  import qualified Game.LambdaHack.Client.UI.Key as K
  import           Game.LambdaHack.Client.UI.UIOptions
  import           Game.LambdaHack.Common.Misc
  import           Game.LambdaHack.Definition.Defs
  
  -- | Key-command mappings to be specified in content and used for the UI.
  newtype InputContentRaw = InputContentRaw [(K.KM, CmdTriple)]
  
  -- | Bindings and other information about human player commands.
  data InputContent = InputContent
    { bcmdMap  :: M.Map K.KM CmdTriple   -- ^ binding of keys to commands
    , bcmdList :: [(K.KM, CmdTriple)]    -- ^ the properly ordered list
                                         --   of commands for the help menu
    , brevMap  :: M.Map HumanCmd [K.KM]  -- ^ and from commands to their keys
    }
  
  -- | Create binding of keys to movement and other standard commands,
  -- as well as commands defined in the config file.
  makeData :: Maybe UIOptions   -- ^ UI client options
           -> InputContentRaw  -- ^ default key bindings from the content
           -> InputContent     -- ^ concrete binding
  makeData muiOptions (InputContentRaw copsClient) =
    let (uCommands0, uVi0, uLeftHand0) = case muiOptions of
          Just UIOptions{uCommands, uVi, uLeftHand} -> (uCommands, uVi, uLeftHand)
          Nothing -> ([], True, True)
        waitTriple = ([CmdMove], "", Wait)
        wait10Triple = ([CmdMove], "", Wait10)
        moveXhairOr n cmd v = ByAimMode $ AimModeCmd { exploration = cmd v
                                                     , aiming = MoveXhair v n }
        rawContent = copsClient ++ uCommands0
        movementDefinitions =
          K.moveBinding uVi0 uLeftHand0
            (\v -> ([CmdMove], "", moveXhairOr 1 MoveDir v))
            (\v -> ([CmdMove], "", moveXhairOr 10 RunDir v))
          ++ [ (K.mkKM "KP_Begin", waitTriple)
             , (K.mkKM "C-KP_Begin", wait10Triple)
             , (K.mkKM "KP_5", wait10Triple)
             , (K.mkKM "S-KP_5", wait10Triple)  -- rxvt
             , (K.mkKM "C-KP_5", wait10Triple) ]
          ++ [(K.mkKM "period", waitTriple) | uVi0]
          ++ [(K.mkKM "C-period", wait10Triple) | uVi0]
          ++ [(K.mkKM "s", waitTriple) | uLeftHand0]
          ++ [(K.mkKM "S", wait10Triple) | uLeftHand0]
        -- This is the most common case of duplicate keys and it usually
        -- has an easy solution, so it's tested for first.
        !_A = flip assert () $
          let movementKeys = map fst movementDefinitions
              filteredNoMovement = filter (\(k, _) -> k `notElem` movementKeys)
                                          rawContent
          in rawContent == filteredNoMovement
             `blame` "commands overwrite the enabled movement keys (you can disable some in config file and try again)"
             `swith` rawContent \\ filteredNoMovement
        bcmdList = rawContent ++ movementDefinitions
        -- This catches repetitions (usually) not involving movement keys.
        rejectRepetitions _ t1 (_, "", _) = t1
        rejectRepetitions _ (_, "", _) t2 = t2
        rejectRepetitions k t1 t2 =
          error $ "duplicate key among command definitions (you can instead disable some movement key sets in config file and overwrite the freed keys)" `showFailure` (k, t1, t2)
    in InputContent
    { bcmdMap = M.fromListWithKey rejectRepetitions bcmdList
    , bcmdList
    , brevMap = M.fromListWith (flip (++)) $ concat
        [ [(cmd, [k])]
        | (k, (cats, _desc, cmd)) <- bcmdList
        , not (null cats)
          && CmdDebug `notElem` cats
        ]
    }
  
  evalKeyDef :: (String, CmdTriple) -> (K.KM, CmdTriple)
  evalKeyDef (t, triple@(cats, _, _)) =
    let km = if CmdInternal `elem` cats
             then K.KM K.NoModifier $ K.Unknown t
             else K.mkKM t
    in (km, triple)
  
  addCmdCategory :: CmdCategory -> CmdTriple -> CmdTriple
  addCmdCategory cat (cats, desc, cmd) = (cat : cats, desc, cmd)
  
  replaceDesc :: Text -> CmdTriple -> CmdTriple
  replaceDesc desc (cats, _, cmd) = (cats, desc, cmd)
  
  replaceCmd :: HumanCmd -> CmdTriple -> CmdTriple
  replaceCmd cmd (cats, desc, _) = (cats, desc, cmd)
  
  moveItemTriple :: [CStore] -> CStore -> MU.Part -> Bool -> CmdTriple
  moveItemTriple stores1 store2 object auto =
    let verb = MU.Text $ verbCStore store2
        desc = makePhrase [verb, object]
    in ([CmdItemMenu, CmdItem], desc, MoveItem stores1 store2 Nothing auto)
  
  repeatTriple :: Int -> [CmdCategory] -> CmdTriple
  repeatTriple n cats =
    ( cats
    , if n == 1
      then "voice recorded macro again"
      else "voice recorded macro" <+> tshow n <+> "times"
    , Repeat n )
  
  repeatLastTriple :: Int -> [CmdCategory] -> CmdTriple
  repeatLastTriple n cats =
    ( cats
    , if n == 1
      then "voice last action again"
      else "voice last action" <+> tshow n <+> "times in a row"
    , RepeatLast n )
  
  -- @AimFloor@ is not there, but @AimEnemy@ and @AimItem@ almost make up for it.
  mouseLMB :: HumanCmd -> Text -> CmdTriple
  mouseLMB goToOrRunTo desc =
    ([CmdMouse], desc, ByAimMode aimMode)
   where
    aimMode = AimModeCmd
      { exploration = ByArea $ common ++  -- exploration mode
          [ (CaMapLeader, grabCmd)
          , (CaMapParty, PickLeaderWithPointer)
          , (CaMap, goToOrRunTo)
          , (CaArenaName, Dashboard)
          , (CaPercentSeen, autoexploreCmd) ]
      , aiming = ByArea $ common ++  -- aiming mode
          [ (CaMap, aimFlingCmd)
          , (CaArenaName, Accept)
          , (CaPercentSeen, XhairStair True) ] }
    common =
      [ (CaMessage, AllHistory)
      , (CaLevelNumber, AimAscend 1)
      , (CaXhairDesc, AimEnemy)  -- inits aiming and then cycles enemies
      , (CaSelected, PickLeaderWithPointer)
  --    , (CaCalmGauge, Macro ["KP_Begin", "C-v"])
      , (CaCalmValue, Yell)
      , (CaHPGauge, Macro ["KP_Begin", "C-v"])
      , (CaHPValue, Wait)
      , (CaLeaderDesc, projectICmd flingTs) ]
  
  mouseMMB :: CmdTriple
  mouseMMB = ( [CmdMouse]
             , "snap crosshair to floor under pointer/cycle detail level"
             , XhairPointerFloor )
  
  mouseMMBMute :: CmdTriple
  mouseMMBMute = ([CmdMouse], "", XhairPointerMute)
  
  mouseRMB :: CmdTriple
  mouseRMB = ( [CmdMouse]
             , "start aiming at enemy under pointer/cycle detail level"
             , ByAimMode aimMode )
   where
    aimMode = AimModeCmd
      { exploration = ByArea $ common ++
          [ (CaMapLeader, dropCmd)
          , (CaMapParty, SelectWithPointer)
          , (CaMap, AimPointerEnemy)
          , (CaArenaName, ExecuteIfClear MainMenuAutoOff)
          , (CaPercentSeen, autoexplore25Cmd) ]
      , aiming = ByArea $ common ++
          [ (CaMap, XhairPointerEnemy)  -- hack; same effect, but matches LMB
          , (CaArenaName, Cancel)
          , (CaPercentSeen, XhairStair False) ] }
    common =
      [ (CaMessage, Hint)
      , (CaLevelNumber, AimAscend (-1))
      , (CaXhairDesc, AimItem)
      , (CaSelected, SelectWithPointer)
  --    , (CaCalmGauge, Macro ["C-KP_Begin", "A-v"])
      , (CaCalmValue, Yell)
      , (CaHPGauge, Macro ["C-KP_Begin", "A-v"])
      , (CaHPValue, Wait10)
      , (CaLeaderDesc, ComposeUnlessError ClearTargetIfItemClear ItemClear) ]
  
  -- This is duplicated wrt content, instead of included via @semicolon@,
  -- because the C- commands are less likely to be modified by the player
  -- and so more dependable than @semicolon@, @colon@, etc.
  goToCmd :: HumanCmd
  goToCmd = Macro ["A-MiddleButtonRelease", "C-semicolon", "C-quotedbl", "C-v"]
  
  -- This is duplicated wrt content, instead of included via @colon@,
  -- because the C- commands are less likely to be modified by the player
  -- and so more dependable than @semicolon@, @colon@, etc.
  runToAllCmd :: HumanCmd
  runToAllCmd = Macro ["A-MiddleButtonRelease", "C-colon", "C-quotedbl", "C-v"]
  
  autoexploreCmd :: HumanCmd
  autoexploreCmd = Macro ["C-?", "C-quotedbl", "C-v"]
  
  autoexplore25Cmd :: HumanCmd
  autoexplore25Cmd = Macro ["'", "C-?", "C-quotedbl", "'", "C-V"]
  
  aimFlingCmd :: HumanCmd
  aimFlingCmd = ComposeIfLocal AimPointerEnemy (projectICmd flingTs)
  
  projectICmd :: [TriggerItem] -> HumanCmd
  projectICmd ts = ComposeUnlessError (ChooseItemProject ts) Project
  
  projectI :: [TriggerItem] -> CmdTriple
  projectI ts = ([CmdItem], descIs ts, projectICmd ts)
  
  projectA :: [TriggerItem] -> CmdTriple
  projectA ts =
    let fling = Compose2ndLocal Project ItemClear
        flingICmd = ComposeUnlessError (ChooseItemProject ts) fling
    in replaceCmd (ByAimMode AimModeCmd { exploration = AimTgt
                                        , aiming = flingICmd })
                  (projectI ts)
  
  -- | flingTs - list containing one flingable projectile
  -- >>> flingTs
  -- [TriggerItem {tiverb = Text "fling", tiobject = Text "in-range projectile", tisymbols = ""}]
  --
  -- I question the value of that test. But would Bob Martin like it
  -- on the grounds it's like double-bookkeeping?
  flingTs :: [TriggerItem]
  flingTs = [TriggerItem { tiverb = "fling"
                         , tiobject = "in-range projectile"
                         , tisymbols = [] }]
  
  applyIK :: [TriggerItem] -> CmdTriple
  applyIK ts =
    ([CmdItem], descIs ts, ComposeUnlessError (ChooseItemApply ts) Apply)
  
  applyI :: [TriggerItem] -> CmdTriple
  applyI ts =
    let apply = Compose2ndLocal Apply ItemClear
    in ([CmdItem], descIs ts, ComposeUnlessError (ChooseItemApply ts) apply)
  
  grabCmd :: HumanCmd
  grabCmd = MoveItem [CGround] CStash (Just "grab") True
              -- @CStash@ is the implicit default; refined in HandleHumanGlobalM
  
  grabItems :: Text -> CmdTriple
  grabItems t = ([CmdItemMenu, CmdItem], t, grabCmd)
  
  dropCmd :: HumanCmd
  dropCmd = MoveItem [CStash, CEqp] CGround Nothing False
  
  dropItems :: Text -> CmdTriple
  dropItems t = ([CmdItemMenu, CmdItem], t, dropCmd)
  
  descIs :: [TriggerItem] -> Text
  descIs [] = "trigger an item"
  descIs (t : _) = makePhrase [tiverb t, tiobject t]
  
  defaultHeroSelect :: Int -> (String, CmdTriple)
  defaultHeroSelect k = ([Char.intToDigit k], ([CmdMeta], "", PickLeader k))
  
  macroRun25 :: [String]
  macroRun25 = ["C-comma", "C-v"]
  
  memberCycle :: Direction -> [CmdCategory] -> CmdTriple
  memberCycle d cats = ( cats
                       , "cycle"
                         <+> (if d == Backward then "backwards" else "")
                         <+> "among all party members"
                       , PointmanCycle d )
  
  memberCycleLevel :: Direction -> [CmdCategory] -> CmdTriple
  memberCycleLevel d cats = ( cats
                            , "cycle"
                              <+> (if d == Backward then "backwards" else "")
                              <+> " among party members on the level"
                            , PointmanCycleLevel d )
  