App-Widget-ChartDirector
view release on metacpan or search on metacpan
lib/App/Widget/ChartDirector.pm view on Meta::CPAN
$num_dims = 2 if (!defined $num_dims);
&App::sub_exit($num_dims) if ($App::trace);
return($num_dims);
}
sub new_xy_chart {
&App::sub_entry if ($App::trace);
my ($self, $spec) = @_;
require "perlchartdir.pm";
my $x = $self->get_x($spec); # print STDERR Dumper $x;
my $width = $spec->{width} || 250;
my $height = $spec->{height} || 250;
my $left_margin = $spec->{left_margin};
my $bottom_margin = $spec->{bottom_margin};
my $right_margin = $spec->{right_margin} || 20;
my $top_margin = $spec->{top_margin};
my $plot_bgcolor = $self->get_theme_value("plot_bgcolor", "0xfffcf0");
my $bgcolor = $self->get_theme_value("bgcolor", "0x3f65b8");
my $titlecolor = $self->get_theme_value("titlecolor", "0xfffcf0");
my $x_labelcolor = $self->get_theme_value("x_labelcolor", "0xfffcf0");
my $y_labelcolor = $self->get_theme_value("y_labelcolor", "0xfffcf0");
my $y_titlecolor = $self->get_theme_value("y_titlecolor", "0xfffcf0");
my $y_max_zero = 1;
if (!$top_margin) {
$top_margin = 5;
$top_margin += 20 if ($spec->{title});
#$top_margin += 20 if ($spec->{y_labels});
$top_margin += 8 if ($spec->{"3D"});
}
if (!$bottom_margin) {
$bottom_margin = 10;
$bottom_margin += 9 if (!$spec->{registered});
$bottom_margin += 15 if ($x);
$bottom_margin += 18 if ($spec->{x_title});
}
if (!$left_margin) {
# TODO: This should be sensitive to the width of the numbers in the scale
my ($y_min, $y_max) = $self->get_y_limits($spec);
$y_min = int($y_min);
$y_max = int($y_max);
$y_max_zero = int($y_max);
my $y_label_len = length($y_max);
$y_label_len = length($y_min) if (length($y_min) > $y_label_len);
$left_margin = 20 + $y_label_len * 6;
$left_margin += 20 if ($spec->{y_title});
}
my ($total_x_length, @x_values);
if ($spec->{x_label_pos}) {
foreach (@$x){
$total_x_length += length($_) + 2; #Taking 2 as the gap value
push (@x_values, length($_));
}
@x_values = sort { $a <=> $b} @x_values;
$self->{total_x_length} = $total_x_length;
$self->{width} = $width;
if ($total_x_length > $width/8 && $x->[0] !~ /^[0-9]{4}-[0-9]{2}-[0-9]{2}$/) {
$width += ($#$x) * ceil (3 * $#$x / 100 ) + 0.5 if ($#$x > 50);
}
}
my $legend_pos = $spec->{legend_pos} || "default"; # Any one from default, top or bottom
my (@length_y_value, $max_legend_length, $num_legend_columns, $legend_width, $margin, $textsize, $number_legend_rows, $length_labels, $length_labels_avg);
my (@length_all_labels, $diff_largest_and_avg, $gap_legends);
if ($legend_pos ne "default") {
$legend_width = $width - 2 * $right_margin;
($margin,$textsize) = (6,10);
$max_legend_length = ceil ( $legend_width / ($textsize * 3/4)); # This is a nearyby approximation of number of characters inside a row in the legends
$length_labels = 0;
foreach my $y_value (@{$spec->{y_labels}}) {
$length_labels += length($y_value);
push (@length_all_labels, length($y_value) );
}
@length_all_labels = sort { $a <=> $b } @length_all_labels;
$length_labels_avg = ceil ($length_labels / ($#{$spec->{y_labels}} + 1));
$diff_largest_and_avg = $length_all_labels[-1] - $length_labels_avg;
# Calculation of gap b/w the legends
$gap_legends = $margin;
if($diff_largest_and_avg > $gap_legends) {
$gap_legends += ceil ($diff_largest_and_avg / 2);
}
else {
$gap_legends += 1;
$gap_legends -= ceil ($diff_largest_and_avg - $gap_legends / 3) if ($length_labels_avg >= $max_legend_length / 4); # Reduce gap if the average length of legends is higher than max. legend length by 4.
}
# Calculation of number of columns
for (my $cols = 1; $cols <= 20; $cols++) { # Taking min. 1 and max. 20 columns
$num_legend_columns = $cols if (($length_labels_avg + $gap_legends) < ($max_legend_length / $cols));
}
$num_legend_columns += 1 if (($length_labels_avg + $gap_legends) > ($max_legend_length / 2)); #Add a new column if the avg. legend length is greater than half of the max. permissible length
if ($spec->{num_legend_columns} ) {
$num_legend_columns = $spec->{num_legend_columns};
}
do {
$num_legend_columns += 1 if ($height > (2 * $spec->{height})); #If the legend height is greater than max. permissible limit than add a new column and the legends will truncate
$height = $spec->{height};
$number_legend_rows = int (($#{$spec->{y_labels}} + 1) / $num_legend_columns);
if (($#{$spec->{y_labels}} + 1) % $num_legend_columns != 0 ) {
$number_legend_rows += 1;
}
$height += (($margin + $textsize) * $number_legend_rows) + (4 * $margin);
} while ($height > (2 * $spec->{height})); # Max. graph height should not be greater than twice of chosen graph height
if ($#{$spec->{y_labels}} <= 0) {
$height = $spec->{height};
}
}
my $graph_height_increment = 0;
my $fontsize = 10;
if ($spec->{x_label_pos}) {
if ($#$x > 30 && $total_x_length > $width/8 && $x->[0] !~ /^[0-9]{4}-[0-9]{2}-[0-9]{2}$/) {
for (my $i = 30; $i <= $#$x; $i++ ) {
$fontsize = $fontsize - 0.1;
$fontsize = 1 if ($fontsize < 1);
}
$fontsize += ceil(($width - $spec->{width})/$#$x) - 1 if ($#$x > 50);
}
$self->{fontsize} = $fontsize;
if ($total_x_length > $width/8 && $x->[0] !~ /^[0-9]{4}-[0-9]{2}-[0-9]{2}$/) {
$graph_height_increment = 1/2 * $x_values[-1] * floor ($fontsize);
$height += $graph_height_increment;
}
}
my $c = new XYChart($width, $height);
my $graph_adjusted_height = $height - $spec->{height}-$graph_height_increment;
my ($top_margin_adjusted,$bottom_margin_adjusted);
if ($legend_pos eq "top" ) {
$top_margin_adjusted = $top_margin+$graph_adjusted_height;
$bottom_margin_adjusted = $height-$top_margin-$bottom_margin-$graph_adjusted_height-$graph_height_increment;
}
elsif ($legend_pos eq "bottom") {
$top_margin_adjusted = $top_margin;
$bottom_margin_adjusted = $height-$top_margin-$bottom_margin-$graph_adjusted_height-$graph_height_increment;
}
else {
$top_margin_adjusted = $top_margin;
$bottom_margin_adjusted = $height-$top_margin-$bottom_margin-$graph_height_increment;
}
my $plot_area = $c->setPlotArea($left_margin , $top_margin_adjusted,
$width-$left_margin-$right_margin,
$bottom_margin_adjusted);
$spec->{plot_area_x} = $left_margin;
$spec->{plot_area_y} = $top_margin_adjusted;
$spec->{plot_area_width} = $width - $left_margin - $right_margin;
$spec->{plot_area_height} = $bottom_margin_adjusted;
$spec->{plot_bgcolor} = $plot_bgcolor;
$plot_area->setBackground(hex($plot_bgcolor), hex($plot_bgcolor));
$c->addTitle($spec->{title}, "arialbd.ttf", 12, hex($titlecolor)) if ($spec->{title});
if ($y_max_zero == 0) {
$c->yAxis()->setMargin($top_margin_adjusted + 15);
}
#Add a legend box at (55, 22) using horizontal layout, with transparent
#background
my $legend;
if ($spec->{y_labels}) {
my $x_adj = 0;
my $y_adj = -2;
if ($spec->{"3D"}) {
$x_adj += 5;
$y_adj += -5;
}
if (($#{$spec->{y_labels}} > 0) && ($legend_pos eq "top" || $legend_pos eq "bottom")) {
if ($legend_pos eq "top" ) {
$legend = $c->addLegend($right_margin, $top_margin + $y_adj, 0,"arial.ttf",10);
}
elsif ($legend_pos eq "bottom" ) {
$legend = $c->addLegend($right_margin, $height - $graph_adjusted_height - $top_margin/4 , 0,"arial.ttf",10);
}
$legend->setBackground(hex($plot_bgcolor));
$legend->setMargin(5);
$legend->setWidth($legend_width);
$legend->setCols($num_legend_columns);
$legend->setTruncate($legend_width,1);
}
else {
$legend = $c->addLegend($left_margin+$x_adj, $top_margin+$y_adj, 0);
$legend->setBackground($perlchartdir::Transparent);
$legend->setMargin(5);
}
}
# To handle the situation when the graph wrapping happens.
if ($legend_pos eq "top" || $legend_pos eq "bottom") {
my $graph_count = $spec->{graph_count} || 1;
$spec->{height} = $height if ($graph_count == 1);
}
if ($spec->{x_label_pos} && $total_x_length > $width/8 && $x->[0] !~ /^[0-9]{4}-[0-9]{2}-[0-9]{2}$/) {
$spec->{height} = $height;
$spec->{width} = $width;
}
$c->yAxis()->setTitle($spec->{y_title}, "arial.ttf", 10, hex($y_titlecolor)) if ($spec->{y_title});
$c->setBackground(hex($bgcolor));
$c->yAxis()->setLabelStyle("arial.ttf", 10, hex($y_labelcolor));
$c->xAxis()->setLabelStyle("arial.ttf", 10, hex($x_labelcolor));
if ($spec->{add_mark} ne "" || $spec->{add_mark2} ne "") {
my $value = $spec->{add_mark};
my $value2 = $spec->{add_mark2};
my $color = $spec->{add_mark_color};
my $color2 = $spec->{add_mark_color2};
$color =~ s/^#//;
$color = "000000" if (!$color || $color eq "none");
$color2 =~ s/^#//;
$color2 = "000000" if (!$color2 || $color2 eq "none");
my ($add_mark_vals);
foreach my $data ([$value, $color], [$value2, $color2]) {
my $hash = {};
if (defined $data->[0]) {
$hash->{value} = $data->[0];
$hash->{color} = $data->[1];
push (@$add_mark_vals, $hash);
}
}
foreach my $add_mark_val (@$add_mark_vals) {
my $amk_value = $add_mark_val->{value};
my $amk_color = $add_mark_val->{color};
if ($amk_value =~ /(?:^-)?\d+(?:\.)?(?:\d+)?$/ && length($amk_color) == 6) {
my $hex_color = hex($amk_color);
$c->yAxis()->addMark($amk_value, $c->dashLineColor($hex_color, $perlchartdir::DashLine));
}
}
}
if (defined $spec->{add_zone}) {
my @values = split(",", $spec->{add_zone});
foreach my $val (@values) {
my ($zone1, $zone2, $color) = split(":", $val);
$color =~ s/^#//;
if ($zone1 =~ /((?:^-)?\d+(?:\.)?(?:\d+)?)/) {
$zone1 = $1;
}
if ($zone2 =~ /((?:^-)?\d+(?:\.)?(?:\d+)?)/) {
$zone2 = $1;
}
if (length($color) == 6 && $zone1 ne "" && $zone2 ne "") {
lib/App/Widget/ChartDirector.pm view on Meta::CPAN
}
$layer->set3D(5) if ($spec->{"3D"});
if ($#$yn > 0) {
my ($stacked_y, $y, $dataset);
if ($spec->{stacked}) {
$stacked_y = [ ]; # make a copy
}
my $y_labels = $spec->{y_labels} || [];
for (my $i = 0; $i <= $#$yn; $i++) {
$y = $yn->[$i];
if ($spec->{stacked}) {
for (my $j = 0; $j <= $#$y; $j++) {
$stacked_y->[$j] += $y->[$j];
}
$y = $stacked_y;
}
#$dataset = $layer->addDataSet($y, -1, $y_labels->[$i]);
################
#we choose colors from @color_set
if($i <= 18) { # RNS 070831-000229
if ($#$data_set_colors != -1) {
$dataset = $layer->addDataSet($y, $data_set_colors->[$i], $y_labels->[$i]);
} else {
$dataset = $layer->addDataSet($y, hex($color_set[$i]), $y_labels->[$i]);
}
}
else {
#if number of y_labels is greater than 20, colors will be repeated
#we have declared only 20 colors
$dataset = $layer->addDataSet($y, hex($color_set[($i-19)]), $y_labels->[$i]); # RNS 070831-000229
}
###############
$dataset->setDataSymbol($self->sym($i, \@symbols)) if ($spec->{points});
}
}
elsif ($#$yn > -1) {
$layer = $c->addLineLayer($yn->[0]);
$layer->setLineWidth(2);
}
if ($spec->{point_labels}) {
my $label_format = $spec->{point_labels};
$label_format = "{value|0}" if ($label_format eq "1");
$layer->setDataLabelFormat($label_format);
}
$self->set_x_axis($spec, $c, $layer, $x);
$c->makeChart($spec->{image_path});
&App::sub_exit() if ($App::trace);
}
sub sym {
&App::sub_entry if ($App::trace);
my ($self, $series, $symbols) = @_;
my $idx = $series % ($#$symbols + 1);
my $symboldef = $symbols->[$idx];
&App::sub_exit($symboldef->{symbol}, $symboldef->{size}) if ($App::trace);
return($symboldef->{symbol}, $symboldef->{size});
}
##Add a legend box at (400, 100)
#$c->addLegend(400, 100);
##Add a stacked bar layer and set the layer 3D depth to 8 pixels
#my $layer = $c->addBarLayer2($perlchartdir::Stack, 8);
##Add the three data sets to the bar layer
#$layer->addDataSet($data0, 0xff8080, "Server # 1");
#$layer->addDataSet($data1, 0x80ff80, "Server # 2");
#$layer->addDataSet($data2, 0x8080ff, "Server # 3");
# TODO: this needs more work before it really works
sub write_meter_graph_image {
&App::sub_entry if ($App::trace);
my ($self, $spec) = @_;
my $c = $self->new_meter_chart($spec);
my $x = $self->get_x($spec);
my $yn = $self->get_y($spec) || [[]];
my $value = $yn->[0][0];
my $radius = $spec->{radius};
my $center_x = $spec->{center_x};
my $center_y = $spec->{center_y};
#my $y_max = $spec->{y_max} || 100;
my $y_max = $value || 100;
my ($major_tick, $minor_tick, $micro_tick);
{
my $y_mantissa = $y_max;
my $y_scale = 1;
while ($y_mantissa > 1.0) {
$y_mantissa /= 10;
$y_scale *= 10;
}
if ($y_mantissa > 0.5) {
$y_max = $y_scale;
$minor_tick = $y_max/10;
$micro_tick = $y_max/20;
}
elsif ($y_mantissa > 0.2) {
$y_max = 0.5 * $y_scale;
$minor_tick = $y_max/25;
$micro_tick = undef;
}
else {
$y_max = 0.2 * $y_scale;
$minor_tick = $y_max/10;
$micro_tick = $y_max/20;
}
$major_tick = $y_max/5;
}
my $y_red = $spec->{y_red} || ($y_max * 0.80);
my $y_yellow = $spec->{y_yellow} || ($y_max * 0.60);
#Meter scale is 0 - 100, with major tick every 20 units, minor tick every 10
#units, and micro tick every 5 units
$c->setScale(0, $y_max, $major_tick, $minor_tick, $micro_tick);
#Set 0 - 60 as green (66FF66) zone
$c->addZone(0, $y_yellow, 0, $radius, 0x66ff66);
lib/App/Widget/ChartDirector.pm view on Meta::CPAN
&App::sub_exit() if ($App::trace);
}
sub write_pie_graph_image {
&App::sub_entry if ($App::trace);
my ($self, $spec) = @_;
my $c = $self->new_pie_chart($spec);
my $x = $self->get_x($spec);
my $yn = $self->get_y($spec);
my $data;
foreach my $y (@$yn) { push (@$data, @{$y}); }
if ($#$x > 0) {
$c->setData($data, $x);
}
else {
$c->setData($data, $spec->{y_labels});
}
# The depths for the sectors
#my $depths = [30, 20, 10, 10];
#$c->set3D2($depths);
#$c->setStartAngle(225);
$c->set3D() if ($spec->{"3D"});
$c->makeChart($spec->{image_path});
&App::sub_exit() if ($App::trace);
}
#my $data = [25, 18, 15, 12, 8, 30, 35];
##The labels for the pie chart
#my $labels = ["Labor", "Licenses", "Taxes", "Legal", "Insurance", "Facilities",
# "Production"];
##Create a PieChart object of size 360 x 300 pixels
#my $c = new PieChart(360, 300);
##Set the center of the pie at (180, 140) and the radius to 100 pixels
#$c->setPieSize(180, 140, 100);
##Add a title to the pie chart
#$c->addTitle("Project Cost Breakdown");
##Draw the pie in 3D
#$c->set3D();
##Set the pie data and the pie labels
#$c->setData($data, $labels);
# TODO: This one doesn't work yet
sub write_step_graph_image_step {
&App::sub_entry if ($App::trace);
my ($self, $spec) = @_;
require "perlchartdir.pm";
#Create a XYChart object of size 500 x 270 pixels, with a pale blue (0xe0e0ff)
#background, a light blue (0xccccff) border, and 1 pixel 3D border effect.
my $c = new XYChart(600, 350, 0xe0e0ff, 0xccccff, 1); #800
#Set the plotarea at (50, 50) and of size 420 x 180 pixels, using white
#(0xffffff) as the plot area background color. Turn on both horizontal and
#vertical grid lines with light grey color (0xc0c0c0)
$c->setPlotArea(50, 50, 320, 260, 0xffffff)->setGridColor(0xc0c0c0, 0xc0c0c0); #720
#Add a legend box at (55, 25) (top of the chart) with horizontal layout. Use 10
#pts Arial Bold Italic font. Set the background and border color to Transparent.
$c->addLegend(55, 20, 0, "arialbi.ttf", 10)->setBackground($perlchartdir::Transparent);
#Add a title to the chart using 14 points Times Bold Itatic font, using blue
#(0x9999ff) as the background color
$c->addTitle("Rate History", "arialbi.ttf", 12)->setBackground(0x9999ff);
#Set the y axis label format to display a percentage sign
#$c->yAxis()->setLabelFormat("{value}%");
my $labels = $spec->{labels} || [ "Unknown" ];
my $default_colors =
[ 0x0000ff, 0x00ff00, 0xff0000, 0x00ffff, 0xff00ff, 0xffff00,
0x111199, 0x119911, 0x991111, 0x119999, 0x991199, 0x999911,
0x3333dd, 0x33dd33, 0xdd3333, 0x33dddd, 0xdd33dd, 0xdddd33,
0x2222bb, 0x22bb22, 0xbb2222, 0x22bbbb, 0xbb22bb, 0xbbbb22 ];
my $colors = $spec->{colors} || $default_colors;
my ($label, $color, $step_xaxis, $xaxis, $yaxis, $layer);
for (my $i = 0; $i <= $#$labels; $i++) {
$label = $labels->[$i];
$color = $colors->[$i] || 0;
if ($color =~ /^0[xX][0-9A-Fa-f]+$/) {
$color = eval $color;
}
$xaxis = $spec->{"x$i"} || [ $i, $i+1, $i+2, $i+3 ];
$yaxis = $spec->{"y$i"} || [ $i, $i+1, $i+2, $i+3 ];
# set the xAxis scale
#$c->xAxis()->setLinearScale($xaxis->[0] - 1, $xaxis->[$#$xaxis], 1, 0);
$c->xAxis()->setAutoScale(0,0,1);
$c->yAxis()->setAutoScale(0,0,1);
$c->xAxis()->setIndent(1);
# we decrement the $step_xaxis values by a day to account for the fact that
# the step function runs from left to right but that the spec-> occurred
# from right to left.
$step_xaxis = [ @$xaxis ]; # make a copy
for (my $x = 0; $x <= $#$step_xaxis; $x++) {
$step_xaxis->[$x]--;
}
#Add a step line layer to the chart and set the line width to 2 pixels
$layer = $c->addStepLineLayer($yaxis, $color, $label);
#$layer->setXData($step_xaxis);
$layer->setLineWidth(2);
# Add a line layer to the chart
# $layer = $c->addLineLayer();
# Add the line. Plot the points with a 9 pixel diamond symbol
# $layer->addDataSet($yaxis, $color)->setDataSymbol( $perlchartdir::DiamondSymbol, 9);
# Enable data label on the data points. Set the label format to nn%.
# $layer->setDataLabelFormat("{value}");
}
print $c->makeChart($spec->{image_path});
&App::sub_exit() if ($App::trace);
}
sub write_step_graph_image {
( run in 1.290 second using v1.01-cache-2.11-cpan-df04353d9ac )