<commit_before>{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
-- | Screen frames and animations.
module Game.LambdaHack.Client.UI.Animation
  ( SingleFrame(..), decodeLine, encodeLine
  , overlayOverlay
  , Animation, Frames, renderAnim, restrictAnim
  , twirlSplash, blockHit, blockMiss, deathBody, swapPlaces, fadeout
  ) where

import Control.Exception.Assert.Sugar
import Data.Binary
import Data.Bits
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Int (Int32)
import Data.List
import Data.Maybe
import Data.Monoid
import qualified Data.Text as T
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Unboxed as U
import GHC.Generics (Generic)

import Game.LambdaHack.Common.Color
import qualified Game.LambdaHack.Common.Color as Color
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.Msg
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.Random

type ScreenLine = U.Vector Int32

decodeLine :: ScreenLine -> [AttrChar]
decodeLine v = map (toEnum . fromIntegral) $ G.toList v

encodeLine :: [AttrChar] -> ScreenLine
encodeLine l = G.fromList $ map (fromIntegral . fromEnum) l

-- | The data sufficent to draw a single game screen frame.
data SingleFrame = SingleFrame
  { sfLevel  :: ![ScreenLine]  -- ^ screen, from top to bottom, line by line
  , sfTop    :: !Overlay       -- ^ some extra lines to show over the top
  , sfBottom :: ![ScreenLine]  -- ^ some extra lines to show at the bottom
  , sfBlank  :: !Bool          -- ^ display only @sfTop@, on blank screen
  }
  deriving (Eq, Show, Generic)

instance Binary SingleFrame

-- | Overlays the @sfTop@ and @sfBottom@ fields onto the @sfLevel@ field.
-- The resulting frame has empty @sfTop@ and @sfBottom@.
-- To be used by simple frontends that don't display overlays
-- in separate windows/panes/scrolled views.
overlayOverlay :: SingleFrame -> SingleFrame
overlayOverlay sf@SingleFrame{..} =
  let lxsize = xsizeSingleFrame sf
      lysize = ysizeSingleFrame sf
      emptyLine = encodeLine
                  $ replicate lxsize (Color.AttrChar Color.defAttr ' ')
      canvasLength = if sfBlank then lysize + 3 else lysize + 1
      canvas | sfBlank = replicate canvasLength emptyLine
             | otherwise = emptyLine : sfLevel
      topTrunc = map (truncateMsg lxsize) $ overlay sfTop
      topLayer = if length topTrunc <= canvasLength
                 then topTrunc
                 else take (canvasLength - 1) topTrunc
                      ++ ["--a portion of the text trimmed--"]
      addAttr t = map (Color.AttrChar Color.defAttr) (T.unpack t)
      f layerLine canvasLine = encodeLine
        $ addAttr layerLine
          ++ drop (T.length layerLine) (decodeLine canvasLine)
      picture = zipWith f topLayer canvas
      bottomLines = if sfBlank then [] else sfBottom
      newLevel = picture ++ drop (length picture) canvas ++ bottomLines
  in SingleFrame { sfLevel = newLevel
                 , sfTop = emptyOverlay
                 , sfBottom = []
                 , sfBlank }

-- | Animation is a list of frame modifications to play one by one,
-- where each modification if a map from positions to level map symbols.
newtype Animation = Animation [EM.EnumMap Point AttrChar]
  deriving (Eq, Show, Monoid)

-- | Sequences of screen frames, including delays.
type Frames = [Maybe SingleFrame]

xsizeSingleFrame :: SingleFrame -> X
xsizeSingleFrame SingleFrame{sfLevel=[]} = 0
xsizeSingleFrame SingleFrame{sfLevel=line : _} = G.length line

ysizeSingleFrame :: SingleFrame -> X
ysizeSingleFrame SingleFrame{sfLevel} = length sfLevel

-- | Render animations on top of a screen frame.
renderAnim :: X -> Y -> SingleFrame -> Animation -> Frames
renderAnim lxsize lysize basicFrame (Animation anim) =
  let modifyFrame SingleFrame{sfLevel = []} _ =
        assert `failure` (lxsize, lysize, basicFrame, anim)
      modifyFrame SingleFrame{sfLevel = levelOld, ..} am =
        let fLine y lineOld =
              let f l (x, acOld) =
                    let pos = Point x y
                        !ac = fromMaybe acOld $ EM.lookup pos am
                    in ac : l
              in foldl' f [] (zip [lxsize-1,lxsize-2..0] (reverse lineOld))
            sfLevel =  -- fully evaluated inside
              let f l (y, lineOld) = let !line = fLine y lineOld in line : l
              in map encodeLine
                 $ foldl' f [] (zip [lysize-1,lysize-2..0]
                                $ reverse $ map decodeLine levelOld)
        in Just SingleFrame{..}  -- a thunk within Just
  in map (modifyFrame basicFrame) anim

blank :: Maybe AttrChar
blank = Nothing

coloredSymbol :: Color -> Char -> Maybe AttrChar
coloredSymbol color symbol = Just $ AttrChar (Attr color defBG) symbol

mzipPairs :: (Point, Point) -> (Maybe AttrChar, Maybe AttrChar)
          -> [(Point, AttrChar)]
mzipPairs (p1, p2) (mattr1, mattr2) =
  let mzip (pos, mattr) = fmap (\x -> (pos, x)) mattr
  in catMaybes $ if p1 /= p2
                 then [mzip (p1, mattr1), mzip (p2, mattr2)]
                 else -- If actor affects himself, show only the effect,
                      -- not the action.
                      [mzip (p1, mattr1)]

restrictAnim :: ES.EnumSet Point -> Animation -> Animation
restrictAnim vis (Animation as) =
  let f imap =
        let common = EM.intersection imap $ EM.fromSet (const ()) vis
          in if EM.null common then Nothing else Just common
  in Animation $ mapMaybe f as

-- | Attack animation. A part of it also reused for self-damage and healing.
twirlSplash :: (Point, Point) -> Color -> Color -> Animation
twirlSplash poss c1 c2 = Animation $ map (EM.fromList . mzipPairs poss)
  [ (coloredSymbol BrWhite '*', coloredSymbol BrCyan '\'')
  , (coloredSymbol c1      '/', blank)
  , (coloredSymbol c1      '-', blank)
  , (coloredSymbol c1      '\\',blank)
  , (coloredSymbol c1      '|', blank)
  , (coloredSymbol c2      '%', blank)
  , (coloredSymbol c2      '/', blank)
  , (blank                    , blank)
  ]

-- | Attack that hits through a block.
blockHit :: (Point, Point) -> Color -> Color -> Animation
blockHit poss c1 c2 = Animation $ map (EM.fromList . mzipPairs poss)
  [ (coloredSymbol BrWhite '*', coloredSymbol BrCyan '\'')
  , (coloredSymbol BrBlue  '{', blank)
  , (coloredSymbol BrBlue  '{', blank)
  , (coloredSymbol BrBlue  '}', blank)
  , (coloredSymbol BrBlue  '}', blank)
  , (coloredSymbol c1      '|', blank)
  , (coloredSymbol c2      '%', blank)
  , (coloredSymbol c2      '/', blank)
  , (blank                    , blank)
  ]

-- | Attack that is blocked.
blockMiss :: (Point, Point) -> Animation
blockMiss poss = Animation $ map (EM.fromList . mzipPairs poss)
  [ (coloredSymbol BrWhite '*', coloredSymbol BrCyan '\'')
  , (coloredSymbol BrBlue  '{', blank)
  , (coloredSymbol BrBlue  '}', blank)
  , (blank                    , blank)
  ]
<commit_msg>Make the attacker more obvious in the combat animation<commit_after>{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
-- | Screen frames and animations.
module Game.LambdaHack.Client.UI.Animation
  ( SingleFrame(..), decodeLine, encodeLine
  , overlayOverlay
  , Animation, Frames, renderAnim, restrictAnim
  , twirlSplash, blockHit, blockMiss, deathBody, swapPlaces, fadeout
  ) where

import Control.Exception.Assert.Sugar
import Data.Binary
import Data.Bits
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Int (Int32)
import Data.List
import Data.Maybe
import Data.Monoid
import qualified Data.Text as T
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Unboxed as U
import GHC.Generics (Generic)

import Game.LambdaHack.Common.Color
import qualified Game.LambdaHack.Common.Color as Color
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.Msg
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.Random

type ScreenLine = U.Vector Int32

decodeLine :: ScreenLine -> [AttrChar]
decodeLine v = map (toEnum . fromIntegral) $ G.toList v

encodeLine :: [AttrChar] -> ScreenLine
encodeLine l = G.fromList $ map (fromIntegral . fromEnum) l

-- | The data sufficent to draw a single game screen frame.
data SingleFrame = SingleFrame
  { sfLevel  :: ![ScreenLine]  -- ^ screen, from top to bottom, line by line
  , sfTop    :: !Overlay       -- ^ some extra lines to show over the top
  , sfBottom :: ![ScreenLine]  -- ^ some extra lines to show at the bottom
  , sfBlank  :: !Bool          -- ^ display only @sfTop@, on blank screen
  }
  deriving (Eq, Show, Generic)

instance Binary SingleFrame

-- | Overlays the @sfTop@ and @sfBottom@ fields onto the @sfLevel@ field.
-- The resulting frame has empty @sfTop@ and @sfBottom@.
-- To be used by simple frontends that don't display overlays
-- in separate windows/panes/scrolled views.
overlayOverlay :: SingleFrame -> SingleFrame
overlayOverlay sf@SingleFrame{..} =
  let lxsize = xsizeSingleFrame sf
      lysize = ysizeSingleFrame sf
      emptyLine = encodeLine
                  $ replicate lxsize (Color.AttrChar Color.defAttr ' ')
      canvasLength = if sfBlank then lysize + 3 else lysize + 1
      canvas | sfBlank = replicate canvasLength emptyLine
             | otherwise = emptyLine : sfLevel
      topTrunc = map (truncateMsg lxsize) $ overlay sfTop
      topLayer = if length topTrunc <= canvasLength
                 then topTrunc
                 else take (canvasLength - 1) topTrunc
                      ++ ["--a portion of the text trimmed--"]
      addAttr t = map (Color.AttrChar Color.defAttr) (T.unpack t)
      f layerLine canvasLine = encodeLine
        $ addAttr layerLine
          ++ drop (T.length layerLine) (decodeLine canvasLine)
      picture = zipWith f topLayer canvas
      bottomLines = if sfBlank then [] else sfBottom
      newLevel = picture ++ drop (length picture) canvas ++ bottomLines
  in SingleFrame { sfLevel = newLevel
                 , sfTop = emptyOverlay
                 , sfBottom = []
                 , sfBlank }

-- | Animation is a list of frame modifications to play one by one,
-- where each modification if a map from positions to level map symbols.
newtype Animation = Animation [EM.EnumMap Point AttrChar]
  deriving (Eq, Show, Monoid)

-- | Sequences of screen frames, including delays.
type Frames = [Maybe SingleFrame]

xsizeSingleFrame :: SingleFrame -> X
xsizeSingleFrame SingleFrame{sfLevel=[]} = 0
xsizeSingleFrame SingleFrame{sfLevel=line : _} = G.length line

ysizeSingleFrame :: SingleFrame -> X
ysizeSingleFrame SingleFrame{sfLevel} = length sfLevel

-- | Render animations on top of a screen frame.
renderAnim :: X -> Y -> SingleFrame -> Animation -> Frames
renderAnim lxsize lysize basicFrame (Animation anim) =
  let modifyFrame SingleFrame{sfLevel = []} _ =
        assert `failure` (lxsize, lysize, basicFrame, anim)
      modifyFrame SingleFrame{sfLevel = levelOld, ..} am =
        let fLine y lineOld =
              let f l (x, acOld) =
                    let pos = Point x y
                        !ac = fromMaybe acOld $ EM.lookup pos am
                    in ac : l
              in foldl' f [] (zip [lxsize-1,lxsize-2..0] (reverse lineOld))
            sfLevel =  -- fully evaluated inside
              let f l (y, lineOld) = let !line = fLine y lineOld in line : l
              in map encodeLine
                 $ foldl' f [] (zip [lysize-1,lysize-2..0]
                                $ reverse $ map decodeLine levelOld)
        in Just SingleFrame{..}  -- a thunk within Just
  in map (modifyFrame basicFrame) anim

blank :: Maybe AttrChar
blank = Nothing

coloredSymbol :: Color -> Char -> Maybe AttrChar
coloredSymbol color symbol = Just $ AttrChar (Attr color defBG) symbol

mzipPairs :: (Point, Point) -> (Maybe AttrChar, Maybe AttrChar)
          -> [(Point, AttrChar)]
mzipPairs (p1, p2) (mattr1, mattr2) =
  let mzip (pos, mattr) = fmap (\x -> (pos, x)) mattr
  in catMaybes $ if p1 /= p2
                 then [mzip (p1, mattr1), mzip (p2, mattr2)]
                 else -- If actor affects himself, show only the effect,
                      -- not the action.
                      [mzip (p1, mattr1)]

restrictAnim :: ES.EnumSet Point -> Animation -> Animation
restrictAnim vis (Animation as) =
  let f imap =
        let common = EM.intersection imap $ EM.fromSet (const ()) vis
          in if EM.null common then Nothing else Just common
  in Animation $ mapMaybe f as

-- | Attack animation. A part of it also reused for self-damage and healing.
twirlSplash :: (Point, Point) -> Color -> Color -> Animation
twirlSplash poss c1 c2 = Animation $ map (EM.fromList . mzipPairs poss)
  [ (coloredSymbol BrWhite '*', coloredSymbol BrCyan '\'')
  , (coloredSymbol c1      '/', coloredSymbol BrYellow '\'')
  , (coloredSymbol c1      '-', blank)
  , (coloredSymbol c1      '\\',blank)
  , (coloredSymbol c1      '|', blank)
  , (coloredSymbol c2      '%', blank)
  , (coloredSymbol c2      '/', blank)
  , (blank                    , blank)
  ]

-- | Attack that hits through a block.
blockHit :: (Point, Point) -> Color -> Color -> Animation
blockHit poss c1 c2 = Animation $ map (EM.fromList . mzipPairs poss)
  [ (coloredSymbol BrWhite '*', coloredSymbol BrCyan '\'')
  , (coloredSymbol BrBlue  '{', coloredSymbol BrYellow '\'')
  , (coloredSymbol BrBlue  '{', blank)
  , (coloredSymbol BrBlue  '}', blank)
  , (coloredSymbol BrBlue  '}', blank)
  , (coloredSymbol c1      '|', blank)
  , (coloredSymbol c2      '%', blank)
  , (coloredSymbol c2      '/', blank)
  , (blank                    , blank)
  ]

-- | Attack that is blocked.
blockMiss :: (Point, Point) -> Animation
blockMiss poss = Animation $ map (EM.fromList . mzipPairs poss)
  [ (coloredSymbol BrWhite '*', coloredSymbol BrCyan '\'')
  , (coloredSymbol BrBlue  '{', blank)
  , (coloredSymbol BrBlue  '}', blank)
  , (blank                    , blank)
  ]

{'fraction_non_alphanumeric': 0.10309278350515463, 'fraction_numerical': 0.005623242736644799, 'mean_word_length': 2.6708123842286318, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 49, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '114789', 'n_tokens_mistral': 4166, 'n_tokens_neox': 4064, 'n_words': 1394}