{-# LANGUAGE TupleSections #-}
module Game.LambdaHack.Client.UI.Animation
( Animation, renderAnim
, pushAndDelay, twirlSplash, blockHit, blockMiss, subtleHit
, deathBody, shortDeathBody, actorX, teleport, swapPlaces, fadeout
#ifdef EXPOSE_INTERNAL
, 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
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)
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
[(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 [[]]
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)
]
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)
]
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)
]
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 '\''
]
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 ';'
]
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 ','
]
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
]
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)
]
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
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]
[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