—package
Graphics::Grid::ViewportTree;
# ABSTRACT: Viewport tree
our
$VERSION
=
'0.001'
;
# VERSION
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