view release on metacpan or  search on metacpan

lib/Graphics/Grid.pm  view on Meta::CPAN

has _gp_stack => (
    is      => 'ro',
    traits  => ['Array'],
    default => sub { [] },
    handles => {
        _push_gp  => 'push',
        _pop_gp   => 'pop',
        _clear_gp => 'clear',
    }
);

sub _build_driver {
    my $driver_cls = 'Graphics::Grid::Driver::Cairo';
    load $driver_cls;
    return $driver_cls->new();
}

sub _build__vptree {
    my ($self) = @_;
    return Graphics::Grid::ViewportTree->new(
        node => Graphics::Grid::Viewport->new(
            name => 'ROOT',
            gp   => $self->driver->default_gpar()
        )
    );
}

sub _build__current_vptree { $_[0]->_vptree }


method current_vptree( $all = true ) {
    return ( $all ? $self->_vptree : $self->_current_vptree );
}


method current_viewport() {
    return $self->_current_vptree->node;
}

method _push_vp($vp) {

    # Viewports in a stack are pushed in series.
    # Viewports in a list are pushed in parallel.
    # For a tree of viewports, the parent is pushed then the children are
    #  pushed in parallel.

    # Push a list of viewpoints in parallel, and move current to last node.
    my $push_node = sub {
        my (@vps) = @_;
        return unless @vps;

        my @trees =
          map { Graphics::Grid::ViewportTree->new( node => $_ ) } @vps;
        $self->_current_vptree->add_children(@trees);
        $self->_current_vptree( $trees[-1] );
    };

    if ( $vp->$_isa('Graphics::Grid::Viewport') ) {
        &$push_node($vp);
    }
    elsif ( Ref::Util::is_arrayref($vp) ) {
        &$push_node(@$vp);
    }
    elsif ( $vp->$_isa('Graphics::Grid::ViewportTree') ) {
        my $t = $vp;
        $self->_current_vptree->add_child($t);

        # go right-then-down in the sub-tree
        while ( my $child_count = $t->child_count ) {
            $t = $t->get_child_at( $child_count - 1 );
        }
        $self->_current_vptree($t);
    }
}


method push_viewport(@vps) {
    for my $vp (@vps) {
        $self->_push_vp($vp);
    }
    $self->_set_vptree( $self->_current_vptree );
}

sub _up_viewport {
    my ( $self, $n, $is_pop ) = @_;

    return if ( $n == 0 );
    return unless ( $self->_current_vptree->has_parent );

    $self->_current_vptree( $self->_current_vptree->parent );
    if ($is_pop) {
        $self->_current_vptree->children( [] );
    }
    $self->_up_viewport( $n - 1, $is_pop );
}


method pop_viewport( $n = 1 ) {
    if ( $n < 0 ) {
        die "must pop at least one viewport";
    }
    if ( $n == 0 ) {

        # retain only the root node
        $self->_current_vptree( $self->_vptree );
        $self->_current_vptree->children( [] );
    }
    else {    # $n > 0
        $self->_up_viewport( $n, true );
    }
    $self->_set_vptree( $self->_current_vptree );
}


method up_viewport( $n = 1 ) {
    if ( $n < 0 ) {
        die "must navigate at least one viewport";
    }
    if ( $n == 0 ) {
        $self->_current_vptree( $self->_vptree );
    }