{-# 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
        Word32
w <- Rnd Word32
randomWord32
        -- @fromIntegralWrap@ is potentially costly, but arch-independent.
        -- Also, it's fine if it wraps.
        let fadeAttr :: X -> X -> AttrCharW32
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 -> OverlaySpace
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]) ]
        OverlaySpace -> StateT SMGen Identity OverlaySpace
forall a. a -> StateT SMGen Identity a
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
$! (X -> OverlaySpace) -> [X] -> OverlaySpace
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap X -> OverlaySpace
fadeLine [X
0..X
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