<commit_before>-- | A set of widgets for UI clients.
module Game.LambdaHack.Client.UI.WidgetClient
  ( displayMore, displayYesNo, displayChoiceUI, displayPush, describeMainKeys
  , promptToSlideshow, overlayToSlideshow, overlayToBlankSlideshow
  , animate, fadeOutOrIn
  ) where

import qualified Data.EnumMap.Strict as EM
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Monoid
import qualified Data.Text as T

import Game.LambdaHack.Client.BfsClient
import qualified Game.LambdaHack.Client.Key as K
import Game.LambdaHack.Client.MonadClient hiding (liftIO)
import Game.LambdaHack.Client.State
import Game.LambdaHack.Client.UI.Animation
import Game.LambdaHack.Client.UI.Config
import Game.LambdaHack.Client.UI.Content.KeyKind
import Game.LambdaHack.Client.UI.DrawClient
import Game.LambdaHack.Client.UI.HumanCmd
import Game.LambdaHack.Client.UI.KeyBindings
import Game.LambdaHack.Client.UI.MonadClientUI
import Game.LambdaHack.Common.ClientOptions
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Msg
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.State

-- | A yes-no confirmation.
getYesNo :: MonadClientUI m => SingleFrame -> m Bool
getYesNo frame = do
  let keys = [ K.toKM K.NoModifier (K.Char 'y')
             , K.toKM K.NoModifier (K.Char 'n')
             , K.escKM
             ]
  K.KM {key} <- promptGetKey keys frame
  case key of
    K.Char 'y' -> return True
    _          -> return False

-- | Display a message with a @-more-@ prompt.
-- Return value indicates if the player tried to cancel/escape.
displayMore :: MonadClientUI m => ColorMode -> Msg -> m Bool
displayMore dm prompt = do
  slides <- promptToSlideshow $ prompt <+> moreMsg
  -- Two frames drawn total (unless 'prompt' very long).
  getInitConfirms dm [] $ slides <> toSlideshow Nothing [[]]

-- | Print a yes/no question and return the player's answer. Use black
-- and white colours to turn player's attention to the choice.
displayYesNo :: MonadClientUI m => ColorMode -> Msg -> m Bool
displayYesNo dm prompt = do
  sli <- promptToSlideshow $ prompt <+> yesnoMsg
  frame <- drawOverlay False dm $ head . snd $ slideshow sli
  getYesNo frame

-- TODO: generalize getInitConfirms and displayChoiceUI to a single op
-- | Print a prompt and an overlay and wait for a player keypress.
-- If many overlays, scroll screenfuls with SPACE. Do not wrap screenfuls
-- (in some menus @?@ cycles views, so the user can restart from the top).
displayChoiceUI :: MonadClientUI m
                => Msg -> Overlay -> [K.KM] -> m (Either Slideshow K.KM)
displayChoiceUI prompt ov keys = do
  (_, ovs) <- fmap slideshow $ overlayToSlideshow (prompt <> ", ESC]") ov
  let legalKeys = [K.spaceKM, K.escKM]
        ++ keys
      loop [] = fmap Left $ promptToSlideshow "*never mind*"
      loop (x : xs) = do
        frame <- drawOverlay False ColorFull x
        km@K.KM {..} <- promptGetKey legalKeys frame
        case key of
          K.Esc -> fmap Left $ promptToSlideshow "*never mind*"
          K.Space -> loop xs
          _ -> return $ Right km
  loop ovs

-- TODO: if more slides, don't take head, but do as in getInitConfirms,
-- but then we have to clear the messages or they get redisplayed
-- each time screen is refreshed.
-- | Push the frame depicting the current level to the frame queue.
-- Only one screenful of the report is shown, the rest is ignored.
displayPush :: MonadClientUI m => Msg -> m ()
displayPush prompt = do
  sls <- promptToSlideshow prompt
  let slide = head . snd $ slideshow sls
  frame <- drawOverlay False ColorFull slide
  displayFrame (Just frame)

describeMainKeys :: MonadClientUI m => m Msg
describeMainKeys = do
  stgtMode <- getsClient stgtMode
  Binding{brevMap} <- askBinding
  Config{configVi, configLaptop} <- askConfig
  cursor <- getsClient scursor
  let kmLeftButtonPress =
        fromMaybe (K.toKM K.NoModifier K.LeftButtonPress)
        $ M.lookup macroLeftButtonPress brevMap
      kmEscape =
        fromMaybe (K.toKM K.NoModifier K.Esc)
        $ M.lookup Cancel brevMap
      kmCtrlx =
        fromMaybe (K.toKM K.Control (K.KP 'x'))
        $ M.lookup GameExit brevMap
      kmRightButtonPress =
        fromMaybe (K.toKM K.NoModifier K.RightButtonPress)
        $ M.lookup TgtPointerEnemy brevMap
      kmReturn =
        fromMaybe (K.toKM K.NoModifier K.Return)
        $ M.lookup Accept brevMap
      moveKeys =
        if configVi then "hjklyubn, "
        else if configLaptop then "uk8o79jl, "
        else ""
      tgtKind = case cursor of
        TEnemy _ True -> "actor"
        TEnemy _ False -> "enemy"
        TEnemyPos _ _ _ True -> "actor"
        TEnemyPos _ _ _ False -> "enemy"
        TPoint{} -> "position"
        TVector{} -> "vector"
      keys | isNothing stgtMode =
        "Explore with numpad or keys or mouse: ["
        <> moveKeys
        <> (T.intercalate ", " $ map K.showKM
            $ [kmLeftButtonPress, kmCtrlx, kmEscape])
        <> "]"<commit_msg>Don't display key hints in screensaver mode<commit_after>-- | A set of widgets for UI clients.
module Game.LambdaHack.Client.UI.WidgetClient
  ( displayMore, displayYesNo, displayChoiceUI, displayPush, describeMainKeys
  , promptToSlideshow, overlayToSlideshow, overlayToBlankSlideshow
  , animate, fadeOutOrIn
  ) where

import qualified Data.EnumMap.Strict as EM
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Monoid
import qualified Data.Text as T

import Game.LambdaHack.Client.BfsClient
import qualified Game.LambdaHack.Client.Key as K
import Game.LambdaHack.Client.MonadClient hiding (liftIO)
import Game.LambdaHack.Client.State
import Game.LambdaHack.Client.UI.Animation
import Game.LambdaHack.Client.UI.Config
import Game.LambdaHack.Client.UI.Content.KeyKind
import Game.LambdaHack.Client.UI.DrawClient
import Game.LambdaHack.Client.UI.HumanCmd
import Game.LambdaHack.Client.UI.KeyBindings
import Game.LambdaHack.Client.UI.MonadClientUI
import Game.LambdaHack.Common.ClientOptions
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Msg
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.State

-- | A yes-no confirmation.
getYesNo :: MonadClientUI m => SingleFrame -> m Bool
getYesNo frame = do
  let keys = [ K.toKM K.NoModifier (K.Char 'y')
             , K.toKM K.NoModifier (K.Char 'n')
             , K.escKM
             ]
  K.KM {key} <- promptGetKey keys frame
  case key of
    K.Char 'y' -> return True
    _          -> return False

-- | Display a message with a @-more-@ prompt.
-- Return value indicates if the player tried to cancel/escape.
displayMore :: MonadClientUI m => ColorMode -> Msg -> m Bool
displayMore dm prompt = do
  slides <- promptToSlideshow $ prompt <+> moreMsg
  -- Two frames drawn total (unless 'prompt' very long).
  getInitConfirms dm [] $ slides <> toSlideshow Nothing [[]]

-- | Print a yes/no question and return the player's answer. Use black
-- and white colours to turn player's attention to the choice.
displayYesNo :: MonadClientUI m => ColorMode -> Msg -> m Bool
displayYesNo dm prompt = do
  sli <- promptToSlideshow $ prompt <+> yesnoMsg
  frame <- drawOverlay False dm $ head . snd $ slideshow sli
  getYesNo frame

-- TODO: generalize getInitConfirms and displayChoiceUI to a single op
-- | Print a prompt and an overlay and wait for a player keypress.
-- If many overlays, scroll screenfuls with SPACE. Do not wrap screenfuls
-- (in some menus @?@ cycles views, so the user can restart from the top).
displayChoiceUI :: MonadClientUI m
                => Msg -> Overlay -> [K.KM] -> m (Either Slideshow K.KM)
displayChoiceUI prompt ov keys = do
  (_, ovs) <- fmap slideshow $ overlayToSlideshow (prompt <> ", ESC]") ov
  let legalKeys = [K.spaceKM, K.escKM]
        ++ keys
      loop [] = fmap Left $ promptToSlideshow "*never mind*"
      loop (x : xs) = do
        frame <- drawOverlay False ColorFull x
        km@K.KM {..} <- promptGetKey legalKeys frame
        case key of
          K.Esc -> fmap Left $ promptToSlideshow "*never mind*"
          K.Space -> loop xs
          _ -> return $ Right km
  loop ovs

-- TODO: if more slides, don't take head, but do as in getInitConfirms,
-- but then we have to clear the messages or they get redisplayed
-- each time screen is refreshed.
-- | Push the frame depicting the current level to the frame queue.
-- Only one screenful of the report is shown, the rest is ignored.
displayPush :: MonadClientUI m => Msg -> m ()
displayPush prompt = do
  sls <- promptToSlideshow prompt
  let slide = head . snd $ slideshow sls
  frame <- drawOverlay False ColorFull slide
  displayFrame (Just frame)

describeMainKeys :: MonadClientUI m => m Msg
describeMainKeys = do
  side <- getsClient sside
  fact <- getsState $ (EM.! side) . sfactionD
  let underAI = isAIFact fact
  stgtMode <- getsClient stgtMode
  Binding{brevMap} <- askBinding
  Config{configVi, configLaptop} <- askConfig
  cursor <- getsClient scursor
  let kmLeftButtonPress =
        fromMaybe (K.toKM K.NoModifier K.LeftButtonPress)
        $ M.lookup macroLeftButtonPress brevMap
      kmEscape =
        fromMaybe (K.toKM K.NoModifier K.Esc)
        $ M.lookup Cancel brevMap
      kmCtrlx =
        fromMaybe (K.toKM K.Control (K.KP 'x'))
        $ M.lookup GameExit brevMap
      kmRightButtonPress =
        fromMaybe (K.toKM K.NoModifier K.RightButtonPress)
        $ M.lookup TgtPointerEnemy brevMap
      kmReturn =
        fromMaybe (K.toKM K.NoModifier K.Return)
        $ M.lookup Accept brevMap
      moveKeys =
        if configVi then "hjklyubn, "
        else if configLaptop then "uk8o79jl, "
        else ""
      tgtKind = case cursor of
        TEnemy _ True -> "actor"
        TEnemy _ False -> "enemy"
        TEnemyPos _ _ _ True -> "actor"
        TEnemyPos _ _ _ False -> "enemy"
        TPoint{} -> "position"
        TVector{} -> "vector"
      keys | underAI = ""
           | isNothing stgtMode =
        "Explore with numpad or keys or mouse: ["
        <> moveKeys
        <> (T.intercalate ", " $ map K.showKM
            $ [kmLeftButtonPress, kmCtrlx, kmEscape])
        <> "]"
{'fraction_non_alphanumeric': 0.09332683877252801, 'fraction_numerical': 0.0005845104724792986, 'mean_word_length': 2.913839115516584, 'pattern_counts': {'":': 0, '<': 45, '<?xml version=': 0, '>': 69, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 2, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '119368', 'n_tokens_mistral': 3294, 'n_tokens_neox': 3147, 'n_words': 1021}