{-# 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 (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, 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)

-- | 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 Int
width PreFrame
basicFrame (Animation [OverlaySpace]
anim) =
  let modifyFrame :: OverlaySpace -> PreFrame
      -- Overlay not truncated, because guaranteed within bounds.
      modifyFrame :: OverlaySpace -> PreFrame
modifyFrame OverlaySpace
am = Int -> OverlaySpace -> PreFrame -> PreFrame
overlayFrame Int
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. (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 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 t) -> f (t, t)
mzip (t
pos, 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 (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 t) -> f (t, t)
mzip (t
pos, 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)]

-- | 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 -> Int -> Rnd Animation
fadeout ScreenContent{Int
rwidth :: ScreenContent -> Int
rwidth :: Int
rwidth, Int
rheight :: ScreenContent -> Int
rheight :: Int
rheight} Bool
out Int
step = do
  let xbound :: Int
xbound = Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      ybound :: Int
ybound = Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      margin :: Int
margin = (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rheight) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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 [Int
1..] String
".%&%;:,."
      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
- Int
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
- Int
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
- Int
1  -- @-1@ for asymmetry
            mnx :: Int
mnx = if Int
ndy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
ndx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
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` Int
3
            k :: Int
k | Int
mnx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 Bool -> Bool -> Bool
|| Int
mnx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
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` Int
15 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
11
                Bool -> Bool -> Bool
&& Int
mnx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
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
+ Int
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` Int
30 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
19 = Int
mnx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 Char
' ' 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
- Int
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 Int
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
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
y))
              in [ (Int -> Int -> PointUI
PointUI Int
0 Int
y, (Int -> AttrCharW32) -> [Int] -> AttrString
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> AttrCharW32
fadeAttr Int
y) [Int
0..Int
x1])
                 , (Int -> Int -> PointUI
PointUI (Int
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 [Int
0..Int
ybound]
      fs :: [Int]
fs | Bool
out = [Int
3, Int
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 .. Int
1]
                       [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
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