Graph-Chart
view release on metacpan or search on metacpan
lib/Graph/Chart.pm view on Meta::CPAN
rotation => -30, # an rotation of the text in degree
kerning_correction => 0.85, # a kerning correcting to correct align of text when rotated ( default 0.91 )
surround => { color => '0x0000ff' , thickness => 1 }, # create a frame around the text with the specified color and thickness
},
}, "
y => { # horizontal grid
color => '0x00fff0',' # color of the grid ( hex HTML value )
number => 8, # number of grid division
thickness => 1, # size of the division's line ( default = 1 )
label => { # an optional label on the bottom side
font => '/usr/lib/cinelerra/fonts/trebuc.ttf', # a TrueType font to use
color => '0xff0000',', # the color of the label
size => 12, # the size of the font
text => [ 100, undef, '20', undef, 1585, undef, 555 ], # the text to render ( a undef element is not ploted, this allow to skip some label )
# space => 10, # an extra space between the division and the text
rotation => 45, # an rotation of the text in degree
kerning_correction => 0.85, # a kerning correcting to correct align of text when rotated ( default 0.91 )
surround => { color => '0x0000ff' , thickness => 1 }, # create a frame around the text with the specified color and thickness
},
# label2 => { # an optional label on the top side
# font => '/usr/lib/cinelerra/fonts/trebuc.ttf', # a TrueType font to use
color => '0xff0000',', # the color of the label
size => 12, # the size of the font
text => [ 100, undef, '20', undef, 1585, undef, 555 ], # the text to render ( a undef element is not ploted, this allow to skip some label )
# space => 10, # an extra space between the division and the text
rotation => 45, # an rotation of the text in degree
kerning_correction => 0.85, # a kerning correcting to correct align of text when rotated ( default 0.91 )
surround => { color => '0x0000ff' , thickness => 1 }, # create a frame around the text with the specified color and thickness
# }
}
reticle => { # when the Chart's type is of any circular shape, create polar division
debord => 30, # the extra debord of the division
color => '0xff0000', # the color of the division
number => 10, # the number of division
label_middle => { # the label to write between 2 division
font => '/usr/lib/cinelerra/fonts/lucon.ttf', # a TrueType font to use
kerning_correction => 0.85, # a kerning correcting to correct align of text when rotated ( default 0.91 )
color => '0xff0000', # the text color
size => 10, # the font size to use
# space => 10, # an extra space between the division and the text
# rotate => 'follow', # rotate the text to be following the division direction
rotate => 'perpendicular', # rotate the the to be perpendicular to the division
# if missing write the text without rotation
text => [700031220,45,90,135,180,225,270,31500 , 1 ,2], # the text to render ( a undef element is not ploted, this allow to skip some label )
},
# label => { # the label to write at the division
font => '/usr/lib/cinelerra/fonts/lucon.ttf', # a TrueType font to use
kerning_correction => 0.85, # a kerning correcting to correct align of text when rotated ( default 0.91 )
color => '0xff0000', # the text color
size => 10, # the font size to use
# space => 10, # an extra space between the division and the text
# rotate => 'follow', # rotate the text to be following the division direction
rotate => 'perpendicular', # rotate the the to be perpendicular to the division
# if missing write the text without rotation
text => [700031220,45,90,135,180,225,270,31500 , 1 ,2], # the text to render ( a undef element is not ploted, this allow to skip some label )
# },
overlay=> { # add an overlay to the graph (useful to show an alert period )
layer => 10, # the layer where the data is plotted ( the lowest number is the deepest layer ) If missing, the layer is created by call order of the method data
set => \@alarm, # a array ref with the data ( the number of dot plotted is the number W provided by the size parameter/method
type => 'pie', # the type of graph ( dot, line, bar, up_dot, up_bar, up_line , down_dot,down_line, down_bar, pie, target, radial )
color => '0xFFD2D2', # color of the plotted element
type => 'pie', # if missing normal overlay are used, if present use a polar structure ( data are in the range of 0 to 360 ° )
merge => 1, # if present and not = 0 all overlay are overwrited by the overlay from a higer layer
opacity => 100, # when merge is missing, the overlay % of opacity copied on the chart
debord => 50, # the debord of the overlay. if missing use the full graph height and in polar ( pie ) use the smallest vertical border ( top or bottom )
},
glyph => { # add some ornament on the graph like line, text or polygon
x => $graph->{x}{min}+200, # the origin of the glyph, all other position are relative to this origin
y => $graph->{x}{max} , # either in pixel x =>0 , y=> 0 = corner lower left
# see the active method
type => 'filled', # type of glyph ( missing = open polygyn, 'filled' = filled polygon, 'text' = text )
color => '0x00FFff', # color of the glyph
data => [ # if one of the polygon type, the data is a set of point to plot ( value relative to the origin )
[ 0, 0 ],
[ 8, 10 ],
[ 0, 10 ],
[ 0, 10 + 20 ],
[ 0, 10 ],
[ -8, 10 ],
[ 0, 0 ]
],
glyph => {
x => 100,
y => 'active_max',
type => 'text',
color => '0xff0000',
size => 12, # if the glyph's type is 'text', this is the font size
font => '/usr/lib/cinelerra/fonts/lucon.ttf', # the TrueType font to use
data => [ # the data set contain an array with all the text to plot followed by the relative position + the optional rotation
[ 'hello world', 0, 0, 30 ], #
[ 'hello universe', 100, 0, 0 ],
],
},
},
},
all these parameters are optional except the size
my $a = B<Graph::Chart>->new( size => [ 800,400 ]
);
=back
=back
=cut
sub new
{
my ( $class ) = shift;
# no strict "refs";
# my $fields_ref = \%{ "${class}::FIELDS" };
# my $self = $fields_ref;
my $self;
$self->{ size } = { @_ }->{ size };
$self->{ bg_color } = _re_color( { @_ }->{ bg_color }, 'ffffffff' );
if ( exists { @_ }->{ frame } )
{
$self->{ frame } = { @_ }->{ frame };
if ( exists { @_ }->{ frame }{ color } )
{
$self->{ frame }{ color } = _re_color( { @_ }->{ frame }{ color }, '00000000' );
}
$self->{ frame }{ thickness } = { @_ }->{ frame }{ thickness } || 1;
}
$self->{ border } = { @_ }->{ border } || [ 0, 0, 0, 0 ];
if ( exists { @_ }->{ grid } )
{
$self->{ grid } = { @_ }->{ grid };
unless ( exists $self->{ grid }->{ debord } )
{
$self->{ grid }->{ debord } = [ 0, 0, 0, 0 ];
}
}
if ( exists { @_ }->{ reticle } )
{
$self->{ reticle } = { @_ }->{ reticle };
if ( !exists { @_ }->{ reticle }->{ debord } )
{
$self->{ reticle }{ debord } = 0;
}
if ( !exists $self->{ reticle }{ number } )
{
$self->{ reticle }->{ number } = 2;
}
}
if ( exists { @_ }->{ overlay } )
{
if ( exists { @_ }->{ overlay }{ layer } )
{
$self->{ overlay }[ { @_ }->{ overlay }{ layer } ] = clone( { @_ }->{ overlay } );
}
else
{
push @{ $self->{ overlay } }, clone( { @_ }->{ overlay } );
}
}
if ( exists { @_ }->{ glyph } )
{
if ( exists { @_ }->{ glyph }{ layer } )
{
$self->{ glyph }[ { @_ }->{ glyph }{ layer } ] = clone( { @_ }->{ glyph } );
}
else
{
push @{ $self->{ glyph } }, clone( { @_ }->{ glyph } );
}
}
bless( $self, $class );
return $self;
}
sub _color_allocate
{
my $col = shift;
my $def = shift;
my $graph = shift;
if ( ref $col eq 'ARRAY' )
{
my @style;
foreach my $c ( @{ $col } )
{
my ( $r, $g, $b, $a ) = unpack "a2 a2 a2 a2 ", _re_color( $c, 'ffffffff' );
push @style, $graph->colorAllocateAlpha( hex $r, hex $g, hex $b, hex $a );
}
$graph->setStyle( @style );
return gdStyled;
}
else
{
if ( $col =~ /^(0x)??([[:xdigit:]]{6})$/i )
{
$col = $2 . '00';
}
elsif ( $col =~ /^(0x)??([[:xdigit:]]{8})$/i )
{
$col = $2;
}
else
{
$col = $def;
}
my ( $r, $g, $b, $a ) = unpack "a2 a2 a2 a2 ", $col;
return $graph->colorAllocateAlpha( hex $r, hex $g, hex $b, hex $a );
}
}
sub _re_color
{
my $col = shift;
my $def = shift;
my $graph = shift;
lib/Graph/Chart.pm view on Meta::CPAN
my $self = shift;
my $object = shift;
if ( $object )
{
$self->{ bg_color } = $object;
}
return $self->{ bg_color };
}
###########################################################################
###########################################################################
### method to provide the data to plot ###
###########################################################################
=head2 data
set the data to be plotted
$graph->data(
{
layer => 10, # the layer where the data is plotted ( the lowest number is the deepest layer ) If missing, the layer is created by call order of the method data
set => \@dot, # a array ref with the data ( the number of dot plotted is the number W provided by the size parameter/method
type => 'pie', # the type of graph ( dot, line, bar, up_dot, up_bar, up_line , down_dot,down_line, down_bar, pie, target, radial )
bar_size => 1, # if any type of bar used, this is an extra width of the bar created, if not defined, the bar width= 1 if set to 1 the size of the bar became 3 ( 1 before, 1 for the bar and one after )
color => '0x0000ff', # color of the plotted element
thickness => 1, # for any type of dot and line, the thiskness to used ( default = 1 )
scale => '90%', # a vertical scale on the value provided ( a decimal number scale all the data value using the value ( data could be outside of the graph) 1 = 100%
# a percent value like, '90%' scale the graph to that percentage ( lower then 100% = some data are plotted outside the graph )
# missing or '100%' resize the graph using the maximal value
# 'auto' or '110%' allow to always have a small extra gap and never reach to extremity of the graph area,
max => 3000, # a maximal value to use to create the graph ( if missing, max = maximal value from the data set )
}
);
=cut
sub data
{
my $self = shift;
my $object = shift;
if ( $object )
{
if ( exists $object->{ layer } )
{
$self->{ data }[ $object->{ layer } ] = clone( $object );
}
else
{
push @{ $self->{ data } }, clone( $object );
}
}
return $self->{ data };
}
###########################################################################
###########################################################################
### method to put an overlay on top of the graph ###
###########################################################################
=head2 overlay
method to put an overlay on top of the graph ( to show alarm period ... )
use the same parameter as the new()
if the same layer is already present, overwrite this layer
=cut
sub overlay
{
my $self = shift;
my $object = shift;
if ( $object )
{
if ( exists $object->{ layer } )
{
$self->{ overlay }[ $object->{ layer } ] = clone( $object );
}
else
{
push @{ $self->{ overlay } }, clone( $object );
}
}
return $self->{ overlay };
}
###########################################################################
###########################################################################
### method to put a glyph on the graph ###
###########################################################################
=head2 overlay
method to put a glyph on the graph ( to show the latest data polled, or a trend value, ... )
use the same parameter as the new()
if the same layer is already present, overwrite this layer
=cut
sub glyph
{
my $self = shift;
my $object = shift;
if ( $object )
{
if ( exists $object->{ layer } )
{
$self->{ glyph }[ $object->{ layer } ] = clone( $object );
}
else
{
push @{ $self->{ glyph } }, clone( $object );
}
}
return $self->{ glyph };
}
###########################################################################
###########################################################################
### method to add a png data TAG ( not standard ) ###
###########################################################################
=head2 png_zEXt
method to add a png data TAG
This tag is not a PNG standard, but allowed by the RFC
see code in img_info.pl
my $png_out1 =$graph->png_zEXt( { eerer => 1, ggg => 'zed' } );
this overwrite the png TAG data with the new value and return the new image
=cut
sub png_zEXt
{
my $self = shift;
my $object = shift;
$self->{ size_tot }->[0] = $self->{ size }->[0] + $self->{ border }->[0] + $self->{ border }->[1];
$self->{ size_tot }->[1] = $self->{ size }->[1] + $self->{ border }->[2] + $self->{ border }->[3];
my $tmp = clone( $self );
# delete $tmp->{ data };
foreach my $idx (0 .. scalar @{$tmp->{ data }})
{
next if ( ! defined $tmp->{ data }[ $idx ] );
delete $tmp->{ data }[ $idx]{ set};
}
delete $tmp->{ img };
lib/Graph/Chart.pm view on Meta::CPAN
}
$png_out = $sig . $ihdr . $text . $end_png;
$self->{ img } = $png_out;
return $self->{ img };
}
###########################################################################
sub update
{
my $self = shift;
my $object = shift;
# carp Dumper($self);
my $image_gd = GD::Image->new( $self->{img});
# carp $image_gd;
#
# $image->copy($sourceImage,$dstX,$dstY, $srcX,$srcY,$width,$height)
}
###########################################################################
### method to render the Chart ###
###########################################################################
=head2 render
render the chart and return a png image
my $img = $graph->render( \%tag )
the hash ref contain data to put in the PNG meta tag.
the tools img_info.pl allow to see the result.
the tag is serialized in the png
the returned value could be writted in a file like this:
my $png_out = $graph->render();
open( my $IMG, '>', $file ) or die $!;
binmode $IMG;
print $IMG $png_out;
close $IMG;
);
=cut
sub render
{
my $self = shift;
my $object = shift;
my $frame = new GD::Image( $self->{ size }->[0] + $self->{ border }->[0] + $self->{ border }->[1], $self->{ size }->[1] + $self->{ border }->[2] + $self->{ border }->[3] );
my $bg_color = _color_allocate( $self->{ bg_color }, 'ffffffff', $frame );
my $bg_color = _color_allocate( $self->{ bg_color }, 'ffffffff', $frame );
$frame->transparent( $bg_color );
$frame->interlaced( 'true' );
### plot overlay
if ( exists $self->{ overlay } )
{
foreach my $layer ( @{ $self->{ overlay } } )
{
next unless ( ref $layer eq 'HASH' );
my $col_graph;
my $frame_over;
if ( exists $layer->{ merge } && $layer->{ merge } )
{
$col_graph = _color_allocate( $layer->{ color }, '00000000', $frame );
}
else
{
$frame_over = new GD::Image( $self->{ size }->[0] + $self->{ border }->[0] + $self->{ border }->[1], $self->{ size }->[1] + $self->{ border }->[2] + $self->{ border }->[3] );
my ( $r, $g, $b, $a ) = unpack "a2 a2 a2 a2 ", $self->{ bg_color };
my $bg_color_over = $frame_over->colorAllocateAlpha( hex $r, hex $g, hex $b, hex $a );
$frame_over->transparent( $bg_color_over );
$frame_over->interlaced( 'true' );
$frame_over->setThickness( 1 );
$col_graph = _color_allocate( $layer->{ color }, '00000000', $frame );
}
my $extra =
$self->{ border }->[2] > $self->{ border }->[3]
? $self->{ border }->[3]
: $self->{ border }->[2];
if ( exists $layer->{ debord } )
{
$extra = $layer->{ debord };
}
my $dot = -1;
my $last_pie;
foreach my $raw_val ( @{ $layer->{ set } } )
{
$dot++;
next if ( !defined $raw_val || !$raw_val );
my $plot_dot = $self->{ border }->[0] + $dot;
my $plot_val = $self->{ border }->[2] + $self->{ border }->[3] + $self->{ size }->[1];
if ( exists $layer->{ merge } && $layer->{ merge } )
{
if ( exists $layer->{ type } && $layer->{ type } eq 'pie' )
{
$frame->filledArc( $self->{ size }->[0] / 2 + $self->{ border }->[0], ( $self->{ size }->[1] / 2 ) + $self->{ border }->[2], ( $self->{ size }->[1] + ( 2 * $extra ) ), ( $self->{ size }->[1] + ( 2 * $extra ) ), $dot, $dot + 1,...
$last_pie = $dot;
}
else
{
$frame->line( $plot_dot, 0, $plot_dot, $plot_val, $col_graph );
}
}
else
{
if ( exists $layer->{ type } && $layer->{ type } eq 'pie' )
{
$frame_over->filledArc( $self->{ size }->[0] / 2 + $self->{ border }->[0], ( $self->{ size }->[1] / 2 ) + $self->{ border }->[2], ( $self->{ size }->[1] + ( 2 * $extra ) ), ( $self->{ size }->[1] + ( 2 * $extra ) ), $dot, $dot...
}
else
{
$frame_over->line( $plot_dot, 0, $plot_dot, $plot_val, $col_graph );
}
}
}
if ( exists $layer->{ merge } && $layer->{ merge } )
{
}
else
{
my $trans = $layer->{ opacity } || 20;
$frame->copyMerge( $frame_over, 0, 0, 0, 0, $self->{ size }->[0] + $self->{ border }->[0] + $self->{ border }->[1], $self->{ size }->[1] + $self->{ border }->[2] + $self->{ border }->[3], $trans );
}
}
}
### end plot overlay
### plot data
if ( exists $self->{ data } )
{
my $last_pie;
foreach my $layer ( @{ $self->{ data } } )
{
next unless ( ref $layer eq 'HASH' );
my $max = max( @{ $layer->{ set } } );
my $min = min( @{ $layer->{ set } } );
my $scale = 1;
my $pre_scale = 1;
my $bar_size = $layer->{ bar_size } || 1;
if ( exists $layer->{ scale } )
{
if ( $layer->{ scale } =~ /^(\d*\.*\d*)%$/ )
{
$pre_scale = $1 / 100;
}
if ( $layer->{ scale } =~ /^(\d*\.*\d*)$/ )
{
$pre_scale = $1;
}
elsif ( $layer->{ scale } eq 'auto' )
{
$pre_scale = 1.1;
}
}
if ( exists $layer->{ max } )
{
$max = $layer->{ max };
}
$scale = $self->{ size }->[1] / ( $pre_scale * $max );
if ( exists $layer->{ type } && $layer->{ type } =~ /(up|down)/ )
{
$scale /= 2;
}
my $thickness = $layer->{ thickness } || 1;
$frame->setThickness( $thickness );
my $col_graph = _color_allocate( $layer->{ color }, '00000000', $frame );
if ( !exists $layer->{ type } || $layer->{ type } =~ /line|dot|bar/ )
{
my $poly = new GD::Polygon;
my $dot = -1;
foreach my $raw_val ( @{ $layer->{ set } } )
{
$dot++;
next if ( !defined $raw_val );
last if ( $dot >= $self->{ size }->[0] );
my $offset = $layer->{ offset } || 0;
my $val = ( $scale * $raw_val ) + $offset;
if ( exists $layer->{ scale } && $layer->{ scale } eq 'log' )
{
$raw_val = $raw_val <= 0 ? $min : $raw_val;
next if ( $raw_val <= 0 );
$val = log10( $raw_val ) + $offset;
( run in 0.665 second using v1.01-cache-2.11-cpan-e1769b4cff6 )