The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

# ABSTRACT: Viewport tree
our $VERSION = '0.001'; # VERSION
extends qw(Forest::Tree);
use Types::Standard qw(ArrayRef InstanceOf);
has '+children' => ( isa => ArrayRef [ InstanceOf ['Graphics::Grid::ViewportTree'] ] );
method _build_name() {
return $self->_uid('GRID.gTree');
}
around BUILDARGS($orig, $class : @rest) {
my %params;
if (@rest == 1) {
%params = %{$rest[0]};
}
elsif (@rest == 2 and $rest[0]->$_isa('Graphics::Grid::Viewport') ) {
%params = ( node => $rest[0], children => $rest[1] );
} else {
%params = @rest;
}
my $children = ( delete $params{children} ) // [];
$children =
[ map { $_->$_isa(__PACKAGE__) ? $_ : __PACKAGE__->new( node => $_ ); }
@$children ];
$class->$orig( %params, children => $children );
}
# return an arrayref of Viewport from root
method path_from_root() {
my $tree = $self;
my @path = ($tree->node);
while ($tree->has_parent) {
my $parent = $tree->parent;
push @path, $parent->node;
$tree = $parent;
}
@path = reverse(@path);
return \@path;
}
method string () {
if ( $self->is_leaf ) {
return sprintf( "Viewport[%s]", $self->node->name );
}
else {
return sprintf(
"Viewport[%s]->(%s)",
$self->node->name,
join( ',',
map { $_->string() } @{ $self->children } )
);
}
}
__PACKAGE__->meta->make_immutable;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Graphics::Grid::ViewportTree - Viewport tree
=head1 VERSION
version 0.001
=head1 SYNOPSIS
=head1 DESCRIPTION
This is a subclass of L<Forest::Tree>, storing viewports at tree nodes.
=head1 METHODS
=head2 node()
my $viewport = $tree->node;
Get the viewport from the tree node.
=head2 path_from_root()
my $viewports = $tree->path_from_root();
Return an array of viewports, starting from the root node of the whole
tree, all the way down in the tree and to the calling node.
=head2 string()
my $tree_as_a_string = $tree->string();
Returns a string to represent the object.
=head1 SEE ALSO
L<Forest::Tree>
L<Graphics::Grid::ViewportLike>
L<Graphics::Grid::Viewport>
=head1 AUTHOR
Stephan Loyd <sloyd@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2018-2023 by Stephan Loyd.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut