    {-# LANGUAGE TupleSections #-}
    -- | Screen frames and animations.
    module Game.LambdaHack.Client.UI.Animation
      ( Animation, renderAnim
      , pushAndDelay, twirlSplash, twirlSplashShort, blockHit, blockMiss, subtleHit
      , deathBody, shortDeathBody, actorX, teleport, vanish, swapPlaces, fadeout
    #ifdef EXPOSE_INTERNAL
        -- * Internal operations
      , blank, cSym, mapPosToOffset, mzipSingleton, mzipPairs
    #endif
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import           Data.Bits (xor)
    import qualified Data.EnumMap.Strict as EM
    import           Data.Word (Word32)

    import Game.LambdaHack.Client.UI.Content.Screen
    import Game.LambdaHack.Client.UI.Frame
    import Game.LambdaHack.Client.UI.Overlay
    import Game.LambdaHack.Client.UI.PointUI
    import Game.LambdaHack.Common.Point
    import Game.LambdaHack.Core.Random
    import Game.LambdaHack.Definition.Color

    -- | 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 [OverlaySpace]
      deriving (X -> Animation -> ShowS
    [Animation] -> ShowS
    Animation -> String
    (X -> Animation -> ShowS)
    -> (Animation -> String)
    -> ([Animation] -> ShowS)
    -> Show Animation
    forall a.
    (X -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: X -> Animation -> ShowS
    showsPrec :: X -> Animation -> ShowS
    $cshow :: Animation -> String
    show :: Animation -> String
    $cshowList :: [Animation] -> ShowS
    showList :: [Animation] -> ShowS
    Show, Animation -> Animation -> Bool
    (Animation -> Animation -> Bool)
    -> (Animation -> Animation -> Bool) -> Eq Animation
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Animation -> Animation -> Bool
    == :: Animation -> Animation -> Bool
    $c/= :: Animation -> Animation -> Bool
    /= :: Animation -> Animation -> Bool
    Eq)

    -- | Render animations on top of a screen frame.
    --
    -- Located in this module to keep @Animation@ abstract.
    renderAnim :: Int -> PreFrame -> Animation -> PreFrames
    renderAnim :: X -> PreFrame -> Animation -> PreFrames
    renderAnim X
    width PreFrame
    basicFrame (Animation [OverlaySpace]
    anim) =
      let modifyFrame :: OverlaySpace -> PreFrame
          -- Overlay not truncated, because guaranteed within bounds.
          modifyFrame :: OverlaySpace -> PreFrame
    modifyFrame OverlaySpace
    am = X -> OverlaySpace -> PreFrame -> PreFrame
    overlayFrame X
    width OverlaySpace
    am PreFrame
    basicFrame
          modifyFrames :: OverlaySpace -> OverlaySpace -> Maybe PreFrame
          modifyFrames :: OverlaySpace -> OverlaySpace -> Maybe PreFrame
    modifyFrames OverlaySpace
    am OverlaySpace
    amPrevious =
            if OverlaySpace
    am OverlaySpace -> OverlaySpace -> Bool
    forall a. Eq a => a -> a -> Bool
    == OverlaySpace
    amPrevious then Maybe PreFrame
    forall a. Maybe a
    Nothing else PreFrame -> Maybe PreFrame
    forall a. a -> Maybe a
    Just (PreFrame -> Maybe PreFrame) -> PreFrame -> Maybe PreFrame
    forall a b. (a -> b) -> a -> b
    $ OverlaySpace -> PreFrame
    modifyFrame OverlaySpace
    am
      in PreFrame -> Maybe PreFrame
    forall a. a -> Maybe a
    Just PreFrame
    basicFrame Maybe PreFrame -> PreFrames -> PreFrames
    forall a. a -> [a] -> [a]
    : (OverlaySpace -> OverlaySpace -> Maybe PreFrame)
    -> [OverlaySpace] -> [OverlaySpace] -> PreFrames
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith OverlaySpace -> OverlaySpace -> Maybe PreFrame
    modifyFrames [OverlaySpace]
    anim ([] OverlaySpace -> [OverlaySpace] -> [OverlaySpace]
    forall a. a -> [a] -> [a]
    : [OverlaySpace]
    anim)

    blank :: Maybe AttrCharW32
    blank :: Maybe AttrCharW32
    blank = Maybe AttrCharW32
    forall a. Maybe a
    Nothing

    cSym :: Color -> Char -> Maybe AttrCharW32
    cSym :: Color -> Char -> Maybe AttrCharW32
    cSym Color
    color Char
    symbol = AttrCharW32 -> Maybe AttrCharW32
    forall a. a -> Maybe a
    Just (AttrCharW32 -> Maybe AttrCharW32)
    -> AttrCharW32 -> Maybe AttrCharW32
    forall a b. (a -> b) -> a -> b
    $ Color -> Char -> AttrCharW32
    attrChar2ToW32 Color
    color Char
    symbol

    mapPosToOffset :: (Point, AttrCharW32) -> (PointUI, AttrString)
    mapPosToOffset :: (Point, AttrCharW32) -> (PointUI, AttrString)
    mapPosToOffset (Point
    p, AttrCharW32
    attr) =
      let pUI :: PointUI
    pUI = PointSquare -> PointUI
    squareToUI (PointSquare -> PointUI) -> PointSquare -> PointUI
    forall a b. (a -> b) -> a -> b
    $ Point -> PointSquare
    mapToSquare Point
    p
      in (PointUI
    pUI, [AttrCharW32
    attr])

    mzipSingleton :: Point -> Maybe AttrCharW32 -> OverlaySpace
    mzipSingleton :: Point -> Maybe AttrCharW32 -> OverlaySpace
    mzipSingleton Point
    p1 Maybe AttrCharW32
    mattr1 =
      ((Point, AttrCharW32) -> (PointUI, AttrString))
    -> [(Point, AttrCharW32)] -> OverlaySpace
    forall a b. (a -> b) -> [a] -> [b]
    map (Point, AttrCharW32) -> (PointUI, AttrString)
    mapPosToOffset ([(Point, AttrCharW32)] -> OverlaySpace)
    -> [(Point, AttrCharW32)] -> OverlaySpace
    forall a b. (a -> b) -> a -> b
    $
        let mzip :: (t, f a) -> f (t, a)
    mzip (t
    pos, f a
    mattr) = (a -> (t, a)) -> f a -> f (t, a)
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (t
    pos,) f a
    mattr
        in [Maybe (Point, AttrCharW32)] -> [(Point, AttrCharW32)]
    forall a. [Maybe a] -> [a]
    catMaybes [(Point, Maybe AttrCharW32) -> Maybe (Point, AttrCharW32)
    forall {f :: * -> *} {t} {a}. Functor f => (t, f a) -> f (t, a)
    mzip (Point
    p1, Maybe AttrCharW32
    mattr1)]

    mzipPairs :: (Point, Point) -> (Maybe AttrCharW32, Maybe AttrCharW32)
              -> OverlaySpace
    mzipPairs :: (Point, Point)
    -> (Maybe AttrCharW32, Maybe AttrCharW32) -> OverlaySpace
    mzipPairs (Point
    p1, Point
    p2) (Maybe AttrCharW32
    mattr1, Maybe AttrCharW32
    mattr2) =
      ((Point, AttrCharW32) -> (PointUI, AttrString))
    -> [(Point, AttrCharW32)] -> OverlaySpace
    forall a b. (a -> b) -> [a] -> [b]
    map (Point, AttrCharW32) -> (PointUI, AttrString)
    mapPosToOffset ([(Point, AttrCharW32)] -> OverlaySpace)
    -> [(Point, AttrCharW32)] -> OverlaySpace
    forall a b. (a -> b) -> a -> b
    $
        let mzip :: (t, f a) -> f (t, a)
    mzip (t
    pos, f a
    mattr) = (a -> (t, a)) -> f a -> f (t, a)
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (t
    pos,) f a
    mattr
        in [Maybe (Point, AttrCharW32)] -> [(Point, AttrCharW32)]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe (Point, AttrCharW32)] -> [(Point, AttrCharW32)])
    -> [Maybe (Point, AttrCharW32)] -> [(Point, AttrCharW32)]
    forall a b. (a -> b) -> a -> b
    $ if Point
    p1 Point -> Point -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Point
    p2
                       then [(Point, Maybe AttrCharW32) -> Maybe (Point, AttrCharW32)
    forall {f :: * -> *} {t} {a}. Functor f => (t, f a) -> f (t, a)
    mzip (Point
    p1, Maybe AttrCharW32
    mattr1), (Point, Maybe AttrCharW32) -> Maybe (Point, AttrCharW32)
    forall {f :: * -> *} {t} {a}. Functor f => (t, f a) -> f (t, a)
    mzip (Point
    p2, Maybe AttrCharW32
    mattr2)]
                       else -- If actor affects himself, show only the effect,
                            -- not the action.
                            [(Point, Maybe AttrCharW32) -> Maybe (Point, AttrCharW32)
    forall {f :: * -> *} {t} {a}. Functor f => (t, f a) -> f (t, a)
    mzip (Point
    p1, Maybe AttrCharW32
    mattr1)]

    -- | Empty animation with a frame of delay, to be used to momentarily display
    -- something for the player to see, e.g., the aiming line when swerving it.
    -- Don't use this if there are multi-line messages on the screen,
    -- because the text blinking is going to be distracting.
    pushAndDelay :: Animation
    pushAndDelay :: Animation
    pushAndDelay = [OverlaySpace] -> Animation
    Animation [[]]

    -- | Attack animation. A part of it also reused for self-damage and healing.
    twirlSplash :: (Point, Point) -> Color -> Color -> Animation
    twirlSplash :: (Point, Point) -> Color -> Color -> Animation
    twirlSplash (Point, Point)
    poss Color
    c1 Color
    c2 = [OverlaySpace] -> Animation
    Animation ([OverlaySpace] -> Animation) -> [OverlaySpace] -> Animation
    forall a b. (a -> b) -> a -> b
    $ ((Maybe AttrCharW32, Maybe AttrCharW32) -> OverlaySpace)
    -> [(Maybe AttrCharW32, Maybe AttrCharW32)] -> [OverlaySpace]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Point, Point)
    -> (Maybe AttrCharW32, Maybe AttrCharW32) -> OverlaySpace
    mzipPairs (Point, Point)
    poss)
      [ (Maybe AttrCharW32
    blank           , Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrCyan Char
    '&')
      , (Maybe AttrCharW32
    blank           , Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrCyan Char
    '&')
      , (Maybe AttrCharW32
    blank           , Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    c1      Char
    '\\',Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    c1      Char
    '|', Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrCyan Char
    '&')
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    c1      Char
    '%', Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    c1      Char
    '/', Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    c1      Char
    '-', Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    c1      Char
    '\\',Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    c2      Char
    '|', Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    c2      Char
    '%', Maybe AttrCharW32
    blank)
      ]

    -- | Short attack animation.
    twirlSplashShort :: (Point, Point) -> Color -> Color -> Animation
    twirlSplashShort :: (Point, Point) -> Color -> Color -> Animation
    twirlSplashShort (Point, Point)
    poss Color
    c1 Color
    c2 = [OverlaySpace] -> Animation
    Animation ([OverlaySpace] -> Animation) -> [OverlaySpace] -> Animation
    forall a b. (a -> b) -> a -> b
    $ ((Maybe AttrCharW32, Maybe AttrCharW32) -> OverlaySpace)
    -> [(Maybe AttrCharW32, Maybe AttrCharW32)] -> [OverlaySpace]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Point, Point)
    -> (Maybe AttrCharW32, Maybe AttrCharW32) -> OverlaySpace
    mzipPairs (Point, Point)
    poss)
      [ (Maybe AttrCharW32
    blank           , Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrCyan Char
    '&')
      , (Maybe AttrCharW32
    blank           , Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrCyan Char
    '&')
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    c1      Char
    '\\',Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    c1      Char
    '|', Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrCyan Char
    '&')
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    c2      Char
    '%', Maybe AttrCharW32
    blank)
      ]

    -- | Attack that hits through a block.
    blockHit :: (Point, Point) -> Color -> Color -> Animation
    blockHit :: (Point, Point) -> Color -> Color -> Animation
    blockHit (Point, Point)
    poss Color
    c1 Color
    c2 = [OverlaySpace] -> Animation
    Animation ([OverlaySpace] -> Animation) -> [OverlaySpace] -> Animation
    forall a b. (a -> b) -> a -> b
    $ ((Maybe AttrCharW32, Maybe AttrCharW32) -> OverlaySpace)
    -> [(Maybe AttrCharW32, Maybe AttrCharW32)] -> [OverlaySpace]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Point, Point)
    -> (Maybe AttrCharW32, Maybe AttrCharW32) -> OverlaySpace
    mzipPairs (Point, Point)
    poss)
      [ (Maybe AttrCharW32
    blank           , Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrCyan Char
    '&')
      , (Maybe AttrCharW32
    blank           , Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrCyan Char
    '&')
      , (Maybe AttrCharW32
    blank           , Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrBlue  Char
    '{', Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrBlue  Char
    '{', Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrCyan Char
    '&')
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrBlue  Char
    '{', Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrBlue  Char
    '}', Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrBlue  Char
    '}', Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrBlue  Char
    '}', Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    c1      Char
    '\\',Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    c1      Char
    '|', Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    c1      Char
    '/', Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    c1      Char
    '-', Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    c2      Char
    '\\',Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    c2      Char
    '|', Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    c2      Char
    '/', Maybe AttrCharW32
    blank)
      ]

    -- | Attack that is blocked.
    blockMiss :: (Point, Point) -> Animation
    blockMiss :: (Point, Point) -> Animation
    blockMiss (Point, Point)
    poss = [OverlaySpace] -> Animation
    Animation ([OverlaySpace] -> Animation) -> [OverlaySpace] -> Animation
    forall a b. (a -> b) -> a -> b
    $ ((Maybe AttrCharW32, Maybe AttrCharW32) -> OverlaySpace)
    -> [(Maybe AttrCharW32, Maybe AttrCharW32)] -> [OverlaySpace]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Point, Point)
    -> (Maybe AttrCharW32, Maybe AttrCharW32) -> OverlaySpace
    mzipPairs (Point, Point)
    poss)
      [ (Maybe AttrCharW32
    blank           , Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrCyan Char
    '&')
      , (Maybe AttrCharW32
    blank           , Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrCyan Char
    '&')
      , (Maybe AttrCharW32
    blank           , Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrBlue  Char
    '{', Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrBlue  Char
    '{', Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrCyan Char
    '&')
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrBlue  Char
    '{', Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrBlue  Char
    '{', Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrBlue  Char
    '}', Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    Blue    Char
    '}', Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    Blue    Char
    '}', Maybe AttrCharW32
    blank)
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    Blue    Char
    '}', Maybe AttrCharW32
    blank)
      ]

    -- | Attack that is subtle (e.g., damage dice 0).
    subtleHit :: (Point, Point) -> Animation
    subtleHit :: (Point, Point) -> Animation
    subtleHit (Point, Point)
    poss = [OverlaySpace] -> Animation
    Animation ([OverlaySpace] -> Animation) -> [OverlaySpace] -> Animation
    forall a b. (a -> b) -> a -> b
    $ ((Maybe AttrCharW32, Maybe AttrCharW32) -> OverlaySpace)
    -> [(Maybe AttrCharW32, Maybe AttrCharW32)] -> [OverlaySpace]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Point, Point)
    -> (Maybe AttrCharW32, Maybe AttrCharW32) -> OverlaySpace
    mzipPairs (Point, Point)
    poss)
      [ (Maybe AttrCharW32
    blank           , Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrCyan Char
    '&')
      , (Maybe AttrCharW32
    blank           , Maybe AttrCharW32
    blank)
      , (Maybe AttrCharW32
    blank           , Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrYellow Char
    '&')
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrBlue  Char
    '\\',Maybe AttrCharW32
    blank)
      , (Maybe AttrCharW32
    blank           , Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrYellow Char
    '&')
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrBlue  Char
    '/', Maybe AttrCharW32
    blank)
      , (Maybe AttrCharW32
    blank           , Maybe AttrCharW32
    blank)
      ]

    -- | Death animation for an organic body.
    deathBody :: Point -> Animation
    deathBody :: Point -> Animation
    deathBody Point
    pos = [OverlaySpace] -> Animation
    Animation ([OverlaySpace] -> Animation) -> [OverlaySpace] -> Animation
    forall a b. (a -> b) -> a -> b
    $ (Maybe AttrCharW32 -> OverlaySpace)
    -> [Maybe AttrCharW32] -> [OverlaySpace]
    forall a b. (a -> b) -> [a] -> [b]
    map (Point -> Maybe AttrCharW32 -> OverlaySpace
    mzipSingleton Point
    pos)
      [ Color -> Char -> Maybe AttrCharW32
    cSym Color
    Red Char
    '%'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Red Char
    '-'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Red Char
    '-'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Red Char
    '\\'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Red Char
    '\\'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Red Char
    '|'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Red Char
    '|'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Red Char
    '%'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Red Char
    '%'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Red Char
    '%'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Red Char
    '%'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Red Char
    ';'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Red Char
    ';'
      ]

    -- | Death animation for an organic body, short version (e.g., for enemies).
    shortDeathBody :: Point -> Animation
    shortDeathBody :: Point -> Animation
    shortDeathBody Point
    pos = [OverlaySpace] -> Animation
    Animation ([OverlaySpace] -> Animation) -> [OverlaySpace] -> Animation
    forall a b. (a -> b) -> a -> b
    $ (Maybe AttrCharW32 -> OverlaySpace)
    -> [Maybe AttrCharW32] -> [OverlaySpace]
    forall a b. (a -> b) -> [a] -> [b]
    map (Point -> Maybe AttrCharW32 -> OverlaySpace
    mzipSingleton Point
    pos)
      [ Color -> Char -> Maybe AttrCharW32
    cSym Color
    Red Char
    '%'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Red Char
    '-'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Red Char
    '\\'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Red Char
    '|'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Red Char
    '%'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Red Char
    '%'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Red Char
    '%'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Red Char
    ';'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Red Char
    ','
      ]

    -- | Mark actor location animation.
    actorX :: Point -> Animation
    actorX :: Point -> Animation
    actorX Point
    pos = [OverlaySpace] -> Animation
    Animation ([OverlaySpace] -> Animation) -> [OverlaySpace] -> Animation
    forall a b. (a -> b) -> a -> b
    $ (Maybe AttrCharW32 -> OverlaySpace)
    -> [Maybe AttrCharW32] -> [OverlaySpace]
    forall a b. (a -> b) -> [a] -> [b]
    map (Point -> Maybe AttrCharW32 -> OverlaySpace
    mzipSingleton Point
    pos)
      [ Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrMagenta Char
    'X'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrMagenta Char
    'X'
      , Maybe AttrCharW32
    blank
      , Maybe AttrCharW32
    blank
      ]

    -- | Actor teleport animation.
    teleport :: (Point, Point) -> Animation
    teleport :: (Point, Point) -> Animation
    teleport (Point, Point)
    poss = [OverlaySpace] -> Animation
    Animation ([OverlaySpace] -> Animation) -> [OverlaySpace] -> Animation
    forall a b. (a -> b) -> a -> b
    $ ((Maybe AttrCharW32, Maybe AttrCharW32) -> OverlaySpace)
    -> [(Maybe AttrCharW32, Maybe AttrCharW32)] -> [OverlaySpace]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Point, Point)
    -> (Maybe AttrCharW32, Maybe AttrCharW32) -> OverlaySpace
    mzipPairs (Point, Point)
    poss)
      [ (Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrMagenta Char
    'o', Color -> Char -> Maybe AttrCharW32
    cSym Color
    Magenta   Char
    '.')
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrMagenta Char
    'O', Color -> Char -> Maybe AttrCharW32
    cSym Color
    Magenta   Char
    '.')
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    Magenta   Char
    'o', Color -> Char -> Maybe AttrCharW32
    cSym Color
    Magenta   Char
    'o')
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    Magenta   Char
    '.', Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrMagenta Char
    'O')
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    Magenta   Char
    '.', Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrMagenta Char
    'o')
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    Magenta   Char
    '.', Maybe AttrCharW32
    blank)
      , (Maybe AttrCharW32
    blank             , Maybe AttrCharW32
    blank)
      ]

    -- | Terrain feature vanishing animation.
    vanish :: Point -> Animation
    vanish :: Point -> Animation
    vanish Point
    pos = [OverlaySpace] -> Animation
    Animation ([OverlaySpace] -> Animation) -> [OverlaySpace] -> Animation
    forall a b. (a -> b) -> a -> b
    $ (Maybe AttrCharW32 -> OverlaySpace)
    -> [Maybe AttrCharW32] -> [OverlaySpace]
    forall a b. (a -> b) -> [a] -> [b]
    map (Point -> Maybe AttrCharW32 -> OverlaySpace
    mzipSingleton Point
    pos)
      [ Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrMagenta Char
    'o'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrMagenta Char
    'O'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Magenta   Char
    'o'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Magenta   Char
    '.'
      , Color -> Char -> Maybe AttrCharW32
    cSym Color
    Magenta   Char
    '.'
      , Maybe AttrCharW32
    blank
      ]

    -- | Swap-places animation, both hostile and friendly.
    swapPlaces :: (Point, Point) -> Animation
    swapPlaces :: (Point, Point) -> Animation
    swapPlaces (Point, Point)
    poss = [OverlaySpace] -> Animation
    Animation ([OverlaySpace] -> Animation) -> [OverlaySpace] -> Animation
    forall a b. (a -> b) -> a -> b
    $ ((Maybe AttrCharW32, Maybe AttrCharW32) -> OverlaySpace)
    -> [(Maybe AttrCharW32, Maybe AttrCharW32)] -> [OverlaySpace]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Point, Point)
    -> (Maybe AttrCharW32, Maybe AttrCharW32) -> OverlaySpace
    mzipPairs (Point, Point)
    poss)
      [ (Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrMagenta Char
    'o', Color -> Char -> Maybe AttrCharW32
    cSym Color
    Magenta   Char
    'o')
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrMagenta Char
    'd', Color -> Char -> Maybe AttrCharW32
    cSym Color
    Magenta   Char
    'p')
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrMagenta Char
    '.', Color -> Char -> Maybe AttrCharW32
    cSym Color
    Magenta   Char
    'p')
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    Magenta   Char
    'p', Color -> Char -> Maybe AttrCharW32
    cSym Color
    Magenta   Char
    '.')
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    Magenta   Char
    'p', Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrMagenta Char
    'd')
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    Magenta   Char
    'p', Color -> Char -> Maybe AttrCharW32
    cSym Color
    BrMagenta Char
    'd')
      , (Color -> Char -> Maybe AttrCharW32
    cSym Color
    Magenta   Char
    'o', Maybe AttrCharW32
    blank)
      , (Maybe AttrCharW32
    blank             , Maybe AttrCharW32
    blank)
      ]

    fadeout :: ScreenContent -> Bool -> Int -> Rnd Animation
    fadeout :: ScreenContent -> Bool -> X -> Rnd Animation
    fadeout ScreenContent{X
    rwidth :: X
    rwidth :: ScreenContent -> X
    rwidth, X
    rheight :: X
    rheight :: ScreenContent -> X
    rheight} Bool
    out X
    step = do
      let xbound :: X
    xbound = X
    rwidth X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    1
          ybound :: X
    ybound = X
    rheight X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    1
          margin :: X
    margin = (X
    rwidth X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    2 X -> X -> X
    forall a. Num a => a -> a -> a
    * X
    rheight) X -> X -> X
    forall a. Integral a => a -> a -> a
    `div` X
    2 X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    2
          edge :: EnumMap X Char
    edge = [(X, Char)] -> EnumMap X Char
    forall k a. Enum k => [(k, a)] -> EnumMap k a
    EM.fromDistinctAscList ([(X, Char)] -> EnumMap X Char) -> [(X, Char)] -> EnumMap X Char
    forall a b. (a -> b) -> a -> b
    $ [X] -> String -> [(X, Char)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [X
    1..] String
    ".%&%;:,."
          fadeChar :: Int -> Int -> Int -> Int -> Char
          fadeChar :: X -> X -> X -> X -> Char
    fadeChar !X
    r !X
    n !X
    x !X
    y =
            let d :: X
    d = X
    x X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    2 X -> X -> X
    forall a. Num a => a -> a -> a
    * X
    y
                ndy :: X
    ndy = X
    n X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    d X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    2 X -> X -> X
    forall a. Num a => a -> a -> a
    * X
    ybound
                ndx :: X
    ndx = X
    n X -> X -> X
    forall a. Num a => a -> a -> a
    + X
    d X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    xbound X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    1  -- @-1@ for asymmetry
                mnx :: X
    mnx = if X
    ndy X -> X -> Bool
    forall a. Ord a => a -> a -> Bool
    > X
    0 Bool -> Bool -> Bool
    && X
    ndx X -> X -> Bool
    forall a. Ord a => a -> a -> Bool
    > X
    0
                      then X -> X -> X
    forall a. Ord a => a -> a -> a
    min X
    ndy X
    ndx
                      else X -> X -> X
    forall a. Ord a => a -> a -> a
    max X
    ndy X
    ndx
                v3 :: X
    v3 = (X
    r X -> X -> X
    forall a. Bits a => a -> a -> a
    `xor` (X
    x X -> X -> X
    forall a. Num a => a -> a -> a
    * X
    y)) X -> X -> X
    forall a. Integral a => a -> a -> a
    `mod` X
    3
                k :: X
    k | X
    mnx X -> X -> Bool
    forall a. Ord a => a -> a -> Bool
    < X
    3 Bool -> Bool -> Bool
    || X
    mnx X -> X -> Bool
    forall a. Ord a => a -> a -> Bool
    > X
    10 = X
    mnx
                  | (X -> X -> X
    forall a. Ord a => a -> a -> a
    min X
    x (X
    xbound X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    x X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    y) X -> X -> X
    forall a. Num a => a -> a -> a
    + X
    n X -> X -> X
    forall a. Num a => a -> a -> a
    + X
    v3) X -> X -> X
    forall a. Integral a => a -> a -> a
    `mod` X
    15 X -> X -> Bool
    forall a. Ord a => a -> a -> Bool
    < X
    11
                    Bool -> Bool -> Bool
    && X
    mnx X -> X -> Bool
    forall a. Ord a => a -> a -> Bool
    > X
    6 = X
    mnx X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    v3
                  | (X
    x X -> X -> X
    forall a. Num a => a -> a -> a
    + X
    3 X -> X -> X
    forall a. Num a => a -> a -> a
    * X
    y X -> X -> X
    forall a. Num a => a -> a -> a
    + X
    v3) X -> X -> X
    forall a. Integral a => a -> a -> a
    `mod` X
    30 X -> X -> Bool
    forall a. Ord a => a -> a -> Bool
    < X
    19 = X
    mnx X -> X -> X
    forall a. Num a => a -> a -> a
    + X
    1
                  | Bool
    otherwise = X
    mnx
            in Char -> X -> EnumMap X Char -> Char
    forall k a. Enum k => a -> k -> EnumMap k a -> a
    EM.findWithDefault Char
    ' ' X
    k EnumMap X Char
    edge
          rollFrame :: X -> StateT SMGen Identity OverlaySpace
    rollFrame !X
    n = do
            w <- Rnd Word32
    randomWord32
            -- @fromIntegralWrap@ is potentially costly, but arch-independent.
            -- Also, it's fine if it wraps.
            let fadeAttr !X
    y !X
    x = Char -> AttrCharW32
    attrChar1ToW32 (Char -> AttrCharW32) -> Char -> AttrCharW32
    forall a b. (a -> b) -> a -> b
    $
                  X -> X -> X -> X -> Char
    fadeChar ((Word32 -> X
    forall a b. (Integral a, Num b) => a -> b
    fromIntegralWrap :: Word32 -> Int) Word32
    w) X
    n X
    x X
    y
                fadeLine !X
    y =
                  let x1 :: Int
                      {-# INLINE x1 #-}
                      x1 :: X
    x1 = X -> X -> X
    forall a. Ord a => a -> a -> a
    min X
    xbound (X
    n X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    2 X -> X -> X
    forall a. Num a => a -> a -> a
    * (X
    ybound X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    y))
                      x2 :: Int
                      {-# INLINE x2 #-}
                      x2 :: X
    x2 = X -> X -> X
    forall a. Ord a => a -> a -> a
    max X
    0 (X
    xbound X -> X -> X
    forall a. Num a => a -> a -> a
    - (X
    n X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    2 X -> X -> X
    forall a. Num a => a -> a -> a
    * X
    y))
                  in [ (X -> X -> PointUI
    PointUI X
    0 X
    y, (X -> AttrCharW32) -> [X] -> AttrString
    forall a b. (a -> b) -> [a] -> [b]
    map (X -> X -> AttrCharW32
    fadeAttr X
    y) [X
    0..X
    x1])
                     , (X -> X -> PointUI
    PointUI (X
    2 X -> X -> X
    forall a. Num a => a -> a -> a
    * X
    x2) X
    y, (X -> AttrCharW32) -> [X] -> AttrString
    forall a b. (a -> b) -> [a] -> [b]
    map (X -> X -> AttrCharW32
    fadeAttr X
    y) [X
    x2..X
    xbound]) ]
            return $! concatMap fadeLine [0..ybound]
          fs :: [X]
    fs | Bool
    out = [X
    3, X
    3 X -> X -> X
    forall a. Num a => a -> a -> a
    + X
    step .. X
    rwidth X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    margin]
             | Bool
    otherwise = [X
    rwidth X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    margin, X
    rwidth X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    margin X -> X -> X
    forall a. Num a => a -> a -> a
    - X
    step .. X
    1]
                           [X] -> [X] -> [X]
    forall a. [a] -> [a] -> [a]
    ++ [X
    0]  -- no remnants of fadein onscreen, in case of lag
      [OverlaySpace] -> Animation
    Animation ([OverlaySpace] -> Animation)
    -> StateT SMGen Identity [OverlaySpace] -> Rnd Animation
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (X -> StateT SMGen Identity OverlaySpace)
    -> [X] -> StateT SMGen Identity [OverlaySpace]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM X -> StateT SMGen Identity OverlaySpace
    rollFrame [X]
    fs