Selkie.git | lib/Selkie/App/Internal/ | HitTest.rakumod

---

=begin pod

=head1 NAME

Selkie::App::Internal::HitTest - internal coordinate hit-testing helpers

=head1 DESCRIPTION

Implementation detail for C<Selkie::App>. Use C<Selkie::App.widget-at-in> from
application code.

=end pod

unit module Selkie::App::Internal::HitTest;

use Selkie::Widget;

# Coordinate-based depth-first hit-test against a widget tree. Children are
# walked in reverse so later-added, visually-on-top siblings win.
sub walk-for-point($w, Int $y, Int $x) {
    return Nil without $w;
    return Nil unless $w.contains-point($y, $x);
    if $w.can('children') {
        for $w.children.reverse -> $child {
            my $hit = walk-for-point($child, $y, $x);
            return $hit if $hit.defined;
        }
    }
    if $w.can('content') {
        my $c = $w.content;
        if $c.defined {
            my $hit = walk-for-point($c, $y, $x);
            return $hit if $hit.defined;
        }
    }
    $w;
}

# Whole-tree walk for overlays that paint outside their nominal rectangle.
sub walk-for-overlay($w, Int $y, Int $x) {
    return Nil without $w;
    if $w.can('children') {
        for $w.children -> $child {
            my $hit = walk-for-overlay($child, $y, $x);
            return $hit if $hit.defined;
        }
    }
    if $w.can('content') {
        my $c = $w.content;
        if $c.defined {
            my $hit = walk-for-overlay($c, $y, $x);
            return $hit if $hit.defined;
        }
    }
    return $w if $w.claims-overlay-at($y, $x);
    Nil;
}

sub app-widget-at-in($root, Int $y, Int $x --> Selkie::Widget) is export {
    return Selkie::Widget without $root;
    my $overlay = walk-for-overlay($root, $y, $x);
    return $overlay if $overlay.defined;
    walk-for-point($root, $y, $x) // Selkie::Widget;
}