{-# 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 (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 :: Int -> PreFrame -> Animation -> PreFrames
renderAnim :: Int -> PreFrame -> Animation -> PreFrames
renderAnim width :: Int
width basicFrame :: PreFrame
basicFrame (Animation anim :: [OverlaySpace]
anim) =
  let modifyFrame :: OverlaySpace -> PreFrame
      -- Overlay not truncated, because guaranteed within bounds.
      modifyFrame :: OverlaySpace -> PreFrame
modifyFrame am :: OverlaySpace
am = Int -> OverlaySpace -> PreFrame -> PreFrame
overlayFrame Int
width OverlaySpace
am PreFrame
basicFrame
      modifyFrames :: (OverlaySpace, OverlaySpace) -> Maybe PreFrame
      modifyFrames :: (OverlaySpace, OverlaySpace) -> Maybe PreFrame
modifyFrames (am :: OverlaySpace
am, amPrevious :: 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. (a -> b) -> [a] -> [b]
map (OverlaySpace, OverlaySpace) -> Maybe PreFrame
modifyFrames ([OverlaySpace] -> [OverlaySpace] -> [(OverlaySpace, OverlaySpace)]
forall a b. [a] -> [b] -> [(a, b)]
zip [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
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 :: (Point, AttrCharW32) -> (PointUI, AttrString)
mapPosToOffset :: (Point, AttrCharW32) -> (PointUI, AttrString)
mapPosToOffset (p :: Point
p, attr :: 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 p1 :: Point
p1 mattr1 :: 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 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 :: (Point, Point) -> (Maybe AttrCharW32, Maybe AttrCharW32)
          -> OverlaySpace
mzipPairs :: (Point, Point)
-> (Maybe AttrCharW32, Maybe AttrCharW32) -> OverlaySpace
mzipPairs (p1 :: Point
p1, p2 :: Point
p2) (mattr1 :: Maybe AttrCharW32
mattr1, mattr2 :: 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 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 = [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 poss :: (Point, Point)
poss c1 :: Color
c1 c2 :: 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 '&')
  , (Maybe AttrCharW32
blank           , Color -> Char -> Maybe AttrCharW32
cSym Color
BrCyan '&')
  , (Maybe AttrCharW32
blank           , Maybe AttrCharW32
blank)
  , (Color -> Char -> Maybe AttrCharW32
cSym Color
c1      '\\',Maybe AttrCharW32
blank)
  , (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)
  ]

-- | Short attack animation.
twirlSplashShort :: (Point, Point) -> Color -> Color -> Animation
twirlSplashShort :: (Point, Point) -> Color -> Color -> Animation
twirlSplashShort poss :: (Point, Point)
poss c1 :: Color
c1 c2 :: 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 '&')
  , (Maybe AttrCharW32
blank           , Color -> Char -> Maybe AttrCharW32
cSym Color
BrCyan '&')
  , (Color -> Char -> Maybe AttrCharW32
cSym Color
c1      '\\',Maybe AttrCharW32
blank)
  , (Color -> Char -> Maybe AttrCharW32
cSym Color
c1      '|', Color -> Char -> Maybe AttrCharW32
cSym Color
BrCyan '&')
  , (Color -> Char -> Maybe AttrCharW32
cSym Color
c2      '%', Maybe AttrCharW32
blank)
  ]

-- | Attack that hits through a block.
blockHit :: (Point, Point) -> Color -> Color -> Animation
blockHit :: (Point, Point) -> Color -> Color -> Animation
blockHit poss :: (Point, Point)
poss c1 :: Color
c1 c2 :: 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 '&')
  , (Maybe AttrCharW32
blank           , Color -> Char -> Maybe AttrCharW32
cSym Color
BrCyan '&')
  , (Maybe AttrCharW32
blank           , Maybe AttrCharW32
blank)
  , (Color -> Char -> Maybe AttrCharW32
cSym Color
BrBlue  '{', Maybe AttrCharW32
blank)
  , (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
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 :: (Point, Point) -> Animation
blockMiss :: (Point, Point) -> Animation
blockMiss poss :: (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 '&')
  , (Maybe AttrCharW32
blank           , Color -> Char -> Maybe AttrCharW32
cSym Color
BrCyan '&')
  , (Maybe AttrCharW32
blank           , Maybe AttrCharW32
blank)
  , (Color -> Char -> Maybe AttrCharW32
cSym Color
BrBlue  '{', Maybe AttrCharW32
blank)
  , (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)
  , (Color -> Char -> Maybe AttrCharW32
cSym Color
Blue    '}', Maybe AttrCharW32
blank)
  ]

-- | Attack that is subtle (e.g., damage dice 0).
subtleHit :: (Point, Point) -> Animation
subtleHit :: (Point, Point) -> Animation
subtleHit poss :: (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 '&')
  , (Maybe AttrCharW32
blank           , Maybe AttrCharW32
blank)
  , (Maybe AttrCharW32
blank           , Color -> Char -> Maybe AttrCharW32
cSym Color
BrYellow '&')
  , (Color -> Char -> Maybe AttrCharW32
cSym Color
BrBlue  '\\',Maybe AttrCharW32
blank)
  , (Maybe AttrCharW32
blank           , Color -> Char -> Maybe AttrCharW32
cSym Color
BrYellow '&')
  , (Color -> Char -> Maybe AttrCharW32
cSym Color
BrBlue  '/', Maybe AttrCharW32
blank)
  , (Maybe AttrCharW32
blank           , Maybe AttrCharW32
blank)
  ]

-- | Death animation for an organic body.
deathBody :: Point -> Animation
deathBody :: Point -> Animation
deathBody pos :: 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 '%'
  , 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 :: Point -> Animation
shortDeathBody :: Point -> Animation
shortDeathBody pos :: 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 '%'
  , 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 :: Point -> Animation
actorX :: Point -> Animation
actorX pos :: 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 'X'
  , Color -> Char -> Maybe AttrCharW32
cSym Color
BrMagenta 'X'
  , Maybe AttrCharW32
blank
  , Maybe AttrCharW32
blank
  ]

-- | Actor teleport animation.
teleport :: (Point, Point) -> Animation
teleport :: (Point, Point) -> Animation
teleport poss :: (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 '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)
  ]

-- | Terrain feature vanishing animation.
vanish :: Point -> Animation
vanish :: Point -> Animation
vanish pos :: 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 'o'
  , Color -> Char -> Maybe AttrCharW32
cSym Color
BrMagenta 'O'
  , Color -> Char -> Maybe AttrCharW32
cSym Color
Magenta   'o'
  , Color -> Char -> Maybe AttrCharW32
cSym Color
Magenta   '.'
  , Color -> Char -> Maybe AttrCharW32
cSym Color
Magenta   '.'
  , Maybe AttrCharW32
blank
  ]

-- | Swap-places animation, both hostile and friendly.
swapPlaces :: (Point, Point) -> Animation
swapPlaces :: (Point, Point) -> Animation
swapPlaces poss :: (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 '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 :: ScreenContent -> Int
rwidth :: 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 -> 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 SMGen Identity OverlaySpace
rollFrame !Int
n = do
        Word32
w <- Rnd Word32
randomWord32
        -- @fromIntegralWrap@ is potentially costly, but arch-independent.
        -- Also, it's fine if it wraps.
        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 ((Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegralWrap :: Word32 -> Int) Word32
w) Int
n Int
x Int
y
            fadeLine :: Int -> OverlaySpace
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 -> Int -> PointUI
PointUI 0 Int
y, (Int -> AttrCharW32) -> [Int] -> AttrString
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> AttrCharW32
fadeAttr Int
y) [0..Int
x1])
                 , (Int -> Int -> PointUI
PointUI (2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
x2) Int
y, (Int -> AttrCharW32) -> [Int] -> AttrString
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> AttrCharW32
fadeAttr Int
y) [Int
x2..Int
xbound]) ]
        OverlaySpace -> StateT SMGen Identity OverlaySpace
forall (m :: * -> *) a. Monad m => a -> m a
return (OverlaySpace -> StateT SMGen Identity OverlaySpace)
-> OverlaySpace -> StateT SMGen Identity OverlaySpace
forall a b. (a -> b) -> a -> b
$! (Int -> OverlaySpace) -> [Int] -> OverlaySpace
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int -> OverlaySpace
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
  [OverlaySpace] -> Animation
Animation ([OverlaySpace] -> Animation)
-> StateT SMGen Identity [OverlaySpace] -> Rnd Animation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> StateT SMGen Identity OverlaySpace)
-> [Int] -> StateT SMGen Identity [OverlaySpace]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int -> StateT SMGen Identity OverlaySpace
rollFrame [Int]
fs