Selkie.git | t/ | 13-modal.rakutest
use Test;
use lib 'lib';
use Selkie::Widget;
use Selkie::Container;
use Selkie::Widget::Modal;
use Selkie::Event;
use Notcurses::Native::Types;
use Selkie::App::Internal::ScreenModalLifecycle;
class TestWidget does Selkie::Widget {
method render() { self.clear-dirty }
}
class TestContainer does Selkie::Container {
method render() {
self!render-children;
self.clear-dirty;
}
}
plan 21;
subtest "construction defaults" => {
plan 8;
my $m = Selkie::Widget::Modal.new;
is $m.width-ratio, 0.8, "default width ratio";
is $m.height-ratio, 0.6, "default height ratio";
ok $m.dim-background, "dim background by default";
nok $m.content.defined, "no content initially";
# Everything S4 added defaults to "exactly what Modal already did":
# an opaque backdrop, no frame, and the framework's own base cell.
is $m.backdrop, BackdropOpaque, "opaque backdrop by default";
nok $m.framed, "unframed by default";
nok $m.frame.defined, "no frame widget built";
is $m.base-egc, ' ', "the plane base still covers the screen";
};
subtest "custom ratios" => {
plan 2;
my $m = Selkie::Widget::Modal.new(width-ratio => 0.5, height-ratio => 0.4);
is $m.width-ratio, 0.5, "custom width ratio";
is $m.height-ratio, 0.4, "custom height ratio";
};
subtest "set-content" => {
plan 3;
my $m = Selkie::Widget::Modal.new;
my $w = TestWidget.new;
$m.set-content($w);
ok $m.content === $w, "content set";
ok $w.parent === $m, "parent set on content";
ok $m.is-dirty, "modal marked dirty";
};
subtest "set-content replaces previous" => {
plan 1;
my $m = Selkie::Widget::Modal.new;
my $w1 = TestWidget.new;
my $w2 = TestWidget.new;
$m.set-content($w1);
$m.set-content($w2);
ok $m.content === $w2, "content replaced";
};
subtest "on-close returns Supply" => {
plan 1;
my $m = Selkie::Widget::Modal.new;
isa-ok $m.on-close, Supply, "on-close is a Supply";
};
subtest "close emits on Supply" => {
plan 1;
my $m = Selkie::Widget::Modal.new;
my $closed = False;
$m.on-close.tap: -> $ { $closed = True };
$m.close;
sleep 0.05;
ok $closed, "close emits event";
};
subtest "focusable-descendants - no content" => {
plan 1;
my $m = Selkie::Widget::Modal.new;
is $m.focusable-descendants.List.elems, 0, "no focusable descendants without content";
};
subtest "focusable-descendants - focusable content" => {
plan 1;
my $m = Selkie::Widget::Modal.new;
$m.set-content(TestWidget.new(focusable => True));
is $m.focusable-descendants.List.elems, 1, "finds focusable content";
};
subtest "focusable-descendants - container content" => {
plan 1;
my $m = Selkie::Widget::Modal.new;
my $c = TestContainer.new;
$c.add(TestWidget.new(focusable => True));
$c.add(TestWidget.new(focusable => True));
$m.set-content($c);
is $m.focusable-descendants.List.elems, 2, "finds focusable descendants in container content";
};
subtest "focusable-descendants - non-focusable content" => {
plan 1;
my $m = Selkie::Widget::Modal.new;
$m.set-content(TestWidget.new);
is $m.focusable-descendants.List.elems, 0, "non-focusable content not included";
};
subtest "handle-event checks own keybinds" => {
plan 2;
my $m = Selkie::Widget::Modal.new;
$m.set-content(TestWidget.new);
my $called = False;
$m.on-key: 'esc', -> $ { $called = True };
my $ev = Selkie::Event.new(
id => NCKEY_ESC,
modifiers => Set.new,
input-type => NCTYPE_PRESS,
event-type => KeyEvent,
);
ok $m.handle-event($ev), "esc keybind consumed";
ok $called, "keybind handler fired";
};
subtest "handle-event passes through unmatched keys" => {
plan 1;
my $m = Selkie::Widget::Modal.new;
$m.set-content(TestWidget.new);
my $ev = Selkie::Event.new(
id => 'x'.ord,
char => 'x',
modifiers => Set.new,
input-type => NCTYPE_PRESS,
event-type => KeyEvent,
);
nok $m.handle-event($ev), "unmatched key passes through (focus trap is in App)";
};
subtest "unmatched key with no keybinds" => {
plan 1;
my $m = Selkie::Widget::Modal.new;
$m.set-content(TestWidget.new);
my $ev = Selkie::Event.new(
id => NCKEY_F00 + 12,
modifiers => Set.new,
input-type => NCTYPE_PRESS,
event-type => KeyEvent,
);
nok $m.handle-event($ev), "F12 passes through";
};
subtest "dim-background can be disabled" => {
plan 2;
my $m = Selkie::Widget::Modal.new(dim-background => False);
nok $m.dim-background, "dim background disabled";
is $m.backdrop, BackdropNone, "…which is BackdropNone";
};
subtest "an unframed modal's geometry is the dialog rectangle" => {
plan 3;
# The pre-S4 render math, pinned: floor(ratio x terminal), floored
# at 3x10, centred. content-extent and modal-rect must agree with it
# so nothing that sized itself against a frameless modal moves.
my $m = Selkie::Widget::Modal.new;
is $m.modal-rect(24, 80).List, (5, 8, 14, 64), "default 0.8 x 0.6 ratios";
is $m.content-extent(24, 80).List, (14, 64), "content gets all of it";
# Terminal smaller than the 3x10 floor: the dialog is clamped, and
# the origin clamps at 0 rather than going negative.
is $m.modal-rect(2, 4).List, (0, 0, 3, 10), "sub-minimum terminal clamps";
};
subtest "set-content on an unframed modal parents to the modal" => {
plan 2;
my $m = Selkie::Widget::Modal.new;
my $w = TestWidget.new;
$m.set-content($w);
ok $w.parent === $m, "content's parent is the modal itself";
is $m.children.elems, 0, "and nothing was added to the child list";
};
# ---------------------------------------------------------------------
# dismissable — the per-modal opt-out for user-initiated dismissal
# ---------------------------------------------------------------------
subtest "dismissable defaults to True" => {
plan 1;
my $m = Selkie::Widget::Modal.new;
ok $m.dismissable, "unset modals stay dismissable — no behaviour change";
};
# `!close-modal-via-esc` and `!modal-is-dismissable` are the real logic
# under test here (Selkie::App::Internal::ScreenModalLifecycle); what a
# harness has to stub out is the stack-mutation primitives, which in the
# real role reach through App for theme/store/plane/focus wiring that
# needs a live terminal (see t/95's and t/97's StubApps for the same
# constraint). A tiny local array reimplements just enough of
# `@!modal-stack`'s push/pop/tail contract to drive the real Esc logic
# honestly.
my class EscHarness does Selkie::App::Internal::ScreenModalLifecycle {
has Selkie::Widget::Modal @.stack;
method !has-modal(--> Bool) { ?@!stack }
method !active-modal() { @!stack ?? @!stack.tail !! Selkie::Widget::Modal }
method !close-modal(--> Nil) { @!stack.pop if @!stack }
method push-modal(Selkie::Widget::Modal $m --> Nil) { @!stack.push($m) }
method esc(--> Nil) { self!close-modal-via-esc }
method modal-count(--> Int) { @!stack.elems }
}
subtest "esc closes a default modal" => {
plan 2;
my $h = EscHarness.new;
$h.push-modal(Selkie::Widget::Modal.new);
is $h.modal-count, 1, "modal is on the stack before esc";
$h.esc;
is $h.modal-count, 0, "esc popped the dismissable modal";
};
subtest "esc does not close a :!dismissable modal" => {
plan 2;
my $h = EscHarness.new;
$h.push-modal(Selkie::Widget::Modal.new(:!dismissable));
is $h.modal-count, 1, "modal is on the stack before esc";
$h.esc;
is $h.modal-count, 1, "esc left the non-dismissable modal in place";
};
subtest ".close still closes a :!dismissable modal" => {
plan 1;
my $m = Selkie::Widget::Modal.new(:!dismissable);
my $closed = False;
$m.on-close.tap: -> $ { $closed = True };
$m.close;
sleep 0.05;
ok $closed, ":!dismissable does not block programmatic close";
};
subtest "esc closes nothing when the topmost of two stacked modals is :!dismissable" => {
plan 3;
my $h = EscHarness.new;
$h.push-modal(Selkie::Widget::Modal.new);
$h.push-modal(Selkie::Widget::Modal.new(:!dismissable));
is $h.modal-count, 2, "both modals are stacked";
$h.esc;
is $h.modal-count, 2, "esc did not touch the non-dismissable topmost modal";
$h.esc;
is $h.modal-count, 2, "repeated esc still does nothing while it's on top";
};