### ====================================================================== ### use ### ====================================================================== # --- Perl Core ------------------- use strict; use warnings; use Data::Dumper; # --- Extension ------------------- use List::Util qw(min max sum); use POSIX qw(ceil); use Win32; # --- GRAPHICS -------------------- use GD; use GD::Graph::hbars; use GD::Graph::lines; use GD::Graph::points; use GD::Graph::linespoints; ### ====================================================================== ### BUILD your data struct and plot options, then call plot ### ====================================================================== ### ---------------------------------------------------------- ### build plot @data) @data = ([], []); foreach { push @{$data[0]}, ; push @{$data[1]}, ; } # print Dumper(\@data); ### ---------------------------------------------------------- ### Plot my $s = sum(@{$data[1]}); # Sum all data pts. my $max = max(@{$data[1]}); # Max val. data pt. my ($ymax, $yticks) = scale($max,100); my %opt = ( title => "", x_label => "", y_label => "', y_max_value => $ymax, y_tick_number => $yticks, y_number_format => "%3d", show_values => 1, ); $opt{y_max_value} = $max + 100; # Fixed $opt{y_tick_number} = 10; plot(\%opt, \@data, 'hb'); $opt{title} .= '-'; $opt{y_max_value} = $ymax; # Float $opt{y_tick_number} = $yticks; plot(\%opt, \@data, 'hb'); ### ====================================================================== ### UTIL: scale ### ====================================================================== sub scale { my ($max, $delta) = @_; $delta ||= $max * 0.1; $max = ceil(($max + $delta) / 10) * 10; my $ticks = min (ceil($max+$delta), 10); return ($max, $ticks); } ### ====================================================================== ### UTIL: plot (using GD::Graph::$type) ### ====================================================================== sub plot { ### Set options for graph, cf params and defaulta my ($rOpt, $rData, $type, $x, $y) = @_; # %Opt, @data, ... $type ||= 'hb'; # Default horiz. bars $x ||= max(scalar(@{$rData->[1]})*20, 150); # Scale to num. data.pts $y ||= 400; # Fixed (dyn: max(ceil($s/2), 400);) my @opt = %{$rOpt}; # Flatten option hash to array my $graph; # (width:y, height:x) if ($type eq 'pt') { $graph = GD::Graph::points->new($y, $x); } if ($type eq 'lp') { $graph = GD::Graph::linespoints->new($y, $x); } if ($type eq 'hb') { $graph = GD::Graph::hbars->new($y, $x); } $graph->set_x_axis_font(gdTinyFont); # $graph->set(logo => ".\\KMD.gif", # logo_resize => 0.5, # logo_position => "LL", ); $graph->set(@opt) or die $graph->error; ### Plot graph, cf @$rData array # print "Plot: ", Dumper(\$rData); my $gd = $graph->plot($rData) or die $graph->error; my ($cwd, $tgt); $cwd = Win32::GetCwd(); foreach my $dir ("plot", "plot\\$PID") { $tgt = "$cwd\\$dir"; unless (-e $tgt and -d $tgt) { mkdir($tgt) or die "can't mkdir '$tgt': $!"; } } open(IMG, ">$tgt\\$rOpt->{title}.png") or die "can't open $tgt\\$t.png: $!"; binmode IMG; print IMG $gd->png; }