Chart/Base.pm - metacpan.org

#===========================#
#                           #
#  Chart::Base              #
#  written by david bonner  #
#  dbonner@cs.bu.edu        #
#                           #
#===========================#


package Chart::Base;

use Carp;
use GD;
use strict;


#==================#
#  public methods  #
#==================#

sub new {
    my $class = shift;
    my $self = {};
    
    bless $self, $class;
    $self->my_init (@_);

    return $self;
}

sub set {
    my $obj = shift;
    my %hash = @_;

    for (keys (%hash)) {
	    $obj->{$_} = $hash{$_};
    }
}

sub add_pt {
    my $obj = shift;
    my @data = @_;   
    my $i = 0;
 
    if ($obj->{'data'} && $#_ != $#{$obj->{'data'}}) {
	carp ("New points must have a value for each dataset");
	return undef;
    }
    else {
	for $i (0..$#data) {
	    push @{$obj->{'data'}->[$i]}, $data[$i];
	}
	return 1;
    }
}

sub add_dataset {
    my $obj = shift;
    my ($set, $i);
    
    if ($obj->{'data'} && $#_ != $#{$obj->{'data'}->[0]}) {
	carp ("New datasets must have as many points as the current ones");
	return undef;
    }
    else {
	$set = $#{$obj->{'data'}} + 1;
	for $i (0..$#_) {
	    push @{$obj->{'data'}->[$set]}, $_[$i];
	}
	return 1;
    }
}

sub clear_data {
    my $obj = shift;
    
    undef $obj->{'data'};
}

sub get_data {
    my $obj = shift;
    
    return $obj->{'data'};
}

sub gif {
    my $obj = shift;
    my $file = shift;
    my $dataref = shift;
    my $prev_data;
    
    $prev_data = $obj->copy_data ($dataref);
    if ($prev_data == 1) {
	if ($#{$dataref} < 1) {
	    croak "Chart::* needs an array of labels and at least one array of data";
	}
	if ($#{$dataref->[0]} == 0) {
	    croak "There aren't any data points!";
	}
    }
	
    $obj->my_plot;
    
    open (GIF, ">$file") or croak ("Couldn\'t open $file:  $!");
    print GIF $obj->{'im'}->gif;
    close GIF;
}

sub cgi_gif {
    my $obj = shift;
    my $dataref = shift;
    my $prev_data;
    
    $prev_data = $obj->copy_data ($dataref);
    if ($prev_data == 1) {
	if ($#{$dataref} < 1) {
	    croak "Chart::* needs an array of labels and at least one array of data";
	}
	if ($#{$dataref->[0]} == 0) {
	    croak "There aren't any data points!";
	}
    }
    
    $obj->my_plot;
    
    print "Content-type: image/gif\n\n";
    print $obj->{'im'}->gif;
}

#===================#
#  private methods  #
#===================#

sub my_init {
    my $self = shift;
    
    #  gimme that image  
    if ($#_ == 1) {
	$self->{'im'} = new GD::Image($_[0], $_[1]);
	$self->{'x_min'} = 0;
	$self->{'x_max'} = $_[0];
	$self->{'y_min'} = 0;
	$self->{'y_max'} = $_[1];
    }
    else {
	$self->{'im'} = new GD::Image(400,300);
	$self->{'x_min'} = 0;
	$self->{'x_max'} = 400;
	$self->{'y_min'} = 0;
	$self->{'y_max'} = 300;
    }
    

    #  allocate some colors
    $self->set_colors;

    #  set the image to be interlaced
    $self->{'im'}->interlaced('true');

    #  tick length of 4 pixels
    $self->{'tick_len'} = 4;

    #  gimme 5 y ticks
    $self->{'y_ticks'} = 5;

    #  show me the legend
    $self->{'legend'} = 'true';

    #  stagger those x-tick labels
    $self->{'stagger_x_labels'} = 'true';

    #  set the pareto cutoff to be 5
    $self->{'cutoff'} = 5;

    #  set the point size to a 5 pixel square
    $self->{'pt_size'} = 4;

    #  give me a 10 pixel border around the whole thing
    $self->{'gif_border'} = 10;

    #  give me a 10 pixel border between the labels and the graph
    $self->{'graph_border'} = 10;

    #  a little space for the text
    $self->{'text_space'} = 2;

    #  pesky pareto graph needs to default sort
    $self->{'sort'} = ['desc', 1, 'num'] if (ref ($self) eq 'Chart::Pareto');
}

sub set_colors {
    my $self = shift;

    $self->{'im'}->colorAllocate (250, 250, 250);
    $self->{'im'}->colorAllocate (0, 0, 0);
    $self->{'im'}->colorAllocate (225, 0, 0);
    $self->{'im'}->colorAllocate (0, 225, 0);
    $self->{'im'}->colorAllocate (0, 0, 225);
    $self->{'im'}->colorAllocate (200, 0, 200);
    $self->{'im'}->colorAllocate (0, 200, 200);
    $self->{'im'}->colorAllocate (225, 225, 0);
    $self->{'im'}->colorAllocate (250, 170, 85);
    $self->{'im'}->colorAllocate (200,200,200);
}

sub copy_data {
    my $obj = shift;
    my $their_ref = shift;
    my $my_ref = [];
    my ($i, $j);

    if ($obj->{'data'}) {
	return -1;
    }
    else {
	for $i (0..$#{$their_ref}) {
	    for $j (0..$#{$their_ref->[$i]}) {
		$my_ref->[$i][$j] = $their_ref->[$i][$j];
	    }
	}
	$obj->{'data'} = $my_ref;
	return 1;
    }
}

sub my_plot {
    my $obj = shift;
    my $dataref = $obj->{'data'};

    if ($obj->{'colors'}) { $obj->set_user_colors }
    if ($obj->{'transparent'} && $obj->{'transparent'} eq 'true') { 
	my $white = $obj->get_color ('white');
	$obj->{'im'}->transparent ($white);
    }
    
    $obj->{'x_min'} += $obj->{'gif_border'};
    $obj->{'y_min'} += $obj->{'gif_border'};
    $obj->{'x_max'} -= $obj->{'gif_border'};
    $obj->{'y_max'} -= $obj->{'gif_border'};

    $obj->check_data; 

    if ($obj->{'title'}) { $obj->draw_title; }
    if ($obj->{'sub_title'}) { $obj->draw_sub_title; }
    if ($obj->{'legend'} eq 'true') { $obj->draw_legend ($dataref) }
    if ($obj->{'x_label'} or $obj->{'y_label'}) { $obj->draw_labels; }

    $obj->{'x_min'} += $obj->{'graph_border'};
    $obj->{'y_min'} += $obj->{'graph_border'};
    $obj->{'x_max'} -= $obj->{'graph_border'};
    $obj->{'y_max'} -= $obj->{'graph_border'};


    if ($obj->{'sort'}) { $obj->sort_data; } 
    $obj->draw_data;
}

sub check_data {
    my $obj = shift;
    my $ref = $obj->{'data'};
    my $mismatch;

    CHECK: for (1..$#{$ref}) {
	       if ($#{$ref->[$_]} > $#{$ref->[0]}) {
		   $mismatch = 1;
		   last CHECK;
	       }
    }

    if ($mismatch) {
	croak ("One or more data sets longer than set of data point labels");
    }
}
    
sub draw_title {
    my $obj = shift;
    my ($w, $h) = (gdLargeFont->width,gdLargeFont->height);
    my $black = $obj->get_color ('black');
    my ($x, $y);
    
    $y = $obj->{'y_min'} + $obj->{'text_space'};
    $obj->{'y_min'} += $h + 2 * $obj->{'text_space'} + $obj->{'gif_border'} / 2;
    $x = ((($obj->{'x_max'} - $obj->{'x_min'}) / $obj->{'text_space'}) - 
	  (($w * length ($obj->{'title'})) / $obj->{'text_space'}));
    $obj->{'im'}->string (gdLargeFont, $x, $y, $obj->{'title'}, $black);
} 

sub draw_sub_title {
    my $obj = shift;
    my ($w, $h) = (gdLargeFont->width,gdLargeFont->height);
    my $black = $obj->get_color ('black');
    my ($x, $y);
		        
    $y = $obj->{'y_min'} + $obj->{'text_space'};
    $obj->{'y_min'} += $h + 2 * $obj->{'text_space'} + $obj->{'gif_border'} / 2;
    $x = ((($obj->{'x_max'} - $obj->{'x_min'}) / $obj->{'text_space'}) -
          (($w * length ($obj->{'sub_title'})) / $obj->{'text_space'}));
    $obj->{'im'}->string (gdLargeFont, $x, $y, $obj->{'sub_title'}, $black);
}


sub draw_labels {
    my $obj = shift;
    my ($w, $h) = (gdMediumBoldFont->width,gdMediumBoldFont->height);
    my $black = $obj->get_color ('black');
    my ($x, $y);
    
    if ($obj->{'x_label'}) {
	$y = $obj->{'y_max'} - ($obj->{'text_space'} + $h);
	$x = (($obj->{'x_max'} - $obj->{'x_min'}) / 2) + $obj->{'x_min'}
	        - (length ($obj->{'x_label'}) / 2) * $w;
	$obj->{'im'}->string (gdMediumBoldFont, $x, $y, 
			      $obj->{'x_label'}, $black);
    }
    
    if ($obj->{'y_label'}) {
	$y = (($obj->{'y_max'} - $obj->{'y_min'}) / 2) + $obj->{'y_min'} +
	    (length ($obj->{'y_label'}) / 2) * $w;
	$x = $obj->{'x_min'} + $obj->{'text_space'};
	$obj->{'im'}->stringUp (gdMediumBoldFont, $x, $y, 
				$obj->{'y_label'}, $black);
    }

    $obj->{'y_max'} -= ($obj->{'x_label'}) ? $h + 2 * $obj->{'text_space'} : 0;
    $obj->{'x_min'} += ($obj->{'y_label'}) ? $h + 2 * $obj->{'text_space'} : 0;
}

sub draw_legend {
    my $obj = shift;
    my $dataref = $obj->{'data'};
    my (@labels, $legend_w, $legend_h, $color, $dash, $ymin);
    my ($w, $h) = (gdSmallFont->width, gdSmallFont->height);
    my $black = $obj->get_color ('black');
    my $max_len = 0;

    #==========================#
    #  prepare list of labels  #
    #==========================#

    if ($obj->{'legend_labels'}) {
	@labels = @{$obj->{'legend_labels'}};
	if ($#labels != $#{$dataref} - 1) {
	    croak ("Number of data set labels does not match number of data sets");
	}
    }
    else {
	for (1..$#{$dataref}) {
	    $labels[$_-1] = "Dataset $_";
	}
    }

    for (@labels) {
	my $str_len = length ($_);
	if ($str_len > $max_len) {
	    $max_len = $str_len;
	}
    }

    #===============#
    #  draw legend  #
    #===============#

    $ymin = $obj->{'y_min'} + $obj->{'graph_border'};

    if (!($obj->{'dashed_lines'})) {
	$legend_h = ($#labels + 1) * ($h + 2 * $obj->{'text_space'});
	$legend_w = ($max_len * $w) + 3 * $obj->{'text_space'};
	$obj->{'x_max'} -= $legend_w + 2 * $obj->{'text_space'};
	
	$obj->{'im'}->rectangle ($obj->{'x_max'} + 2 * $obj->{'text_space'},
				 $ymin,
				 $obj->{'x_max'} + 2 * $obj->{'text_space'} 
			             + $legend_w,
				 $ymin + $legend_h,
				 $black);
	
	for (0..$#labels) {
	    $color = $obj->data_color($_);
	    
	    $obj->{'im'}->string (gdSmallFont,
				  $obj->{'x_max'} + 7,
				  $ymin + $obj->{'text_space'} 
			              + $_ * ($h + 2 * $obj->{'text_space'}),
				  $labels[$_],
				  $color);
	}
    }
    else {
	$legend_h = ($#labels + 1) * ($h + 2 * $obj->{'text_space'});
	$legend_w = ($max_len * $w) + 3 * $obj->{'text_space'} + 22;
	$obj->{'x_max'} -= $legend_w + 2 * $obj->{'text_space'} + 22;
	
	$obj->{'im'}->rectangle ($obj->{'x_max'} + 2 * $obj->{'text_space'},
				 $ymin,
				 $obj->{'x_max'} + 2 * $obj->{'text_space'} 
			             + $legend_w,
				 $ymin + $legend_h,
				 $black);
	
	$dash = $obj->{'dashed_lines'};
	$obj->{'dashed_lines'} = '';

	for (0..$#labels) {
	    $color = $obj->data_color($_);
	    
	    $obj->{'im'}->string (gdSmallFont,
				  $obj->{'x_max'} + 29,
				  $ymin + $obj->{'text_space'} 
				      + $_ * ($h + 2 * $obj->{'text_space'}),
				  $labels[$_],
				  $color);
	}

	$obj->{'dashed_lines'} = $dash;

	for (0..$#labels) {
	    $color = $obj->data_color($_);
	    
	    $obj->{'im'}->line ($obj->{'x_max'} + 7,
				$ymin + $obj->{'text_space'} + $h/2
				    + $_ * ($h + 2 * $obj->{'text_space'}),
				$obj->{'x_max'} + 27,
				$ymin + $obj->{'text_space'} + $h/2
				    + $_ * ($h + 2 * $obj->{'text_space'}),
				$color);
	}
    }
}

sub sort_data {
    my $obj = shift;
    my $dataref = $obj->{'data'};
    my ($order, $set, $type);
    my ($ref, $i, $j);

    if ($obj->{'nosort'}) { return }

    if (ref ($obj->{'sort'})) {
	($order, $set, $type) = @{$obj->{'sort'}};
    }
    else {
	$order = $obj->{'sort'};
    }

    $set = 0 unless ($set);
    $type = 'alpha' unless ($type);

    for $i (0..$#{$dataref->[0]}) {
	for $j (0..$#{$dataref}) {
	    $ref->[$i][$j] = $dataref->[$j][$i];
	}
    }
    
    if ($order eq 'asc') {
	if ($type eq 'alpha') {
            @{$ref} = sort {$Chart::Base::a->[$set] cmp $Chart::Base::b->[$set]}
	                       @{$ref};
	}
	else {
	    @{$ref} = sort {$Chart::Base::a->[$set] <=> $Chart::Base::b->[$set]}
	                       @{$ref};
	} 
    }
    else {
	if ($type eq 'alpha') {
            @{$ref} = sort {$Chart::Base::b->[$set] cmp $Chart::Base::a->[$set]}
	                       @{$ref};
        }
        else {
            @{$ref} = sort {$Chart::Base::b->[$set] <=> $Chart::Base::a->[$set]}
                               @{$ref};
        }   
    }
    
    for $i (0..$#{$dataref->[0]}) {
        for $j (0..$#{$dataref}) {
            $dataref->[$j][$i] = $ref->[$i][$j];
        }
    }
					    
    
    $obj->{'data'} = $dataref;
}

sub draw_axes {
    my $obj = shift;
    my $black = $obj->get_color ('black');
    
    $obj->{'im'}->rectangle ($obj->{'x_min'}, $obj->{'y_min'},
			     $obj->{'x_max'}, $obj->{'y_max'},
			     $black);
}

sub set_user_colors {
    my $obj = shift;
    my @rgbs = @{$obj->{'colors'}};

    for (@rgbs) {
	if ($_) {
	    $obj->{'im'}->colorAllocate (@{$_});
	}
    }
}

sub get_color {
    my $obj = shift;
    my $color = shift;
    my %colors = ('white' => [250,250,250],
		  'black' => [0,0,0],
		  'red' => [225,0,0],
		  'green' => [0,225,0],
		  'blue' => [0,0,225],
		  'purple' => [200,0,200],
		  'light_blue' => [0,200,200],
		  'yellow' => [225,225,0],
		  'orange' => [250,170,85],
		  'grey' => [200,200,200]);
    my @rgb = (defined($colors{$color})) ? @{$colors{$color}} : (0,0,0);

    return $obj->{'im'}->colorClosest(@rgb);
}

sub data_color {
    my $obj = shift;
    my $num = shift;
    my %colors = (0 => 'red',
		  1 => 'blue',
		  2 => 'green',
		  3 => 'purple',
		  4 => 'orange',
		  5 => 'light_blue',
		  6 => 'yellow');
    my ($col,%dots);

    $col = ($obj->{'colors'}->[$num]) 
    		? $obj->{'im'}->colorClosest (@{$obj->{'colors'}->[$num]})
		: $obj->get_color ($colors{$num});

    %dots = (4 => [$col],
             0 => [$col,$col,gdTransparent],
	     1 => [$col,$col,$col,$col,$col,$col,gdTransparent,gdTransparent,gdTransparent,$col,$col,$col,gdTransparent,gdTransparent,gdTransparent],
	     2 => [$col,$col,$col,$col,$col,$col,$col,$col,gdTransparent,gdTransparent,gdTransparent,gdTransparent],
	     3 => [$col,$col,$col,$col,gdTransparent,gdTransparent]);

    if ($obj->{'dashed_lines'} && $obj->{'dashed_lines'} ne '') {
        $obj->{'im'}->setStyle ((@{$dots{$num}}) 
	              ? @{$dots{$num}} : ($col,gdTransparent));
	return gdStyled;
    }
    else {
        return $col;
    }
}

1;
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)