libsvg-graph-perl 0.02-2 / usr / share / perl5 / SVG / Frame.pm

package SVG::Graph::Group;

use base SVG::Graph::Data;
use strict;
use Data::Dumper;

=head1 NAME

SVG::Frame - SVG::Frame object

=head1 METHODS

=head2 new

 Title   : new
 Usage   :
 Function:
 Example :
 Returns : 
 Args    :


=cut

sub new {
  my($class, %args) = @_;
  my $self = bless {}, $class;
  $self->init(%args);
  return $self;
}

=head2 init

 Title   : init
 Usage   :
 Function:
 Example :
 Returns : 
 Args    :


=cut

sub init {
  my($self, %args) = @_;

#  die "you must provide a 'data' arg to new()" unless $args{data};
  $self->_parent_svg($args{svg});

  my $id = 'n'.sprintf("%07d",int(rand(9999999)));
  my $group = $self->_parent_svg->svg->group(id=>$id);

  foreach my $arg (keys %args){
	my $meth = 'add_'.$arg;
        $self->$meth($args{$arg});
  }
  $self->svg($group);
  $self->is_changed(1);
}

=head2 add_glyph

 Title   : add_glyph
 Usage   :
 Function:
 Example :
 Returns : 
 Args    :


=cut

sub add_glyph {
  my($self, $glyphtype, %args) = @_;

  my $class = 'SVG::Graph::Glyph::'.$glyphtype || 'generic';
  eval "require $class"; if($@){ die "couldn't load $class: $@" };

  my $glyph = $class->new(%args, svg => $self->svg, group => $self,
						  xsize=>$self->xsize,
						  ysize=>$self->ysize,
						  xoffset=>$self->xoffset,
						  yoffset=>$self->yoffset,
						 );
  push @{$self->{glyphs}}, $glyph;
  return $glyph;
}

=head2 add_group

 Title   : add_group
 Usage   :
 Function:
 Example :
 Returns : 
 Args    :


=cut

sub add_group {
  my($self,@groups) = @_;

  my $epitaph = "only SVG::Graph::Group objects accepted";

  if(scalar(@groups)){
	foreach my $group (@groups){
	  if(ref $group eq 'ARRAY'){
		foreach my $g (@$group){
		  die $epitaph unless ref $g eq 'SVG::Graph::Group';
		  push @{$self->{groups}}, $g;
		}
	  } else {
		die $epitaph unless ref $group eq 'SVG::Graph::Group';
		push @{$self->{groups}}, $group;
	  }
	}
  } else {
   my $group = SVG::Graph::Group->new(svg=>$self->_parent_svg,
									  _parent_group=>$self,
									  xoffset=>$self->_parent_svg->margin,
									  yoffset=>$self->_parent_svg->margin,
									  xsize=>$self->_parent_svg->width  - (2 * $self->_parent_svg->margin),
									  ysize=>$self->_parent_svg->height - (2 * $self->_parent_svg->margin),
									 );	

   $group->stack($self->stack) if $self->stack;
   $group->ystat($self->ystat) if $self->stack;

   push @{$self->{groups}}, $group;
	return $group;
  }

  $self->is_changed(1);
}

=head2 groups

 Title   : groups
 Usage   :
 Function:
 Example :
 Returns : 
 Args    :


=cut

sub groups {
  my $self = shift;
  return $self->{groups} ? @{$self->{groups}} : ();
}

=head2 add_data

 Title   : add_data
 Usage   :
 Function:
 Example :
 Returns : 
 Args    :


=cut

sub add_data {
  my($self,@datas) = @_;

  my $epitaph = "only SVG::Graph::Data objects accepted";

  foreach my $data (@datas){
	if(ref $data eq 'ARRAY'){
	  foreach my $d (@$data){
		die $epitaph unless ref $d eq 'SVG::Graph::Data' || ref $data eq 'SVG::Graph::Data::Tree';
		push @{$self->{data}}, $d;
	  }
	} else {
	  die $epitaph unless ref $data eq 'SVG::Graph::Data' || ref $data eq 'SVG::Graph::Data::Tree';
	  push @{$self->{data}}, $data;
	}
  }

  $self->is_changed(1);
}

=head2 all_data

 Title   : all_data
 Usage   :
 Function:
 Example :
 Returns : 
 Args    :


=cut

sub all_data {
  my $self = shift;
  my $flag = shift;

  if(($self->_parent_group && $flag) || !$self->_parent_group){
	my @data = $self->data;

	#recurse down into subgroups...
	foreach my $subgroup ($self->groups){
	  push @data, $subgroup->all_data(1);
	}

	return map {$_->can('data') ? $_->all_data(1) : $_ } @data;
  } elsif($self->_parent_group) {
	return $self->_parent_group->all_data;
  }
}

=head2 data

 Title   : data
 Usage   :
 Function:
 Example :
 Returns : 
 Args    :


=cut

sub data {
  my $self = shift;

  #these are SVG::Graph::Data objects
  my @data = $self->{data} ? @{$self->{data}} : ();

  #recurse down into subgroups...
  foreach my $subgroup ($self->groups){
	push @data, $subgroup->data;
  }

  return map {$_->can('data') ? $_->data : $_ } @data;
}

=head2 glyphs

 Title   : glyphs
 Usage   :
 Function:
 Example :
 Returns : 
 Args    :


=cut

sub glyphs {
  my $self = shift;
  return $self->{glyphs} ? @{$self->{glyphs}} : ();
}

=head2 data_chunks

 Title   : data_chunks
 Usage   :
 Function:
 Example :
 Returns : 
 Args    :


=cut

sub data_chunks {
  my $self = shift;

  my @data = $self->{data} ? @{$self->{data}} : ();

  #recurse down into subgroups...
  foreach my $subgroup ($self->groups){
	push @data, $subgroup->data_chunks;
  }

  return @data;
}

=head2 draw

 Title   : draw
 Usage   :
 Function:
 Example :
 Returns : 
 Args    :


=cut

sub draw {
  my($self, $svg) = @_;

  foreach my $group ($self->groups){
#warn $group;
	$group->draw($self);
  }

  foreach my $glyph ($self->glyphs){
#warn $glyph;
	$glyph->draw($self);
  }
}

=head2 _recalculate_stats

 Title   : _recalculate_stats
 Usage   :
 Function:
 Example :
 Returns : 
 Args    :


=cut

sub _recalculate_stats{
   my ($self,@args) = @_;
   return undef unless $self->is_changed;

   my $xstat = Statistics::Descriptive::Full->new();
   my $ystat = Statistics::Descriptive::Full->new();
   my $zstat = Statistics::Descriptive::Full->new();

   #right now we only support y-stacking.  this may need to be extended in the future
   if($self->stack){
	 my @ystack;
	 foreach my $data ($self->data_chunks){
	   my $i = 0;
	   foreach my $datum ($data->data){
		 $ystack[$i] += $datum->y;
		 $i++;
	   }
	 }

	 $ystat->add_data($_) foreach @ystack;
   } else {
	 $ystat->add_data(map {ref($_) && $_->can('y') ? $_->y : $_} map {$_->can('data') ? $_->data : $_->y} $self->all_data);

   }

   $xstat->add_data(map {ref($_) && $_->can('x') ? $_->x : $_} map {$_->can('data') ? $_->data : $_->x} $self->all_data);
   $zstat->add_data(map {ref($_) && $_->can('z') ? $_->z : $_} map {$_->can('data') ? $_->data : $_->z} $self->all_data);

   $self->xstat($xstat);
   $self->ystat($ystat);
   $self->zstat($zstat);

   $self->is_changed(0);
}

=head2 _parent_svg

 Title   : _parent_svg
 Usage   : $obj->_parent_svg($newval)
 Function: 
 Example : 
 Returns : value of _parent_svg (a scalar)
 Args    : on set, new value (a scalar or undef, optional)


=cut

sub _parent_svg{
    my $self = shift;

    return $self->{'_parent_svg'} = shift if @_;
    return $self->{'_parent_svg'};
}

=head2 _parent_group

 Title   : _parent_group
 Usage   : $obj->_parent_group($newval)
 Function: 
 Example : 
 Returns : value of _parent_group (a scalar)
 Args    : on set, new value (a scalar or undef, optional)


=cut

sub add__parent_group{return shift->_parent_group(@_)}
sub _parent_group{
    my $self = shift;

    return $self->{'_parent_group'} = shift if @_;
    return $self->{'_parent_group'};
}

=head2 svg

 Title   : svg
 Usage   : $obj->svg($newval)
 Function: 
 Example : 
 Returns : value of svg (a scalar)
 Args    : on set, new value (a scalar or undef, optional)


=cut

sub svg{
    my $self = shift;

    return $self->{'svg'} = shift if @_;
    return $self->{'svg'};
}

=head2 xsize

 Title   : xsize
 Usage   : $obj->xsize($newval)
 Function: 
 Example : 
 Returns : value of xsize (a scalar)
 Args    : on set, new value (a scalar or undef, optional)


=cut

sub add_xsize {return shift->xsize(@_)}
sub xsize{
    my $self = shift;

    return $self->{'xsize'} = shift if @_;
    return $self->{'xsize'};
}

=head2 ysize

 Title   : ysize
 Usage   : $obj->ysize($newval)
 Function: 
 Example : 
 Returns : value of ysize (a scalar)
 Args    : on set, new value (a scalar or undef, optional)


=cut

sub add_ysize {return shift->ysize(@_)}
sub ysize{
    my $self = shift;

    return $self->{'ysize'} = shift if @_;
    return $self->{'ysize'};
}

=head2 xoffset

 Title   : xoffset
 Usage   : $obj->xoffset($newval)
 Function: 
 Example : 
 Returns : value of xoffset (a scalar)
 Args    : on set, new value (a scalar or undef, optional)


=cut

sub add_xoffset {return shift->xoffset(@_)}
sub xoffset{
    my $self = shift;

    return $self->{'xoffset'} = shift if @_;
    return $self->{'xoffset'};
}

=head2 yoffset

 Title   : yoffset
 Usage   : $obj->yoffset($newval)
 Function: 
 Example : 
 Returns : value of yoffset (a scalar)
 Args    : on set, new value (a scalar or undef, optional)


=cut

sub add_yoffset {return shift->yoffset(@_)}
sub yoffset{
    my $self = shift;

    return $self->{'yoffset'} = shift if @_;
    return $self->{'yoffset'};
}

=head2 xmin

 Title   : xmin
 Usage   : $obj->xmin($newval)
 Function: 
 Example : 
 Returns : value of xmin (a scalar)
 Args    : on set, new value (a scalar or undef, optional)


=cut

sub xmin{
    my $self = shift;

    return $self->{'xmin'} = shift if @_;
    return $self->{'xmin'} if defined $self->{'xmin'};
    $self->_recalculate_stats();
    return $self->xstat->min;

}

=head2 xmax

 Title   : xmax
 Usage   : $obj->xmax($newval)
 Function: 
 Example : 
 Returns : value of xmax (a scalar)
 Args    : on set, new value (a scalar or undef, optional)


=cut

sub xmax{
    my $self = shift;

    return $self->{'xmax'} = shift if @_;
    return $self->{'xmax'} if defined $self->{'xmax'};
    $self->_recalculate_stats();
    return $self->xstat->max;

}

=head2 ymin

 Title   : ymin
 Usage   : $obj->ymin($newval)
 Function: 
 Example : 
 Returns : value of ymin (a scalar)
 Args    : on set, new value (a scalar or undef, optional)


=cut

sub ymin{
    my $self = shift;

    return $self->{'ymin'} = shift if @_;
    return $self->{'ymin'} if defined $self->{'ymin'};
    $self->_recalculate_stats();
    return $self->ystat->min;

}

=head2 ymax

 Title   : ymax
 Usage   : $obj->ymax($newval)
 Function: 
 Example : 
 Returns : value of ymax (a scalar)
 Args    : on set, new value (a scalar or undef, optional)


=cut

sub ymax{
    my $self = shift;

    return $self->{'ymax'} = shift if @_;
    return $self->{'ymax'} if defined $self->{'ymax'};
    $self->_recalculate_stats();
    return $self->ystat->max;

}

=head2 xrange

 Title   : xrange
 Usage   : $obj->xrange($newval)
 Function: 
 Example : 
 Returns : value of xrange (a scalar)


=cut

sub xrange{
    my $self = shift;

    return $self->xmax - $self->xmin;
}

=head2 yrange

 Title   : yrange
 Usage   : $obj->yrange($newval)
 Function: 
 Example : 
 Returns : value of yrange (a scalar)


=cut

sub yrange{
    my $self = shift;

    return $self->ymax - $self->ymin;
}

=head2 stack

 Title   : stack
 Usage   : $obj->stack($newval)
 Function: 
 Example : 
 Returns : value of stack (a scalar)
 Args    : on set, new value (a scalar or undef, optional)


=cut

sub stack{
    my $self = shift;

    return $self->{'stack'} = shift if @_;
    return $self->{'stack'};
}

1;