Selkie.git | lib/Selkie/ | Tree.rakumod


=begin pod

=head1 NAME

Selkie::Tree - Tree-walking helpers used by widgets that need to reach
beyond their own subtree

=head1 SYNOPSIS

=begin code :lang<raku>

use Selkie::Tree;

# Mark every widget whose plane intersects this absolute screen rect
# as dirty — used by Image.destroy-blit-plane to repaint cells under
# the removed sprixel.
mark-widgets-in-rect-dirty(
    abs-y => 5,  abs-x => 10,
    rows  => 4,  cols  => 16,
);

# The active modal (or Nil), used by widgets that need to skip
# rendering when occluded.
my $modal = current-active-modal;

# Every walk up a parent chain takes its hops through next-ancestor,
# which turns a cyclic tree into a loud death instead of a frozen
# render thread.
my $node = $some-widget;
my int $hops = 0;
while $node.defined {
    last if $node === $wanted;
    $node = next-ancestor($node, $hops);
    $hops = $hops + 1;
}

=end code

=head1 DESCRIPTION

A small set of free subs that bridge between a widget and the wider
tree it lives in, without requiring the widget to walk up to the
L<Selkie::App> instance manually. L<Selkie::App> at init populates
two class-level provider closures — one returning the live list of
tree roots (active screen + modal stack + toast), the other returning
the active modal — and the helpers here read through them.

This pattern keeps widgets like L<Selkie::Widget::Image> from needing
a circular import on Selkie::App while still letting them participate
in app-level coordination (cell cleanup after sprixel destroy, modal
occlusion checks, etc.).

C<next-ancestor> is the other half of that job: the single hop
primitive every parent-chain walk in Selkie goes through. It is a
guard, not a convenience — see "Cycle-safe parent walks" below.

C<mark-widgets-in-rect-dirty> walks whole trees, so it is written to
stay cheap on the trees it actually meets: it prunes any subtree whose
root is parked (see C<Selkie::Widget.is-parked> — notcurses carries
bound child planes with their parent, so a parked subtree owns no
on-screen cells), and it duck-types C<children> / C<content> through
C<nqp::can>. Both details matter for correctness as much as speed; see
the sub's own documentation.

=head2 Cycle-safe parent walks

A widget tree is a tree by convention, not by construction: C<parent>
is a plain writable attribute that layouts set when they adopt a child.
One mis-ordered reparent — a container adopting a widget that is
already one of its own ancestors — turns every C<while $node.defined {
$node = $node.parent }> loop into an infinite spin. Several of those
loops run on the frame path (focus validation, dirty propagation, event
bubbling), so the symptom is the worst shape a TUI failure can take:
the screen freezes, every key is dead, nothing crashes, and there is no
stack to look at.

C<next-ancestor> is the hop primitive that makes that impossible. Take
each step through it, passing the number of hops taken so far, and a
cyclic chain dies at C<PARENT-CHAIN-LIMIT> hops with an
C<X::Selkie::WidgetCycle> naming the widgets in the loop:

=begin code :lang<raku>

my $node = $widget;
my int $hops = 0;
while $node.defined {
    return True if $node === $root;
    $node = next-ancestor($node, $hops);
    $hops = $hops + 1;
}

=end code

L<X::Selkie::WidgetCycle> is a compunit of its own, so C<CATCH { when
X::Selkie::WidgetCycle { … } }> names it exactly as written.

The limit is deliberately far above any real nesting depth (a deep
production layout is tens of widgets, not hundreds), so tripping it is
never a false positive and always an upstream bug. It fails loudly on
purpose: a silently truncated walk would leave focus, dirty marking and
event routing quietly wrong for the rest of the session.

The guard costs one integer comparison per hop and allocates nothing —
the walks it protects run per frame.

=head2 Widget teardown notifications

C<Selkie::Widget>'s plane-destroy chokepoint calls
C<notify-widget-destroyed>, so app-level bookkeeping that holds widget
references (mouse capture, for one) can drop them instead of routing
later events into a torn-down widget. C<Selkie::App> installs the
observer at init through C<set-widget-destroyed-observer>.

The observer runs on whatever thread destroyed the widget — including
the GC finalizer thread, since C<Widget.DESTROY> routes to C<destroy>.
Observers must therefore be thread-safe and must not touch app data
structures the render thread owns; the supported shape is to set an
atomic flag and let the render thread do the actual pruning.

=end pod

unit module Selkie::Tree;

use nqp;

use X::Selkie::WidgetCycle;

# --- Tree-roots provider --------------------------------------------------
#
# Closure returning the live list of widget tree roots — typically the
# active screen's root plus every modal in the stack plus the toast
# overlay. Set by Selkie::App at init. Used by C<mark-widgets-in-rect-dirty>
# to find the trees to walk.

my &TREE-ROOTS-PROVIDER = -> { () };

#|( Set the tree-roots provider — a closure returning an iterable of
    widget roots. C<Selkie::App> calls this during init so tree-walking
    helpers can find the live trees without each helper needing a
    direct reference to the app. )
sub set-tree-roots-provider(&p --> Nil) is export {
    &TREE-ROOTS-PROVIDER = &p;
}

#|( The current list of widget tree roots. Used internally by helpers
    in this module; apps don't typically call this directly. )
sub current-tree-roots(--> List) is export {
    TREE-ROOTS-PROVIDER().List;
}

# --- Active-modal provider ------------------------------------------------
#
# Closure returning the topmost open modal widget (or Nil). Set by
# Selkie::App at init. Used by widgets that need to detect occlusion —
# notably L<Selkie::Widget::Image>, which destroys its blit and skips
# rendering when a modal is open and the image is not in its tree.

my &MODAL-PROVIDER = -> { Nil };

#|( Set the active-modal provider — a closure returning the topmost
    open modal widget or Nil. C<Selkie::App> calls this on init. )
sub set-modal-provider(&p --> Nil) is export {
    &MODAL-PROVIDER = &p;
}

#|( The topmost open modal widget, or Nil if no modal is open. )
sub current-active-modal(--> Mu) is export {
    MODAL-PROVIDER();
}

# --- Widget-destroyed observer --------------------------------------------
#
# Closure invoked from Selkie::Widget's plane-destroy chokepoint with the
# widget being torn down. Set by Selkie::App at init so app-level state
# holding widget references (notably the mouse-capture table) can be
# invalidated. See the "Widget teardown notifications" section above for
# the threading contract.

my &DESTROY-OBSERVER = -> $ { };

#|( Set the widget-destroyed observer — a closure called with each
    widget as its plane is destroyed. C<Selkie::App> calls this on init.
    The observer may run on the GC finalizer thread; keep it
    thread-safe and allocation-light. )
sub set-widget-destroyed-observer(&p --> Nil) is export {
    &DESTROY-OBSERVER = &p;
}

#|( Notify the registered observer that C<$widget> is being destroyed.
    Called by C<Selkie::Widget>; apps don't call this directly.

    Never lets an observer failure escape into a teardown path: a
    destroy that throws would abandon the rest of the widget's cleanup
    (and, from a finalizer, take down the GC thread's work item). )
sub notify-widget-destroyed(Mu $widget --> Nil) is export {
    my $ = try DESTROY-OBSERVER($widget);
    Nil;
}

# --- Cycle-safe parent walks ----------------------------------------------

# Hop budget for a single parent-chain walk. Far above any real nesting
# depth — a deeply nested production layout is tens of widgets — so
# reaching it means the chain is cyclic, never that a legitimate tree
# was too deep. Documented in the "Cycle-safe parent walks" section.
constant PARENT-CHAIN-LIMIT is export = 256;

# How many widgets an X::Selkie::WidgetCycle names. Enough to show the
# whole loop for any realistic reparenting bug while keeping the
# message readable.
my constant CYCLE-REPORT-WIDGETS = 12;

# The exception itself lives in its own compunit (L<X::Selkie::WidgetCycle>)
# so its name really is X::Selkie::WidgetCycle — the name a consumer
# writes in a CATCH block. Declaring it inside this module would nest it
# under Selkie::Tree, and forcing it into GLOBAL from here breaks
# precompilation of the staged copy during install.

# Bounded description of the chain hanging off $start, used only to
# build the exception message. Duck-typed and hard-capped so it stays
# safe on the pathological tree that got us here.
sub describe-widget-chain(Mu $start --> Str) {
    my @parts;
    my $node = $start;
    my int $seen = 0;
    while $node.defined && $seen < CYCLE-REPORT-WIDGETS {
        my $obj := nqp::decont($node);
        @parts.push: nqp::can($obj, 'widget-id')
            ?? "{$node.^name}#{$node.widget-id}"
            !! $node.^name;
        last unless nqp::can($obj, 'parent');
        $node = $node.parent;
        $seen = $seen + 1;
    }
    @parts.push('…') if $node.defined;
    @parts.join(' -> ');
}

#|( One hop up a parent chain, with the cycle guard applied.
    C<$hops> is the number of hops already taken on this walk; pass 0
    on the first call and increment from there. Returns
    C<$node.parent> — the walk's own C<.defined> test is what ends it
    at the root.

    Throws C<X::Selkie::WidgetCycle> once a single walk has taken
    C<PARENT-CHAIN-LIMIT> hops. See the "Cycle-safe parent walks"
    section above for why this fails loudly rather than truncating. )
sub next-ancestor(Mu $node, int $hops --> Mu) is export {
    if $hops >= PARENT-CHAIN-LIMIT {
        die X::Selkie::WidgetCycle.new(
            chain => describe-widget-chain($node),
            hops  => PARENT-CHAIN-LIMIT,
        );
    }
    $node.parent;
}

#|( True when C<$widget> is outside the active modal tree and therefore
    should suppress out-of-band painting such as sprixels. Widgets inside
    the active modal, including descendants of its content tree, are not
    occluded. )
sub widget-occluded-by-active-modal(Mu $widget --> Bool) is export {
    my $modal = current-active-modal();
    return False without $modal;

    my $p = $widget;
    my int $hops = 0;
    while $p.defined {
        return False if $p === $modal;
        return True unless $p.can('parent').elems > 0;
        $p = next-ancestor($p, $hops);
        $hops = $hops + 1;
    }
    True;
}

# --- Tree-walking helpers -------------------------------------------------

#|( Walk every tree root and mark dirty any widget whose absolute screen
    bounds intersect the given rectangle. Used by sprixel-bearing
    widgets after they destroy a blit-plane: the cells under the
    removed sprixel may belong to a widget that has nothing else
    changing this frame, so without an explicit dirty mark the widget
    won't repaint and the cells will continue to show whatever was
    cached pre-sprixel-removal. Called once per blit teardown.

    Two properties keep this affordable on the trees it actually runs
    against (a long chat transcript in a consumer app is ~10k widgets):

    =item B<Parked subtrees are pruned.> A widget whose C<is-parked>
      latch is set has been moved to C<park-y>, and notcurses carries
      every bound descendant plane along with it — so neither it nor
      anything beneath it owns an on-screen cell, and none of them can
      intersect an on-screen rect. Skipping the subtree is not an
      approximation. It also breaks a feedback loop: without the prune,
      tearing a sprixel down re-dirties the parked cards whose stale
      C<abs-y> still overlaps the rect, which re-renders them, which
      tears more sprixels down.
    =item B<Capability tests go through C<nqp::can>.> C<children> and
      C<content> are duck-typed here on purpose — C<Selkie::Widget::CardList>
      and C<ViewportedCardList> expose C<children> without composing
      C<Selkie::Container>, so a C<~~ Selkie::Container> test would walk
      past every card in the list. C<nqp::can> answers the same question
      as C<.^can> from the method cache, without building the candidate
      list C<.^can> returns. )
sub mark-widgets-in-rect-dirty(
    Int  :$abs-y!,
    Int  :$abs-x!,
    UInt :$rows!,
    UInt :$cols!,
    --> Nil
) is export {
    return if $rows == 0 || $cols == 0;
    my Int $rect-bottom = $abs-y + $rows.Int;
    my Int $rect-right  = $abs-x + $cols.Int;

    sub visit($w) {
        return without $w;
        # Parked: off-screen along with its whole subtree. Nothing to
        # dirty here and nothing to recurse into.
        return if $w.is-parked;
        # Rectangles overlap iff
        #   !(a.right <= b.left || b.right <= a.left ||
        #     a.bottom <= b.top  || b.bottom <= a.top)
        my Int $w-abs-y  = $w.abs-y;
        my Int $w-abs-x  = $w.abs-x;
        my Int $w-bottom = $w-abs-y + $w.rows.Int;
        my Int $w-right  = $w-abs-x + $w.cols.Int;
        my Bool $intersects = !(
               $w-right     <= $abs-x
            || $rect-right  <= $w-abs-x
            || $w-bottom    <= $abs-y
            || $rect-bottom <= $w-abs-y
        );
        $w.mark-dirty if $intersects && !$w.is-dirty;
        my $obj := nqp::decont($w);
        if nqp::can($obj, 'children') {
            my $kids := $w.children;
            visit($_) for $kids;
        }
        if nqp::can($obj, 'content') {
            my $c := $w.content;
            visit($c) if $c.defined;
        }
    }

    visit($_) for current-tree-roots();
}