Selkie.git | t/ | 88-modal-frame.rakutest
use Test;
use lib 'lib';
use Selkie::BorderStyle;
use Selkie::Container;
use Selkie::Store;
use Selkie::Widget;
use Selkie::Widget::Border;
use Selkie::Widget::Modal;
=begin pod
C<Selkie::Widget::Modal>'s optional internal frame.
The frame is a real C<Selkie::Widget::Border> registered as a Container
child, which is what gets the framework's own cascades (set-store,
set-theme, park, the render loop's mark-all-dirty) for free. The
load-bearing property is B<ownership>: C<.content> must keep answering
the caller's widget so that every consumer written against an unframed
modal — C<ConfirmModal>, C<HelpOverlay>, App-Cantina's dialogs — keeps
working, while the widget tree underneath actually runs
modal → frame → content.
The other one is B<interior arithmetic>. A framed modal hands its
content the frame's inner rectangle, not the dialog rectangle: two rows
and columns for the edges plus C<frame-padding> on each side. Anything
sized against the wrong number puts every flex spacer in a consumer's
dialog off by the frame thickness, which is exactly the kind of bug that
only shows up as "the buttons are one row too low".
Everything here is plane-free.
=end pod
plan 12;
class TestWidget does Selkie::Widget {
has Int $.destroy-count is rw = 0;
has @.resizes;
method render() { self.clear-dirty }
method handle-resize(UInt $rows, UInt $cols) {
@!resizes.push: ($rows, $cols);
self.resize($rows, $cols);
}
method destroy() {
$!destroy-count++;
self!destroy-plane;
}
}
class TestContainer does Selkie::Container {
method render() {
self!render-children;
self.clear-dirty;
}
}
subtest "framed defaults to False and builds no frame" => {
plan 3;
my $m = Selkie::Widget::Modal.new;
nok $m.framed, "framed is False by default";
nok $m.frame.defined, "frame is the Border type object";
is $m.children.elems, 0, "no Container children — the tree is untouched";
};
subtest "framed modal builds a Border child" => {
plan 4;
my $m = Selkie::Widget::Modal.new(framed => True);
isa-ok $m.frame, Selkie::Widget::Border, "frame is a Border";
is $m.children.elems, 1, "the frame is a Container child";
ok $m.children[0] === $m.frame, "…and it is the frame";
ok $m.frame.parent === $m, "frame's parent is the modal";
};
subtest "frame attributes propagate from the constructor" => {
plan 12;
my $glyphs = Selkie::BorderStyle::BorderGlyphs.new(
top-left => '.', top-right => '.',
bottom-left => "'", bottom-right => "'",
horizontal => '.', vertical => ':',
);
my $m = Selkie::Widget::Modal.new(
framed => True,
frame-style => BorderRounded,
frame-glyphs => $glyphs,
frame-title => 'Rename',
frame-title-align => TitleLeft,
frame-bottom-title => 'esc cancel',
frame-bottom-title-align => TitleRight,
frame-padding => 2,
);
my $f = $m.frame;
is $f.border-style, BorderRounded, "border-style";
ok $f.border-glyphs === $glyphs, "explicit glyph table forwarded";
is $f.title, 'Rename', "title";
is $f.title-align, TitleLeft, "title-align";
is $f.bottom-title, 'esc cancel', "bottom-title";
is $f.bottom-title-align, TitleRight, "bottom-title-align";
is ($f.padding-top, $f.padding-right, $f.padding-bottom, $f.padding-left),
(2, 2, 2, 2), "padding fans out to all four edges";
# Modal chrome paints from its own theme slots, and deliberately
# does not react to focus: a modal is a focus trap, so a
# focus-reactive frame would sit permanently in the focused style.
is $f.style-slot, 'modal-frame', "unfocused frame slot";
is $f.focused-style-slot, 'modal-frame', "focused frame slot is the same";
is $f.title-slot, 'modal-title', "top title slot";
is $f.bottom-title-slot, 'modal-key', "bottom title slot";
ok $f.focus-from-store, "focus subscription stays on (the walk must stay honest)";
};
subtest "frame defaults" => {
plan 5;
my $f = Selkie::Widget::Modal.new(framed => True).frame;
is $f.border-style, BorderSingle, "single frame by default";
is $f.title, '', "no title by default";
is $f.title-align, TitleCenter, "dialog headings centre by default";
is $f.bottom-title-align, TitleCenter, "so does the key-hint strip";
is $f.padding-top, 1, "one cell of padding by default";
};
subtest "content ownership — .content is always the caller's widget" => {
plan 5;
my $m = Selkie::Widget::Modal.new(framed => True);
my $w = TestWidget.new;
$m.set-content($w);
ok $m.content === $w, ".content answers the user's widget, not the frame";
ok $m.frame.content === $w, "the frame holds it";
ok $w.parent === $m.frame, "content's parent is the frame";
ok $w.parent.parent === $m, "…which parents up to the modal";
ok $m.is-dirty, "modal marked dirty";
};
subtest "set-content swap semantics survive the frame" => {
plan 4;
my $m = Selkie::Widget::Modal.new(framed => True);
my $a = TestWidget.new;
my $b = TestWidget.new;
$m.set-content($a);
$m.set-content($b);
ok $m.content === $b, "content replaced";
is $a.destroy-count, 1, "outgoing content destroyed by default";
my $c = TestWidget.new;
$m.set-content($c, :!destroy);
ok $m.content === $c, "content replaced again";
is $b.destroy-count, 0, ":!destroy keeps the outgoing widget alive";
};
subtest "focusable-descendants reaches through the frame" => {
plan 3;
my $m = Selkie::Widget::Modal.new(framed => True);
my $c = TestContainer.new;
my $one = TestWidget.new(focusable => True);
my $two = TestWidget.new(focusable => True);
$c.add($one);
$c.add($two);
$m.set-content($c);
my @fd = $m.focusable-descendants.List;
is @fd.elems, 2, "both focusables found";
ok @fd[0] === $one, "first in tree order";
ok @fd[1] === $two, "second in tree order";
};
subtest "the frame's focus subscription reaches the content subtree" => {
plan 3;
# This is Border's !is-descendant walk: it climbs parent links from
# the focused widget looking for the frame's content. With the frame
# in the middle of the tree that walk has to pass through it, so
# this is the regression net for the ownership design above.
my $store = Selkie::Store.new;
# Same handler shape App registers for 'ui/focus'; computed subs are
# only re-walked on a tick that had events, so a bare assoc-in
# wouldn't exercise the subscription at all.
$store.register-handler('ui/focus', -> $s, %ev {
(db => { ui => { focused-widget => %ev<widget> } },);
});
my $m = Selkie::Widget::Modal.new(framed => True);
my $c = TestContainer.new;
my $deep = TestWidget.new(focusable => True);
$c.add($deep);
$m.set-content($c);
$m.set-store($store);
$store.tick;
$m.frame.clear-dirty;
$store.dispatch('ui/focus', widget => $deep);
$store.tick;
ok $m.frame.is-dirty, "focusing a deep descendant reaches the frame";
$m.frame.clear-dirty;
$store.dispatch('ui/focus', widget => TestWidget.new);
$store.tick;
ok $m.frame.is-dirty, "focus moving away also notifies the frame";
$m.frame.clear-dirty;
$store.dispatch('ui/focus', widget => TestWidget.new);
$store.tick;
nok $m.frame.is-dirty,
"…but a focus change entirely outside the modal doesn't";
};
subtest "content-extent — unframed is the dialog rectangle" => {
plan 2;
my $m = Selkie::Widget::Modal.new(width-ratio => 0.5, height-ratio => 0.5);
is $m.modal-rect(24, 80).List, (6, 20, 12, 40),
"centred half-size dialog";
is $m.content-extent(24, 80).List, (12, 40),
"content gets the whole rectangle";
};
subtest "content-extent — the frame eats edges plus padding" => {
plan 4;
my $m = Selkie::Widget::Modal.new(
width-ratio => 0.5, height-ratio => 0.5, framed => True,
);
# 12x40 dialog, one row/col of frame on each side, one of padding:
# 12 - 2 - 2 = 8 rows, 40 - 2 - 2 = 36 cols.
is $m.content-extent(24, 80).List, (8, 36), "default padding of 1";
my $tight = Selkie::Widget::Modal.new(
width-ratio => 0.5, height-ratio => 0.5,
framed => True, frame-padding => 0,
);
is $tight.content-extent(24, 80).List, (10, 38), "padding 0 costs only the edges";
my $fat = Selkie::Widget::Modal.new(
width-ratio => 0.5, height-ratio => 0.5,
framed => True, frame-padding => 3,
);
is $fat.content-extent(24, 80).List, (4, 32), "padding 3";
# Squeezed to nothing on the vertical axis: the dialog floor is 3
# rows, of which the frame alone wants 2 — the Border parks the
# content rather than attempting a zero-row resize.
my $collapsed = Selkie::Widget::Modal.new(
width-ratio => 0.5, height-ratio => 0.1, framed => True,
);
is $collapsed.content-extent(10, 80).List, (0, 36),
"a collapsed interior reports zero rather than going negative";
};
subtest "handle-resize cascades the interior dimensions" => {
plan 6;
my $unframed = Selkie::Widget::Modal.new(
width-ratio => 0.5, height-ratio => 0.5,
);
my $plain = TestWidget.new;
$unframed.set-content($plain);
$unframed.handle-resize(24, 80);
is $plain.resizes.List, ((12, 40),), "unframed content gets the dialog rect";
my $framed = Selkie::Widget::Modal.new(
width-ratio => 0.5, height-ratio => 0.5, framed => True,
);
my $inner = TestWidget.new;
$framed.set-content($inner);
$framed.handle-resize(24, 80);
is $framed.frame.rows, 12, "frame took the dialog rows";
is $framed.frame.cols, 40, "frame took the dialog cols";
is $inner.resizes.List, ((8, 36),),
"content got the interior, not the dialog rectangle";
$framed.handle-resize(24, 80);
is $inner.resizes.elems, 1, "unchanged dimensions short-circuit";
# A terminal too small for the frame's interior: skip the cascade
# rather than hand notcurses a zero-dimension resize.
my $tiny = Selkie::Widget::Modal.new(
width-ratio => 0.5, height-ratio => 0.1, framed => True,
);
my $squeezed = TestWidget.new;
$tiny.set-content($squeezed);
$tiny.handle-resize(10, 80);
is $squeezed.resizes.elems, 0, "collapsed interior cascades nothing";
};
subtest "destroy tears the subtree down exactly once" => {
plan 4;
my $m = Selkie::Widget::Modal.new(framed => True);
my $w = TestWidget.new;
$m.set-content($w);
$m.destroy;
is $w.destroy-count, 1, "content destroyed once, not once per owner";
nok $m.content.defined, "content slot cleared";
nok $m.frame.defined, "frame slot cleared";
my $unframed = Selkie::Widget::Modal.new;
my $u = TestWidget.new;
$unframed.set-content($u);
$unframed.destroy;
is $u.destroy-count, 1, "unframed path unchanged";
};