/usr/share/perl5/SVG/Graph/Glyph/pictogram.pm is in libsvg-graph-perl 0.02-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 | package SVG::Graph::Glyph::pictogram;
use base SVG::Graph::Glyph;
use strict;
use Data::Dumper;
our @lifts;
=head1 NAME
SVG::Graph::Glyph::pictogram - SVG::Graph::Glyph::pictogram object
=head1 METHODS
=head2 draw
Title : draw
Usage :
Function:
Example :
Returns :
Args :
=cut
sub draw{
my ($self,@args) = @_;
my($x1,$x2,$y1,$y2) = (undef,undef,undef,undef);
#this will be the width of a bar, we need to calculate the
#minimum distance between any two values in the data,
#and use that as the step size.
my $step = undef;
my %xcoords = map {$_->x => 1} $self->group->data;
($x1,$x2) = (undef,undef);
foreach my $xcoord (sort {$a <=> $b} keys %xcoords){
$x1 = $xcoord and next unless defined($x1);
$x2 = $xcoord;
if(!defined($step)){
$step = $x2 - $x1;
} else {
$step = $x2 - $x1 < $step ? $x2 - $x1 : $step;
}
$x1 = $x2;
}
foreach my $data ($self->group->data_chunks){
my @newlifts = $self->_glyphs($step,\@lifts,[$data->data]);
my $i = 0;
foreach my $newlift (@newlifts){
$lifts[$i] += $newlift;
$i++;
}
}
}
sub _glyphs {
my $self = shift;
my($step,$lifts,$data) = @_;
my @ls = ();
my $l;
#FIXME this logic is fubar, but it keeps things in proper scale.
my $yscale = $self->ysize / ($self->group->ymax);
my $xscale = $self->xsize / (scalar(@$data));
my $fontsize = int($self->xsize / (scalar(@$data) * 0.96));
foreach my $datum (sort {$a->x <=> $b->x} @$data){
my $xsc = 1;
my $ysc = $datum->y * $yscale;
warn $ysc;
my $x1 = (($datum->x - 1) * $fontsize) + $self->xoffset;
my $y1 = $self->ysize + $self->yoffset - ($self->yoffset / 8);
if($datum->y > 0){
$self->canvas->text(
x => 0,
y => 0,
# 'transform' => "scale($xsc,$ysc), translate(". $x1/$xsc .",". $y1/$ysc .")",
'transform' => "scale($xsc,$ysc), translate(". $x1/$xsc .",". 0 .")",
'font-size' => $fontsize,
'font-family' => 'Helvetica',
'text-anchor' => 'right',
'fill' => $self->color->{$datum->label},
)->cdata($datum->label);
}
}
}
=head2 color
Title : color
Usage : $obj->color($newval)
Function:
Example :
Returns : value of color (a scalar)
Args : on set, new value (a scalar or undef, optional)
=cut
sub color{
my $self = shift;
return $self->{'color'} = shift if @_;
return $self->{'color'};
}
1;
|