Selkie.git | t/ | 93-tween.rakutest
use Test;
use lib 'lib';
use Selkie::Alpha;
use Selkie::Style;
use Selkie::Tween;
=begin pod
The tween primitives: the easing curves, the two interpolators, and
C<Tween>'s clock.
Everything here is deterministic — every time-taking method takes an
explicit C<Instant>, so not one of these tests sleeps or looks at the
wall clock. That is the whole reason the C<Instant> parameters exist.
The load-bearing test is B<a single huge jump lands exactly on 1.0>.
Selkie's idle ladder drops the loop to 4 Hz after two minutes idle, and
a store handler can stall a frame for far longer than that, so a 150 ms
tween being sampled exactly once — long after it should have ended — is
a routine occurrence rather than a pathological one. Frame-count-driven
animation (C<ProgressBar.tick>) mangles that case; wall-clock driving is
what makes it land.
=end pod
plan 19;
my constant TOL = 1e-9;
# A recorder for on-update / on-complete traffic, so each test can
# assert on what the callbacks actually saw rather than on side effects.
class Recorder {
has @.updates;
has Int $.completes = 0;
method on-update() { -> Num $v { @!updates.push($v) } }
# sub {}, not a bare block: a bare block in statement position is
# executed on the spot rather than returned.
method on-complete() { sub { $!completes++ } }
method last() { @!updates ?? @!updates[*-1] !! Num }
}
subtest 'every easing maps the endpoints exactly' => {
plan 8;
for EaseLinear, EaseInQuad, EaseOutQuad, EaseInOutQuad -> $e {
is-approx ease($e, 0e0), 0e0, TOL, "$e starts at 0";
is-approx ease($e, 1e0), 1e0, TOL, "$e ends at 1";
}
};
subtest 'every easing is monotonically non-decreasing and stays in range' => {
plan 8;
for EaseLinear, EaseInQuad, EaseOutQuad, EaseInOutQuad -> $e {
my @v = (0..40).map({ ease($e, $_ / 40) });
# Parenthesised: an unparenthesised reduction would swallow the
# test description into the list it is reducing.
ok ([<=] @v), "$e never goes backwards";
ok (@v.all >= -TOL && @v.all <= 1e0 + TOL), "$e stays inside 0..1";
}
};
subtest 'the curves have the shapes their names claim' => {
plan 7;
is-approx ease(EaseLinear, 0.25e0), 0.25e0, TOL, 'linear is the identity';
is-approx ease(EaseInQuad, 0.5e0), 0.25e0, TOL, 'in-quad is behind at the midpoint';
is-approx ease(EaseOutQuad, 0.5e0), 0.75e0, TOL, 'out-quad is ahead at the midpoint';
is-approx ease(EaseInOutQuad, 0.5e0), 0.5e0, TOL,
'in-out-quad halves meet cleanly at the midpoint';
is-approx ease(EaseInOutQuad, 0.25e0), 0.125e0, TOL, 'in-out-quad accelerates first';
is-approx ease(EaseInOutQuad, 0.75e0), 0.875e0, TOL, 'in-out-quad decelerates last';
# in-quad and out-quad are reflections of each other about (0.5, 0.5).
is-approx ease(EaseInQuad, 0.3e0), 1e0 - ease(EaseOutQuad, 0.7e0), TOL,
'in-quad and out-quad are point reflections';
};
subtest 'ease clamps rather than extrapolating' => {
plan 4;
is-approx ease(EaseOutQuad, -5e0), 0e0, TOL, 'negative t clamps to the start';
is-approx ease(EaseOutQuad, 12e0), 1e0, TOL, 'past-the-end t clamps to the end';
is-approx ease(EaseInQuad, 0), 0e0, TOL, 'an Int coerces';
is-approx ease(EaseInQuad, 1/2), 0.25e0, TOL, 'a Rat coerces';
};
subtest 'lerp-rgb hits the endpoints exactly' => {
plan 4;
is lerp-rgb(0x123456, 0xABCDEF, 0e0), 0x123456, 't = 0 is the from colour, bit for bit';
is lerp-rgb(0x123456, 0xABCDEF, 1e0), 0xABCDEF, 't = 1 is the to colour, bit for bit';
is lerp-rgb(0x123456, 0xABCDEF, -3e0), 0x123456, 'negative t clamps to from';
is lerp-rgb(0x123456, 0xABCDEF, 9e0), 0xABCDEF, 'past-the-end t clamps to to';
};
subtest 'lerp-rgb interpolates each component independently' => {
plan 4;
is lerp-rgb(0x000000, 0xFFFFFF, 0.5e0), 0x808080,
'black to white at the midpoint is mid grey';
is lerp-rgb(0xFF0000, 0x0000FF, 0.5e0), 0x800080,
'red to blue crosses through purple, green untouched';
is lerp-rgb(0x010203, 0x040506, 1/3), 0x020304,
'a third of the way is exact when the arithmetic is exact';
is lerp-rgb(0x00FF00, 0x00FF00, 0.37e0), 0x00FF00,
'interpolating a colour with itself is a fixed point';
};
subtest 'lerp-rgb rounds half up and ignores bits above the low 24' => {
plan 4;
# 127.5 in both directions: round-half-up makes the midpoint of a
# ramp and of its reverse the same colour, which is what stops a
# fade-in and its matching fade-out from disagreeing by one step.
is lerp-rgb(0x000000, 0xFF0000, 0.5e0), 0x800000, 'upward 127.5 rounds to 0x80';
is lerp-rgb(0xFF0000, 0x000000, 0.5e0), 0x800000, 'downward 127.5 rounds to 0x80';
is lerp-rgb(0x000000, 0x0000FF, 0.999e0), 0x0000FF,
'very-nearly-1 rounds up to the endpoint';
is lerp-rgb(0xAA112233, 0xAA112233, 0.5e0), 0x112233,
'high bits are masked off on input and never set on output';
};
subtest 'lerp-style ramps the colours' => {
plan 3;
my $a = Selkie::Style.new(fg => 0x000000, bg => 0x102030);
my $b = Selkie::Style.new(fg => 0xFFFFFF, bg => 0x506070);
is lerp-style($a, $b, 0e0).fg, 0x000000, 'fg at t = 0 is the from colour';
is lerp-style($a, $b, 1e0).bg, 0x506070, 'bg at t = 1 is the to colour';
is lerp-style($a, $b, 0.5e0).bg, 0x304050, 'bg ramps componentwise';
};
subtest 'lerp-style snaps the boolean flags at the midpoint' => {
plan 10;
my $off = Selkie::Style.new(fg => 0x000000);
my $on = Selkie::Style.new(
fg => 0xFFFFFF,
bold => True, italic => True, underline => True, strikethrough => True,
);
for <bold italic underline strikethrough> -> $flag {
nok lerp-style($off, $on, 0.49e0)."$flag"(), "$flag is still off just below 0.5";
ok lerp-style($off, $on, 0.5e0)."$flag"(), "$flag is on at exactly 0.5";
}
ok lerp-style($off, $on, 1e0).bold, 'flags stay on past the midpoint';
nok lerp-style($on, $off, 0.5e0).bold, 'snapping works in the other direction too';
};
subtest 'lerp-style snaps the alpha modes at the midpoint' => {
plan 5;
# Alpha is two bits with nothing in between, so there is no
# intermediate state to land on — see Selkie::Alpha.
my $opaque = Selkie::Style.new(
fg => 0x000000, bg => 0x000000,
fg-alpha => AlphaOpaque, bg-alpha => AlphaOpaque,
);
my $blend = Selkie::Style.new(
fg => 0xFFFFFF, bg => 0xFFFFFF,
fg-alpha => AlphaBlend, bg-alpha => AlphaBlend,
);
is lerp-style($opaque, $blend, 0.49e0).fg-alpha, AlphaOpaque,
'fg-alpha holds the from mode below the midpoint';
is lerp-style($opaque, $blend, 0.5e0).fg-alpha, AlphaBlend,
'fg-alpha switches at exactly 0.5';
is lerp-style($opaque, $blend, 0.49e0).bg-alpha, AlphaOpaque,
'bg-alpha holds the from mode below the midpoint';
is lerp-style($opaque, $blend, 0.5e0).bg-alpha, AlphaBlend,
'bg-alpha switches at exactly 0.5';
# ...while the colours ramp right through the switchover.
is lerp-style($opaque, $blend, 0.49e0).fg, 0x7D7D7D,
'the colour keeps ramping either side of the alpha snap';
};
subtest 'lerp-style handles a colour defined on only one side' => {
plan 6;
# There is no RGB value for "inherit", so a mixed pair has no ramp
# to run and switches once, at the midpoint, exactly like a flag.
my $bare = Selkie::Style.new(fg => 0xFF0000); # bg inherits
my $solid = Selkie::Style.new(fg => 0x00FF00, bg => 0x000000);
nok lerp-style($bare, $solid, 0.49e0).bg.defined,
'bg is still inheriting just below the midpoint';
is lerp-style($bare, $solid, 0.5e0).bg, 0x000000,
'bg switches to the defined colour at 0.5';
is lerp-style($solid, $bare, 0.49e0).bg, 0x000000,
'and back the other way below the midpoint';
nok lerp-style($solid, $bare, 0.5e0).bg.defined,
'switching to undefined works too';
nok lerp-style($bare, $bare, 0.5e0).bg.defined,
'undefined on both sides stays undefined throughout';
is lerp-style($bare, $solid, 0.5e0).fg, 0x808000,
'the fully-defined channel still ramps in the same call';
};
subtest 'tick interpolates on wall-clock elapsed seconds' => {
plan 8;
my $r = Recorder.new;
my $t0 = Instant.from-posix(1_000);
my $tw = Tween.new(
duration => 1, on-update => $r.on-update, on-complete => $r.on-complete,
);
nok $tw.tick($t0), 'ticking before start does nothing';
is $r.updates.elems, 0, 'and fires no update';
$tw.start($t0);
ok $tw.running, 'start arms the tween';
ok $tw.tick($t0), 'the first tick updates';
is-approx $r.updates[0], 0e0, TOL, 'the first tick sits at the start value';
$tw.tick($t0 + 0.25);
is-approx $r.updates[1], 0.25e0, TOL, 'a quarter of the duration is a quarter along';
$tw.tick($t0 + 0.75);
is-approx $r.updates[2], 0.75e0, TOL, 'three quarters along';
is $r.completes, 0, 'nothing has completed yet';
};
subtest 'the end boundary fires exactly once, however far past it we land' => {
plan 12;
my $t0 = Instant.from-posix(2_000);
# Exactly on the end.
my $r1 = Recorder.new;
my $tw1 = Tween.new(
duration => 0.15, on-update => $r1.on-update, on-complete => $r1.on-complete,
).start($t0);
ok $tw1.tick($t0 + 0.15), 'the tick that reaches the end still updates';
is-approx $r1.last, 1e0, TOL, 'landing exactly on the end gives 1.0';
is $r1.completes, 1, 'on-complete fired';
nok $tw1.running, 'and the tween stopped running';
ok $tw1.done, 'and is marked done';
nok $tw1.tick($t0 + 0.16), 'a further tick is a no-op';
is $r1.completes, 1, 'on-complete did not fire twice';
# The 4 Hz worst case: one single sample, 250 ms into a 150 ms
# tween, is the only frame this animation ever gets.
my $r2 = Recorder.new;
my $tw2 = Tween.new(
duration => 0.15, on-update => $r2.on-update, on-complete => $r2.on-complete,
).start($t0);
ok $tw2.tick($t0 + 0.25), 'the single deep-idle frame updates';
is $r2.updates.elems, 1, 'exactly one update';
is-approx $r2.last, 1e0, TOL, 'which lands exactly on 1.0, not past it';
is $r2.completes, 1, 'and completes exactly once';
# Absurdly late: the process was stopped for an hour.
my $r3 = Recorder.new;
my $tw3 = Tween.new(
duration => 0.15, on-update => $r3.on-update, on-complete => $r3.on-complete,
).start($t0);
$tw3.tick($t0 + 3_600);
is-approx $r3.last, 1e0, TOL, 'an hour late still lands on 1.0';
};
subtest 'progress reports the raw clamped position' => {
plan 5;
my $t0 = Instant.from-posix(3_000);
my $tw = Tween.new(
duration => 2, easing => EaseInQuad, on-update => -> Num $ { },
);
is-approx $tw.progress, 0e0, TOL, 'a fresh tween is at 0';
$tw.start($t0);
$tw.tick($t0 + 0.5);
is-approx $tw.progress, 0.25e0, TOL, 'progress is raw, not eased';
$tw.tick($t0 - 10);
is-approx $tw.progress, 0e0, TOL, 'a clock that went backwards clamps to 0';
$tw.tick($t0 + 1_000);
is-approx $tw.progress, 1e0, TOL, 'far past the end clamps to 1';
ok $tw.done, 'and the clamped end still completes the tween';
};
subtest 'cancel stops the tween without completing it' => {
plan 6;
my $r = Recorder.new;
my $t0 = Instant.from-posix(4_000);
my $tw = Tween.new(
duration => 1, on-update => $r.on-update, on-complete => $r.on-complete,
).start($t0);
$tw.tick($t0 + 0.4);
$tw.cancel;
nok $tw.running, 'cancel stops the tween';
nok $tw.done, 'a cancelled tween did not finish';
is $r.completes, 0, 'on-complete did not fire';
nok $tw.tick($t0 + 0.5), 'a cancelled tween ignores further ticks';
is $r.updates.elems, 1, 'and fires no further updates';
is-approx $tw.progress, 0.4e0, TOL, 'progress is left where it stopped';
};
subtest 'finish jumps to the end and fires both callbacks once' => {
plan 7;
my $r = Recorder.new;
my $t0 = Instant.from-posix(5_000);
my $tw = Tween.new(
duration => 1, on-update => $r.on-update, on-complete => $r.on-complete,
).start($t0);
$tw.tick($t0 + 0.1);
$tw.finish;
is-approx $r.last, 1e0, TOL, 'finish paints the end state';
is $r.completes, 1, 'and completes';
ok $tw.done, 'the tween is done';
nok $tw.running, 'and no longer running';
is-approx $tw.progress, 1e0, TOL, 'progress jumped to 1';
$tw.finish;
is $r.completes, 1, 'finishing twice completes only once';
# finish on a tween that was never started is the "just apply the
# end state" shortcut.
my $r2 = Recorder.new;
Tween.new(
duration => 1, on-update => $r2.on-update, on-complete => $r2.on-complete,
).finish;
is $r2.completes, 1, 'finish works on a tween that was never started';
};
subtest 'start is idempotent while restart re-arms' => {
plan 6;
my $r = Recorder.new;
my $t0 = Instant.from-posix(6_000);
my $tw = Tween.new(
duration => 1, on-update => $r.on-update, on-complete => $r.on-complete,
).start($t0);
$tw.tick($t0 + 0.5);
$tw.start($t0 + 0.5); # must NOT reset a live tween
$tw.tick($t0 + 0.75);
is-approx $r.last, 0.75e0, TOL, 'start on a running tween keeps the original zero point';
$tw.restart($t0 + 0.75);
is-approx $tw.progress, 0e0, TOL, 'restart resets progress';
$tw.tick($t0 + 1e0);
is-approx $r.last, 0.25e0, TOL, 'and re-bases the clock';
is $r.completes, 0, 'the abandoned run did not complete';
# Re-arming after a natural completion.
$tw.tick($t0 + 99);
is $r.completes, 1, 'the second run completed';
$tw.start($t0 + 99);
ok $tw.running && !$tw.done, 'start on a finished tween re-arms it';
};
subtest 'reverse inverts the value while keeping the curve shape' => {
plan 5;
my $r = Recorder.new;
my $t0 = Instant.from-posix(7_000);
my $tw = Tween.new(
duration => 1, easing => EaseOutQuad, reverse => True,
on-update => $r.on-update, on-complete => $r.on-complete,
).start($t0);
$tw.tick($t0);
is-approx $r.last, 1e0, TOL, 'a reversed tween starts at 1';
$tw.tick($t0 + 0.5);
is-approx $r.last, 1e0 - ease(EaseOutQuad, 0.5e0), TOL,
'the value is 1 minus the forward curve, not the curve of reversed time';
$tw.tick($t0 + 1);
is-approx $r.last, 0e0, TOL, 'and ends at 0';
is $r.completes, 1, 'reversal does not change when on-complete fires';
is-approx $tw.progress, 1e0, TOL, 'progress still counts forward';
};
subtest 'degenerate durations' => {
plan 5;
my $r = Recorder.new;
my $t0 = Instant.from-posix(8_000);
# A zero duration is what an "animations off" preference turned all
# the way down produces: complete on the first tick, don't divide
# by zero, don't skip the callbacks.
my $tw = Tween.new(
duration => 0, on-update => $r.on-update, on-complete => $r.on-complete,
).start($t0);
ok $tw.tick($t0), 'a zero-duration tween ticks once';
is-approx $r.last, 1e0, TOL, 'straight to the end value';
is $r.completes, 1, 'and completes immediately';
nok $tw.tick($t0), 'with nothing left to do';
dies-ok { Tween.new(duration => -1, on-update => -> Num $ { }) },
'a negative duration is rejected at construction';
};