#!/usr/bin/perl -w
#
# $Id: bargraph_multi.pm
#

use strict;
use diagnostics ;
package bargraph_multi ;
use Exporter () ;
@bargraph_multi::ISA = qw(Exporter) ;
@bargraph_multi::EXPORT = qw(Build_Labeled_X_Axis_Graph_Str Build_Labeled_X_Axis_Graph_Obj
			Build_Labeled_X_Axis_Graph_Obj_opts Build_Labeled_X_Axis_Graph_Str_opts ) ;
@bargraph_multi::EXPORT_OK = qw( ) ;
use GD;
use GD::Graph::colour;
use GD::Graph::bars;
use GD::Graph::hbars;
use GD::Graph::bars3d;
#use Data::Dumper;



# This perl code is builds Graphs using the GD::Graph modules.
# This code deals with a non-numeric X-Axis.  Each tick on the X-Axis is the name of a group.
#   The other style has a numeric X-Axis.
sub Build_Labeled_X_Axis_Graph_Str {
# The parameters are:
# $Data_In - A reference to a list of lists.  (aka, Array of Arrays)
#		Each of the sublists has the same number of elements.
#      An element might be the undef value.
#   The first sublist is the names of the groups.
#   The other sublists are related to the elements in the $Legend parameter.
# $Legend - A reference to a list.
#		Each element of the list is the name of a group.
#   The data for each group is a sublist in the $Data_In parameter.
# ---- The rest of the parameters are individual options as scalars: numbers, character strings, or undef.
# The returned value is a list of (reference to the plotted graphical object, and graphic string in the mode.
	my ($Data_In, $Legend, $Graphic_Mode, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, 
			$ymax, $ymin, $yticknum, $t_margin, $b_margin, $l_margin, $r_margin, 
			$colorscheme, $bar_spacing, $bargroup_spacing,
			$show_values, $x_label_position, $y_label_position, $transparent, $overwrite, 
			$interlaced, $bgclr, $fgclr, $boxclr, $accentclr, $shadowclr, $shadow_depth,
			$labelclr, $axislabelclr, $legendclr, $valuesclr, $textclr, $dclrs, $borderclrs,
			$cycle_clrs, $accent_treshold, $long_ticks, $tick_length, $x_ticks, $y_number_format,
			$x_label_skip, $y_label_skip, $x_last_label_skip, $x_tick_offset, $x_all_ticks,
			$x_labels_vertical, $x_plot_values, $y_plot_values,
			$box_axis, $no_axes, $two_axes, $use_axis, $zero_axis, $zero_axis_only, $axis_space,
			$text_space, $cumulate, $correct_width, $values_vertical, $values_space,
			$values_format, $legend_placement, $legend_marker_width, $legend_marker_height, $lg_cols
			) = @_ ;
	my $Graph_Obj ;
	$Graph_Obj = &Build_Labeled_X_Axis_Graph_Obj 
	 	($Data_In, $Legend, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, 
			$ymax, $ymin, $yticknum, $t_margin, $b_margin, $l_margin, $r_margin, 
			$colorscheme, $bar_spacing, $bargroup_spacing,
			$show_values, $x_label_position, $y_label_position, $transparent, $overwrite,
			$interlaced, $bgclr, $fgclr, $boxclr, $accentclr, $shadowclr, $shadow_depth,
			$labelclr, $axislabelclr, $legendclr, $valuesclr, $textclr, $dclrs, $borderclrs,
			$cycle_clrs, $accent_treshold, $long_ticks, $tick_length, $x_ticks, $y_number_format,
			$x_label_skip, $y_label_skip, $x_last_label_skip, $x_tick_offset, $x_all_ticks,
			$x_labels_vertical, $x_plot_values, $y_plot_values,
			$box_axis, $no_axes, $two_axes, $use_axis, $zero_axis, $zero_axis_only, $axis_space,
			$text_space, $cumulate, $correct_width, $values_vertical, $values_space,
			$values_format, $legend_placement, $legend_marker_width, $legend_marker_height, $lg_cols ) ;
	my $Plotted_Str ;
	unless (defined $Graph_Obj) {
		return (undef, "") ;
	} else {
		if ($Graphic_Mode =~ m/png/i) {
			$Plotted_Str = $Graph_Obj -> png ;
		} elsif ($Graphic_Mode =~ m/gif/i) {
			$Plotted_Str = $Graph_Obj -> gif ;
		} else {
			return ($Graphic_Mode, "Unsupported Graphical Mode $Graph_Obj.\n") ;
		}
	}
	return ($Graph_Obj, $Plotted_Str) ;
}
			

sub Build_Labeled_X_Axis_Graph_Obj {
	my ($Data_In, $Legend, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, 
			$ymax, $ymin, $yticknum, $t_margin, $b_margin, $l_margin, $r_margin, 
			$colorscheme, $bar_spacing, $bargroup_spacing,
			$show_values, $x_label_position, $y_label_position, $transparent, $overwrite,
			$interlaced, $bgclr, $fgclr, $boxclr, $accentclr, $shadowclr, $shadow_depth,
			$labelclr, $axislabelclr, $legendclr, $valuesclr, $textclr, $dclrs, $borderclrs,
			$cycle_clrs, $accent_treshold, $long_ticks, $tick_length, $x_ticks, $y_number_format,
			$x_label_skip, $y_label_skip, $x_last_label_skip, $x_tick_offset, $x_all_ticks,
			$x_labels_vertical, $x_plot_values, $y_plot_values,
			$box_axis, $no_axes, $two_axes, $use_axis, $zero_axis, $zero_axis_only, $axis_space,
			$text_space, $cumulate, $correct_width, $values_vertical, $values_space,
			$values_format, $legend_placement, $legend_marker_width, $legend_marker_height, $lg_cols ) = @_ ;
	# $colorscheme is a colon seperated string of colors.
	my $HBI_Debug_Obj = 0 ;
	my $Data_In_sublist ; my $Data_In_cnt = 0 ;

	if ($HBI_Debug_Obj) {
		warn "INFO: " . __FILE__ . " Parm List Legend array len is $#{$Legend}.\n" ;
		foreach $Data_In_sublist (@{$Data_In}) {
			warn "INFO: Data array len is $#{$Data_In_sublist}.\n" ;
			$Data_In_cnt ++ ;
		}
		warn "INFO: Data array $Data_In_cnt elements.\n" ;
	}

	my $graph;
	if ($hbar) {
    #print STDERR "hbar set\n";
    $graph = GD::Graph::hbars->new($xdim,$ydim);
	} else {
    $graph = GD::Graph::bars->new($xdim,$ydim);
    #print STDERR "hbar not set\n";
	}
	my @ret_colour_names_avail = () ;
	my %valid_colour_name = () ;
	@ret_colour_names_avail = GD::Graph::colour::colour_list(59) ;
	for my $clr_name (@ret_colour_names_avail) {
  	if (defined $clr_name) {$valid_colour_name{$clr_name} = 1;}
	}

# The keys of the hash array valid_colour_name are the known color names.

# warn $full_colour_list ;
# warn "The number of colours is $#ret_colour_names_avail ." ;
# The colors I found at one time are: pink lbrown lred purple 
# dblue lpurple green white gold blue dyellow red lgreen marine 
# dred cyan yellow lblue orange lgray dgreen dbrown lyellow 
# black gray dpink dgray lorange dpurple

# Set blue yellow if the colorscheme parameter is 1.
# else use the default.
if ($colorscheme and $colorscheme ==1) {
	$graph->set( dclrs => [ qw(blue yellow) ] ); 
} elsif ($colorscheme) {
	my @new_colors = split /:/ , $colorscheme ;
	my $index = 0 ;
	my $colors = $graph->get('dclrs');
	my $color ;
	foreach $color (@new_colors) {
		if ($valid_colour_name{$color} ) {
			# warn "Pushed $color ." ;
			$colors->[$index] = $color ;
			$index ++ ;
		} else {
			warn "Invalid color $color requested." ;
		}
	}
	# warn "Setting dclrs." ;
	$graph->set( dclrs => $colors) ;
	# warn "Set dclrs." ;
}


my %opt = ('transparent' => 0,
	   'x_label_position' => 0.5,
	   'show_values' => 1,
	   'y_max_value' => 100,
	   'overwrite' => 0);
if ($title) {$opt{'title'} = $title;}
if ($xlabel) {$opt{'x_label'} = $xlabel;}
if ($ylabel) {$opt{'y_label'} = $ylabel;}
if ($ymax) {$opt{'y_max_value'} = $ymax;}
if ($ymin) {$opt{'y_min_value'} = $ymin;}
if ($t_margin) {$opt{'t_margin'} = $t_margin;}
if ($b_margin) {$opt{'b_margin'} = $b_margin;}
if ($l_margin) {$opt{'l_margin'} = $l_margin;}
if ($r_margin) {$opt{'r_margin'} = $r_margin;}
if ($yticknum) {$opt{'y_tick_number'} = $yticknum;}
if ($bar_spacing) {$opt{'bar_spacing'} = $bar_spacing;}
if ($bargroup_spacing) {$opt{'bargroup_spacing'} = $bargroup_spacing;}
if ($show_values) {$opt{'show_values'} = $show_values;}
if ($x_label_position) {$opt{'x_label_position'} = $x_label_position;}
if ($y_label_position) {$opt{'y_label_position'} = $y_label_position;}
if ($transparent) {$opt{'transparent'} = $transparent;}
if ($overwrite) {$opt{'overwrite'} = $overwrite;}
if ($interlaced) {$opt{'interlaced'} = $interlaced;}
if ($bgclr) {$opt{'bgclr'} = $bgclr;}
if ($fgclr) {$opt{'fgclr'} = $fgclr;}
if ($boxclr) {$opt{'boxclr'} = $boxclr;}
if ($accentclr) {$opt{'accentclr'} = $accentclr;}
if ($shadowclr) {$opt{'shadowclr'} = $shadowclr;}
if ($shadow_depth) {$opt{'shadow_depth'} = $shadow_depth;}
if ($labelclr) {$opt{'labelclr'} = $labelclr ;}
if ($axislabelclr) {$opt{'axislabelclr'} = $axislabelclr ;}
if ($legendclr) {$opt{'legendclr'} = $legendclr ;}
if ($valuesclr) {$opt{'valuesclr'} = $valuesclr ;}
if ($textclr) {$opt{'textclr'} = $textclr ;}
if ($dclrs) {$opt{'dclrs'} = $dclrs ;}
if ($borderclrs) {$opt{'borderclrs'} = $borderclrs ;}
if ($cycle_clrs) {$opt{'cycle_clrs'} = $cycle_clrs ;}
if ($accent_treshold) {$opt{'accent_treshold'} = $accent_treshold ;}
if ($long_ticks) {$opt{'long_ticks'} = $long_ticks ;}
if ($tick_length) {$opt{'tick_length'} = $tick_length ;}
if ($x_ticks) {$opt{'x_ticks'} = $x_ticks ;}
if ($y_number_format) {$opt{'y_number_format'} = $y_number_format ;}
if ($x_label_skip) {$opt{'x_label_skip'} = $x_label_skip ;}
if ($y_label_skip) {$opt{'y_label_skip'} = $y_label_skip ;}
if ($x_last_label_skip) {$opt{'x_last_label_skip'} = $x_last_label_skip ;}
if ($x_tick_offset) {$opt{'x_tick_offset'} = $x_tick_offset ;}
if ($x_all_ticks) {$opt{'x_all_ticks'} = $x_all_ticks ;}
if ($x_label_position) {$opt{'x_label_position'} = $x_label_position ;}
if ($y_label_position) {$opt{'y_label_position'} = $y_label_position ;}
if ($x_labels_vertical) {$opt{'x_labels_vertical'} = $x_labels_vertical ;}
if ($x_plot_values) {$opt{'x_plot_values'} = $x_plot_values ;}
if ($y_plot_values) {$opt{'y_plot_values'} = $y_plot_values ;}
if ($box_axis) {$opt{'box_axis'} = $box_axis ;}
if ($no_axes) {$opt{'no_axes'} = $no_axes ;}
if ($two_axes) {$opt{'two_axes'} = $two_axes ;}
if ($use_axis) {$opt{'use_axis'} = $use_axis ;}
if ($zero_axis) {$opt{'zero_axis'} = $zero_axis ;}
if ($zero_axis_only) {$opt{'zero_axis_only'} = $zero_axis_only ;}
if ($axis_space) {$opt{'axis_space'} = $axis_space ;}
if ($text_space) {$opt{'text_space'} = $text_space ;}
if ($cumulate) {$opt{'cumulate'} = $cumulate ;}
if ($overwrite) {$opt{'overwrite'} = $overwrite ;}
if ($correct_width) {$opt{'correct_width'} = $correct_width ;}
if ($values_vertical) {$opt{'values_vertical'} = $values_vertical ;}
if ($values_space) {$opt{'values_space'} = $values_space ;}
if ($values_format) {$opt{'values_format'} = $values_format ;}
if ($legend_placement) {$opt{'legend_placement'} = $legend_placement ;}
if ($legend_marker_width) {$opt{'legend_marker_width'} = $legend_marker_width ;}
if ($legend_marker_height) {$opt{'legend_marker_height'} = $legend_marker_height ;}
if ($lg_cols) {$opt{'lg_cols'} = $lg_cols ;}

if ((defined $Legend) && (ref($Legend) eq "ARRAY") && ($#{${Legend}} >= 0)) {
	$graph -> set_legend(@{$Legend}) ;
} else {
	warn "ERROR: Empty Legend array passed to XXX." ;
}

$graph->set(%opt) or die $graph->error;
$graph->set_title_font(gdGiantFont);
$graph->set_x_label_font(gdGiantFont);
$graph->set_y_label_font(gdGiantFont);
$graph->set_x_axis_font(gdGiantFont);
$graph->set_y_axis_font(gdGiantFont);
$graph->set_values_font(gdGiantFont);
$graph->set_legend_font(gdGiantFont);

my $gd = $graph->plot($Data_In) ;

return $gd

}

# This perl code is builds Graphs using the GD::Graph modules.
# This code deals with a non-numeric X-Axis.  Each tick on the X-Axis is the name of a group.
#   The other style has a numeric X-Axis.
sub Build_Labeled_X_Axis_Graph_Str_opts {
# The parameters are:
# $Data_In - A reference to a list of lists.  (aka, Array of Arrays)
#		Each of the sublists has the same number of elements.
#      An element might be the undef value.
#   The first sublist is the names of the groups.
#   The other sublists are related to the elements in the $Legend parameter.
# $Legend - A reference to a list.
# $opts - A reference to a hash array of parameters.
#   We use the standard options for the GRAPH package.
#   We add Graphic_Mode for PNG or GIF.
#   We add the fonts to use for text.  The default font is a large font.
# The returned value is a list of (reference to the plotted graphical object, and graphic string in the mode.
	my ($Data_In, $Legend, $opts) = @_ ;
	my $Graph_Obj ;
	$Graph_Obj = &Build_Labeled_X_Axis_Graph_Obj_opts ($Data_In, $Legend, $opts) ;
	my $Graphic_Mode = $opts->{'Graphic_Mode'} ;
	unless (defined $Graphic_Mode) {$Graphic_Mode = "png" ;}
	my $Graphic_Mode_ref = ref $Graphic_Mode ;
	if ($Graphic_Mode_ref) {
		return ($Graph_Obj, "Unsupported Reference Graphical Mode $Graphic_Mode_ref.\n") ;
	}
	my $Plotted_Str ;
	unless (defined $Graph_Obj) {
		return (undef, "") ;
	} else {
		if ($Graphic_Mode =~ m/png/i) {
			$Plotted_Str = $Graph_Obj -> png ;
		} elsif ($Graphic_Mode =~ m/gif/i) {
			$Plotted_Str = $Graph_Obj -> gif ;
		} else {
			return ($Graph_Obj, "Unsupported Graphical Mode $Graphic_Mode.\n") ;
		}
	}
	return ($Graph_Obj, $Plotted_Str) ;
}

sub Build_Labeled_X_Axis_Graph_Obj_opts {
	my ($Data_In, $Legend, $opts ) = @_ ;
	# $colorscheme is a colon seperated string of colors.
	my $HBI_Debug_Obj = 0 ;
	my $Data_In_sublist ; my $Data_In_cnt = 0 ;

	if ($HBI_Debug_Obj) {
		warn "INFO: " . __FILE__ . " Opts Legend array len is $#{$Legend}.\n" ;
		foreach $Data_In_sublist (@{$Data_In}) {
			warn "INFO: Data array len is $#{$Data_In_sublist}.\n" ;
			warn "Info: Elements " . join(" ", @{$Data_In_sublist}) . " X" ;
			$Data_In_cnt ++ ;
		}
		warn "INFO: Data array $Data_In_cnt elements.\n" ;
		if (defined $Data_In) {
			my $Data_In_ref = ref $Data_In ;
			if ($Data_In_ref) {
				warn "INFO: Data_In is a reference to a $Data_In_ref \n" ;
			} else {
				warn "INFO: Data_In is a scalar $Data_In \n" ;
			}
		} else {
			warn "ERROR: Data_In is not defined." ;
		}
	}
	my $hbar = $opts->{'hbar'} ;
	my $xdim = $opts->{'width'} ;
	my $ydim = $opts->{'height'} ;
	warn "INFO: hbar $hbar xdim $xdim ydim $ydim X" if ($HBI_Debug_Obj) ;
	my $graph;
	if ($hbar) {
    #print STDERR "hbar set\n";
    $graph = GD::Graph::hbars->new($xdim,$ydim);
	} else {
    $graph = GD::Graph::bars->new($xdim,$ydim);
    #print STDERR "hbar not set\n";
	}

	if ($HBI_Debug_Obj) {
		if (defined $graph) {
			my $graph_ref = ref $graph ;
			if ($graph_ref) {
				warn "INFO: graph is a reference to a $graph_ref \n" ;
			} else {
				warn "INFO: graph is a scalar $graph \n" ;
			}
		} else {
			warn "ERROR: graph is not defined." ;
		}
	}

	my @ret_colour_names_avail = () ;
	my %valid_colour_name = () ;
	@ret_colour_names_avail = GD::Graph::colour::colour_list(59) ;
	for my $clr_name (@ret_colour_names_avail) {
  	if (defined $clr_name) {$valid_colour_name{$clr_name} = 1;}
	}

# The keys of the hash array valid_colour_name are the known color names.

# warn $full_colour_list ;
# warn "The number of colours is $#ret_colour_names_avail ." ;
# The colors I found at one time are: pink lbrown lred purple 
# dblue lpurple green white gold blue dyellow red lgreen marine 
# dred cyan yellow lblue orange lgray dgreen dbrown lyellow 
# black gray dpink dgray lorange dpurple

# Set blue yellow if the colorscheme parameter is 1.
# else use the default.
	my $colorscheme = $opts->{'colorscheme'} ;
	if ((defined $colorscheme) and ($colorscheme eq 1)) {
		$graph->set( dclrs => [ qw(blue yellow) ] ); 
	} elsif ($colorscheme) {
		my @new_colors = split /:/ , $colorscheme ;
		my $index = 0 ;
		my $colors = $graph->get('dclrs');
		my $color ;
		foreach $color (@new_colors) {
			if ($valid_colour_name{$color} ) {
				# warn "Pushed $color ." ;
				$colors->[$index] = $color ;
				$index ++ ;
			} else {
				warn "Invalid color $color requested." ;
			}
		}
		# warn "Setting dclrs." ;
		$graph->set( dclrs => $colors) ;
		# warn "Set dclrs." ;
	}

	if ((defined $Legend) && (ref($Legend) eq "ARRAY") && ($#{${Legend}} >= 0)) {
		$graph -> set_legend(@{$Legend}) ;
	} else {
		warn "ERROR: Empty Legend array passed to XXX." ;
	}
	
	my %G_Opts = () ;
	my $key ;
	foreach $key (keys %{$opts}) {
		$G_Opts{$key} = $opts->{$key} ;
	}
	delete $G_Opts{'colorscheme'} ;
	delete $G_Opts{'hbar'} ;
	delete $G_Opts{'Graphic_Mode'} ;
	delete $G_Opts{'width'} ;
	delete $G_Opts{'height'} ;

	unless ($graph->set(%G_Opts)) {
		warn "ERROR: graph->set complained" ;
		warn $graph->error;
	}
	my $use_font ;
	$use_font = $opts->{'title_font'} ;
	if (defined $use_font) {
		$graph->set_title_font($use_font);
	} else {
		$graph->set_title_font(gdGiantFont);
	}
	$use_font = $opts->{'x_label_font'} ;
	if (defined $use_font) {
		$graph->set_x_label_font($use_font);
	} else {
		$graph->set_x_label_font(gdGiantFont);
	}
	$use_font = $opts->{'y_label_font'} ;
	if (defined $use_font) {
		$graph->set_y_label_font($use_font);
	} else {
		$graph->set_y_label_font(gdGiantFont);
	}
	$use_font = $opts->{'x_axis_font'} ;
	if (defined $use_font) {
		$graph->set_x_axis_font($use_font);
	} else {
		$graph->set_x_axis_font(gdGiantFont);
	}
	$use_font = $opts->{'y_axis_font'} ;
	if (defined $use_font) {
		$graph->set_y_axis_font($use_font);
	} else {
		$graph->set_y_axis_font(gdGiantFont);
	}
	$use_font = $opts->{'values_font'} ;
	if (defined $use_font) {
		$graph->set_values_font($use_font);
	} else {
		$graph->set_values_font(gdGiantFont);
	}
	$use_font = $opts->{'legend_font'} ;
	if (defined $use_font) {
		$graph->set_legend_font($use_font);
	} else {
		$graph->set_legend_font(gdGiantFont);
	}

	# my $gd = $graph->plot(@{$Data_In}) ; # rejected. Bad Data
	my $gd = $graph->plot($Data_In) ;

	if ($HBI_Debug_Obj) {
		if (defined $gd) {
			my $gd_ref = ref $gd ;
			if ($gd_ref) {
				warn "INFO: gd is a reference to a $gd_ref \n" ;
			} else {
				warn "INFO: gd is a scalar $gd \n" ;
			}
		} else {
			warn "ERROR: gd is not defined." ;
			warn "ERROR: graph error is " . $graph->error ;
		}
	}

	return $gd
}

1 ;