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

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Bits
import qualified Data.EnumMap.Strict as EM

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

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

-- | Render animations on top of a screen frame.
--
-- Located in this module to keep @Animation@ abstract.
renderAnim :: PreFrame -> Animation -> PreFrames
renderAnim :: PreFrame -> Animation -> PreFrames
renderAnim basicFrame :: PreFrame
basicFrame (Animation anim :: [IntOverlay]
anim) =
  let modifyFrame :: IntOverlay -> PreFrame
      modifyFrame :: IntOverlay -> PreFrame
modifyFrame am :: IntOverlay
am = IntOverlay -> PreFrame -> PreFrame
overlayFrame IntOverlay
am PreFrame
basicFrame
      modifyFrames :: (IntOverlay, IntOverlay) -> Maybe PreFrame
      modifyFrames :: (IntOverlay, IntOverlay) -> Maybe PreFrame
modifyFrames (am :: IntOverlay
am, amPrevious :: IntOverlay
amPrevious) =
        if IntOverlay
am IntOverlay -> IntOverlay -> Bool
forall a. Eq a => a -> a -> Bool
== IntOverlay
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
$ IntOverlay -> PreFrame
modifyFrame IntOverlay
am
  in PreFrame -> Maybe PreFrame
forall a. a -> Maybe a
Just PreFrame
basicFrame Maybe PreFrame -> PreFrames -> PreFrames
forall a. a -> [a] -> [a]
: ((IntOverlay, IntOverlay) -> Maybe PreFrame)
-> [(IntOverlay, IntOverlay)] -> PreFrames
forall a b. (a -> b) -> [a] -> [b]
map (IntOverlay, IntOverlay) -> Maybe PreFrame
modifyFrames ([IntOverlay] -> [IntOverlay] -> [(IntOverlay, IntOverlay)]
forall a b. [a] -> [b] -> [(a, b)]
zip [IntOverlay]
anim ([] IntOverlay -> [IntOverlay] -> [IntOverlay]
forall a. a -> [a] -> [a]
: [IntOverlay]
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
color symbol :: 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 :: ScreenContent -> (Point, AttrCharW32) -> (Int, [AttrCharW32])
mapPosToOffset :: ScreenContent -> (Point, AttrCharW32) -> (Int, [AttrCharW32])
mapPosToOffset ScreenContent{Int
rwidth :: ScreenContent -> Int
rwidth :: Int
rwidth} (Point{..}, attr :: AttrCharW32
attr) =
  ((Int
py Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
px, [AttrCharW32
attr])

mzipSingleton :: ScreenContent -> Point -> Maybe AttrCharW32 -> IntOverlay
mzipSingleton :: ScreenContent -> Point -> Maybe AttrCharW32 -> IntOverlay
mzipSingleton coscreen :: ScreenContent
coscreen p1 :: Point
p1 mattr1 :: Maybe AttrCharW32
mattr1 = ((Point, AttrCharW32) -> (Int, [AttrCharW32]))
-> [(Point, AttrCharW32)] -> IntOverlay
forall a b. (a -> b) -> [a] -> [b]
map (ScreenContent -> (Point, AttrCharW32) -> (Int, [AttrCharW32])
mapPosToOffset ScreenContent
coscreen) ([(Point, AttrCharW32)] -> IntOverlay)
-> [(Point, AttrCharW32)] -> IntOverlay
forall a b. (a -> b) -> a -> b
$
  let mzip :: (t, f t) -> f (t, t)
mzip (pos :: t
pos, mattr :: f t
mattr) = (t -> (t, t)) -> f t -> f (t, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t
pos,) f t
mattr
  in [Maybe (Point, AttrCharW32)] -> [(Point, AttrCharW32)]
forall a. [Maybe a] -> [a]
catMaybes [(Point, Maybe AttrCharW32) -> Maybe (Point, AttrCharW32)
forall (f :: * -> *) t t. Functor f => (t, f t) -> f (t, t)
mzip (Point
p1, Maybe AttrCharW32
mattr1)]

mzipPairs :: ScreenContent -> (Point, Point) -> (Maybe AttrCharW32, Maybe AttrCharW32)
          -> IntOverlay
mzipPairs :: ScreenContent
-> (Point, Point)
-> (Maybe AttrCharW32, Maybe AttrCharW32)
-> IntOverlay
mzipPairs coscreen :: ScreenContent
coscreen (p1 :: Point
p1, p2 :: Point
p2) (mattr1 :: Maybe AttrCharW32
mattr1, mattr2 :: Maybe AttrCharW32
mattr2) = ((Point, AttrCharW32) -> (Int, [AttrCharW32]))
-> [(Point, AttrCharW32)] -> IntOverlay
forall a b. (a -> b) -> [a] -> [b]
map (ScreenContent -> (Point, AttrCharW32) -> (Int, [AttrCharW32])
mapPosToOffset ScreenContent
coscreen) ([(Point, AttrCharW32)] -> IntOverlay)
-> [(Point, AttrCharW32)] -> IntOverlay
forall a b. (a -> b) -> a -> b
$
  let mzip :: (t, f t) -> f (t, t)
mzip (pos :: t
pos, mattr :: f t
mattr) = (t -> (t, t)) -> f t -> f (t, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t
pos,) f t
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 t. Functor f => (t, f t) -> f (t, t)
mzip (Point
p1, Maybe AttrCharW32
mattr1), (Point, Maybe AttrCharW32) -> Maybe (Point, AttrCharW32)
forall (f :: * -> *) t t. Functor f => (t, f t) -> f (t, t)
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 t. Functor f => (t, f t) -> f (t, t)
mzip (Point
p1, Maybe AttrCharW32
mattr1)]

pushAndDelay :: Animation
pushAndDelay :: Animation
pushAndDelay = [IntOverlay] -> Animation
Animation [[]]

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

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

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

-- | Attack that is subtle (e.g., damage dice 0).
subtleHit :: ScreenContent -> Point -> Animation
subtleHit :: ScreenContent -> Point -> Animation
subtleHit coscreen :: ScreenContent
coscreen pos :: Point
pos = [IntOverlay] -> Animation
Animation ([IntOverlay] -> Animation) -> [IntOverlay] -> Animation
forall a b. (a -> b) -> a -> b
$ (Maybe AttrCharW32 -> IntOverlay)
-> [Maybe AttrCharW32] -> [IntOverlay]
forall a b. (a -> b) -> [a] -> [b]
map (ScreenContent -> Point -> Maybe AttrCharW32 -> IntOverlay
mzipSingleton ScreenContent
coscreen Point
pos)
  [ Color -> Char -> Maybe AttrCharW32
cSym Color
BrCyan '\''
  , Color -> Char -> Maybe AttrCharW32
cSym Color
BrYellow '\''
  , Color -> Char -> Maybe AttrCharW32
cSym Color
BrYellow '^'
  , Color -> Char -> Maybe AttrCharW32
cSym Color
BrCyan '^'
  , Color -> Char -> Maybe AttrCharW32
cSym Color
BrCyan '\''
  ]

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

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

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

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

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

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