content: -- | A set of Frame monad operations.
  module Game.LambdaHack.Client.UI.FrameM
    ( drawOverlay, promptGetKey, addToMacro, dropEmptyMacroFrames
    , lastMacroFrame, stopPlayBack, renderAnimFrames, animate
  #ifdef EXPOSE_INTERNAL
      -- * Internal operations
    , resetPlayBack, restoreLeaderFromRun, basicFrameForAnimation
  #endif
    ) where
  
  import Prelude ()
  
  import Game.LambdaHack.Core.Prelude
  
  import qualified Data.Bifunctor as B
  import qualified Data.EnumMap.Strict as EM
  import qualified Data.Map.Strict as M
  import qualified Data.Vector.Unboxed as U
  
  import           Game.LambdaHack.Client.MonadClient
  import           Game.LambdaHack.Client.State
  import           Game.LambdaHack.Client.UI.Animation
  import           Game.LambdaHack.Client.UI.Content.Input
  import           Game.LambdaHack.Client.UI.Content.Screen
  import           Game.LambdaHack.Client.UI.ContentClientUI
  import           Game.LambdaHack.Client.UI.DrawM
  import           Game.LambdaHack.Client.UI.Frame
  import qualified Game.LambdaHack.Client.UI.HumanCmd as HumanCmd
  import qualified Game.LambdaHack.Client.UI.Key as K
  import           Game.LambdaHack.Client.UI.MonadClientUI
  import           Game.LambdaHack.Client.UI.Msg
  import           Game.LambdaHack.Client.UI.MsgM
  import           Game.LambdaHack.Client.UI.Overlay
  import           Game.LambdaHack.Client.UI.PointUI
  import           Game.LambdaHack.Client.UI.SessionUI
  import           Game.LambdaHack.Client.UI.Slideshow
  import           Game.LambdaHack.Common.ActorState
  import           Game.LambdaHack.Common.ClientOptions
  import           Game.LambdaHack.Common.Faction
  import           Game.LambdaHack.Common.MonadStateRead
  import           Game.LambdaHack.Common.State
  import           Game.LambdaHack.Common.Types
  import qualified Game.LambdaHack.Definition.Color as Color
  
  -- | Draw the current level with the overlay on top.
  drawOverlay :: MonadClientUI m
              => ColorMode -> Bool -> FontOverlayMap -> LevelId
              -> m PreFrame3
  drawOverlay dm onBlank ovs lid = do
    CCUI{coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui
    basicFrame <- if onBlank
                  then do
                    let m = U.replicate (rwidth * rheight)
                                        (Color.attrCharW32 Color.spaceAttrW32)
                    return (m, FrameForall $ \_v -> return ())
                  else drawHudFrame dm lid
    FontSetup{..} <- getFontSetup
    let propWidth = if isMonoFont propFont then 2 * rwidth else 4 * rwidth
        ovProp | not (isSquareFont propFont)
               = truncateOverlay False propWidth rheight False 0 onBlank
                 $ EM.findWithDefault [] propFont ovs
               | otherwise = []
        ovMono = if not (isSquareFont monoFont)
                 then truncateOverlay False (2 * rwidth) rheight False 0 onBlank
                      $ EM.findWithDefault [] monoFont ovs
                 else []
        ovSquare | not (isSquareFont propFont)
                 = truncateOverlay False (2 * rwidth) rheight False 0 onBlank
                   $ EM.findWithDefault [] squareFont ovs
                | otherwise = []
        ovOther | not (isSquareFont propFont) = []
                | otherwise
                = truncateOverlay True rwidth rheight True 20 onBlank
                  $ concat $ EM.elems ovs
                      -- 20 needed not to leave gaps in skill menu
                      -- in the absence of backdrop
        ovBackdrop =
          if not (isSquareFont propFont) && not onBlank
          then let propOutline =
                     truncateOverlay False propWidth rheight True 0 onBlank
                     $ EM.findWithDefault [] propFont ovs
                   monoOutline =
                     truncateOverlay False (2 * rwidth) rheight True 0 onBlank
                     $ EM.findWithDefault [] monoFont ovs
                   squareOutline =
                     truncateOverlay False (2 * rwidth) rheight True 0 onBlank
                     $ EM.findWithDefault [] squareFont ovs
                   g x al Nothing = Just (x, x + length al - 1)
                   g x al (Just (xmin, xmax)) =
                     Just (min xmin x, max xmax (x + length al - 1))
                   f em (PointUI x y, al) = EM.alter (g x al) y em
                   extentMap = foldl' f EM.empty
                               $ propOutline ++ monoOutline ++ squareOutline
                   listBackdrop (y, (xmin, xmax)) =
                     ( PointUI (2 * (xmin `div` 2)) y
                     , blankAttrString
                       $ min (rwidth - 2 * (xmin `div` 2))
                             (1 + xmax `divUp` 2 - xmin `div` 2) )
               in map listBackdrop $ EM.assocs extentMap
          else []
        overlayedFrame = overlayFrame rwidth ovOther
                         $ overlayFrame rwidth ovBackdrop basicFrame
    return (overlayedFrame, (ovProp, ovSquare, ovMono))
  
  promptGetKey :: MonadClientUI m
               => ColorMode -> FontOverlayMap -> Bool -> [K.KM]
               -> m K.KM
  promptGetKey dm ovs onBlank frontKeyKeys = do
    lidV <- viewedLevelUI
    report <- getsSession $ newReport . shistory
    sreqQueried <- getsSession sreqQueried
    macroFrame <- getsSession smacroFrame
    let interrupted =
          -- If server is not querying for request, then the key is needed due to
          -- a special event, not ordinary querying the player for command,
          -- so interrupt.
          not sreqQueried
          -- Any alarming message interupts macros, except when the macro
          -- displays help and ends, which is a helpful thing to do.
          || (anyInReport disturbsResting report
              && keyPending macroFrame /= KeyMacro [K.mkKM "F1"])
    km <- case keyPending macroFrame of
      KeyMacro (km : kms) | not interrupted
                            -- A faulty key in a macro is a good reason
                            -- to interrupt it, as well.
                            && (null frontKeyKeys || km `elem` frontKeyKeys) -> do
        -- No need to display the frame, because a frame was displayed
        -- when the player chose to play a macro and each turn or more often
        -- a frame is displayed elsewhere.
        -- The only excepton is when navigating menus through macros,
        -- but there the speed is particularly welcome.
        modifySession $ \sess ->
          sess {smacroFrame = (smacroFrame sess) {keyPending = KeyMacro kms}}
        msgAdd MsgMacroOperation $ "Voicing '" <> tshow km <> "'."
        return km
      KeyMacro kms -> do
        if null kms then do
          -- There was no macro. Not important if there was a reason
          -- for interrupt or not.
          when (dm /= ColorFull) $ do
            -- This marks a special event, regardless of @sreqQueried@.
            side <- getsClient sside
            fact <- getsState $ (EM.! side) . sfactionD
            unless (gunderAI fact) -- don't forget special autoplay keypresses
              -- Forget the furious keypresses just before a special event.
              resetPressedKeys
          -- Running, if any, must have ended naturally, because no macro.
          -- Therefore no need to restore leader back to initial run leader,
          -- but running itself is cancelled below.
        else do
          -- The macro was not empty, but not played, so it must have been
          -- interrupted, so we can't continue playback, so wipe out the macro.
          resetPlayBack
          -- This might have been an unexpected end of a run, too.
          restoreLeaderFromRun
          -- Macro was killed, so emergency, so reset input, too.
          resetPressedKeys
        frontKeyFrame <- drawOverlay dm onBlank ovs lidV
        recordHistory
        modifySession $ \sess ->
          sess { srunning = Nothing
               , sxhairGoTo = Nothing
               , sdisplayNeeded = False
               , sturnDisplayed = True }
        connFrontendFrontKey frontKeyKeys frontKeyFrame
    -- In-game macros need to be recorded here, not in @UI.humanCommand@,
    -- to also capture choice of items from menus, etc.
    -- Notice that keys coming from macros (from content, in-game, config)
    -- are recorded as well and this is well defined and essential.
    --
    -- Only keys pressed when player is queried for a command are recorded.
    when sreqQueried $ do
      CCUI{coinput=InputContent{bcmdMap}} <- getsSession sccui
      modifySession $ \sess ->
        sess {smacroFrame = addToMacro bcmdMap km $ smacroFrame sess}
    return km
  
  addToMacro :: M.Map K.KM HumanCmd.CmdTriple -> K.KM -> KeyMacroFrame
             -> KeyMacroFrame
  addToMacro bcmdMap km macroFrame =
    case (\(_, _, cmd) -> cmd) <$> M.lookup km bcmdMap of
      Nothing -> macroFrame
      Just HumanCmd.Record -> macroFrame
      Just HumanCmd.RepeatLast{} -> macroFrame
      _ -> macroFrame { keyMacroBuffer =
                          (km :) `B.first` keyMacroBuffer macroFrame }
             -- This is noop when not recording a macro,
             -- which is exactly the required semantics.
  
  dropEmptyMacroFrames :: KeyMacroFrame -> [KeyMacroFrame]
                       -> (KeyMacroFrame, [KeyMacroFrame])
  dropEmptyMacroFrames mf [] = (mf, [])
  dropEmptyMacroFrames (KeyMacroFrame _ (KeyMacro []) _)
                       (mf : mfs) = dropEmptyMacroFrames mf mfs
  dropEmptyMacroFrames mf mfs = (mf, mfs)
  
  lastMacroFrame :: KeyMacroFrame -> [KeyMacroFrame] -> KeyMacroFrame
  lastMacroFrame mf [] = mf
  lastMacroFrame _ (mf : mfs) = lastMacroFrame mf mfs
  
  stopPlayBack :: MonadClientUI m => m ()
  stopPlayBack = msgAdd MsgStopPlayback "!"
  
  -- | We wipe any actions in progress, but keep the data needed to repeat
  -- the last global macros and the last command.
  resetPlayBack :: MonadClientUI m => m ()
  resetPlayBack =
    modifySession $ \sess ->
      let lastFrame = lastMacroFrame (smacroFrame sess) (smacroStack sess)
      in sess { smacroFrame = lastFrame {keyPending = mempty}
              , smacroStack = [] }
  
  restoreLeaderFromRun :: MonadClientUI m => m ()
  restoreLeaderFromRun = do
    srunning <- getsSession srunning
    case srunning of
      Nothing -> return ()
      Just RunParams{runLeader} -> do
        -- Switch to the original leader, from before the run start,
        -- unless dead or unless the faction never runs with multiple
        -- (but could have the leader changed automatically meanwhile).
        side <- getsClient sside
        fact <- getsState $ (EM.! side) . sfactionD
        arena <- getArenaUI
        memA <- getsState $ memActor runLeader arena
        when (memA && not (noRunWithMulti fact)) $
          updateClientLeader runLeader
  
  -- This is not our turn, so we can't obstruct screen with messages
  -- and message reformatting causes distraction, so there's no point
  -- trying to squeeze the report into the single available line,
  -- except when it's not our turn permanently, because AI runs UI.
  basicFrameForAnimation :: MonadClientUI m
                          => LevelId -> Maybe Bool -> m PreFrame3
  basicFrameForAnimation arena forceReport = do
    FontSetup{propFont} <- getFontSetup
    sbenchMessages <- getsClient $ sbenchMessages . soptions
    side <- getsClient sside
    fact <- getsState $ (EM.! side) . sfactionD
    report <- getReportUI False
    let par1 = firstParagraph $ foldr (<+:>) [] $ renderReport True report
        -- If messages are benchmarked, they can't be displayed under AI,
        -- because this is not realistic when player is in control.
        truncRep | not sbenchMessages && fromMaybe (gunderAI fact) forceReport =
                     EM.fromList [(propFont, [(PointUI 0 0, par1)])]
                 | otherwise = EM.empty
    drawOverlay ColorFull False truncRep arena
  
  -- | Render animations on top of the current screen frame.
  renderAnimFrames :: MonadClientUI m
                   => LevelId -> Animation -> Maybe Bool -> m PreFrames3
  renderAnimFrames arena anim forceReport = do
    CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui
    snoAnim <- getsClient $ snoAnim . soptions
    basicFrame <- basicFrameForAnimation arena forceReport
    smuteMessages <- getsSession smuteMessages
    return $! if | smuteMessages -> []
                 | fromMaybe False snoAnim -> [Just basicFrame]
                 | otherwise -> map (fmap (\fr -> (fr, snd basicFrame)))
                                $ renderAnim rwidth (fst basicFrame) anim
  
  -- | Render and display animations on top of the current screen frame.
  animate :: MonadClientUI m => LevelId -> Animation -> m ()
  animate arena anim = do
    -- The delay before reaction to keypress was too long in case of many
    -- projectiles hitting actors, so frames need to be skipped.
    keyPressed <- anyKeyPressed
    unless keyPressed $ do
      frames <- renderAnimFrames arena anim Nothing
      displayFrames arena frames
  