Adding the graphing engine.
This commit is contained in:
Martin Kamerbeek
parent
683b580849
commit
27af7de00c
25 changed files with 3830 additions and 15 deletions
|
|
@ -131,6 +131,7 @@
|
|||
- fix [ 1172613 ] Header Tag Not Accessibility Friendly
|
||||
- fix [ 1340839 ] If can't use item in adminConsole don't display it
|
||||
- fix [ 1473937 ] scratch->set not taking.
|
||||
- Added a graphing engine and tied it into the Poll asset (Martin Kamerbeek / Procolix)
|
||||
|
||||
6.8.8
|
||||
- fix [ 1452466 ] File size not set in File asset (Thanks to Eric S)
|
||||
|
|
|
|||
|
|
@ -42,6 +42,9 @@ save you many hours of grief.
|
|||
Net::Subnets
|
||||
DateTime::Format::Mail
|
||||
Net::POP3
|
||||
POSIX
|
||||
List::Util
|
||||
Color::Calc
|
||||
|
||||
* The upgrade script is going to convert your WebGUI config files
|
||||
from the current PlainConfig format to the new JSON format.
|
||||
|
|
|
|||
|
|
@ -27,16 +27,20 @@
|
|||
<tmpl_var form.submit>
|
||||
<tmpl_var form.end>
|
||||
<tmpl_else>
|
||||
<tmpl_loop answer_loop>
|
||||
<span class="pollAnswer"><tmpl_var answer.text><br /></span>
|
||||
<table cellpadding=0 cellspacing=0 border=0>
|
||||
<tr>
|
||||
<td width="<tmpl_var answer.graphWidth>" class="pollColor">^Spacer(1,1);</td>
|
||||
<td class="pollAnswer"> <tmpl_var answer.percent>% (<tmpl_var answer.total>)</td>
|
||||
</tr>
|
||||
</table>
|
||||
</tmpl_loop>
|
||||
<span class="pollAnswer"><hr size="1"><b><tmpl_var responses.label>:</b> <tmpl_var responses.total></span>
|
||||
<tmpl_if hasImageGraph>
|
||||
<img src="<tmpl_var graphUrl>" />
|
||||
<tmpl_else>
|
||||
<tmpl_loop answer_loop>
|
||||
<span class="pollAnswer"><tmpl_var answer.text><br /></span>
|
||||
<table cellpadding=0 cellspacing=0 border=0>
|
||||
<tr>
|
||||
<td width="<tmpl_var answer.graphWidth>" class="pollColor">^Spacer(1,1);</td>
|
||||
<td class="pollAnswer"> <tmpl_var answer.percent>% (<tmpl_var answer.total>)</td>
|
||||
</tr>
|
||||
</table>
|
||||
</tmpl_loop>
|
||||
<span class="pollAnswer"><hr size="1"><b><tmpl_var responses.label>:</b> <tmpl_var responses.total></span>
|
||||
</tmpl_if>
|
||||
</tmpl_if>
|
||||
</div>
|
||||
|
||||
|
|
|
|||
|
|
@ -53,6 +53,7 @@ updateScratch();
|
|||
installSQLForm();
|
||||
addResizableTextareas();
|
||||
addScratchKeys();
|
||||
addGraphing();
|
||||
|
||||
finish($session); # this line required
|
||||
|
||||
|
|
@ -1066,7 +1067,82 @@ ENDOFQUERY5
|
|||
$session->config->addToArray("assets","WebGUI::Asset::Wobject::SQLForm");
|
||||
}
|
||||
|
||||
sub addGraphing {
|
||||
print "\tAdding graphing system.\n" unless ($quiet);
|
||||
|
||||
# Create palette and color manager tables.
|
||||
$session->db->write(<<GRAPH1
|
||||
create table imageColor (
|
||||
colorId varchar(22) binary not null primary key,
|
||||
name varchar(255) not null default 'untitled',
|
||||
fillTriplet char(7) not null default '#000000',
|
||||
fillAlpha char(2) not null default '00',
|
||||
strokeTriplet char(7) not null default '#000000',
|
||||
strokeAlpha char(2) not null default '00'
|
||||
);
|
||||
GRAPH1
|
||||
);
|
||||
|
||||
$session->db->write(<<GRAPH2
|
||||
create table imagePalette (
|
||||
paletteId varchar(22) binary not null primary key,
|
||||
name varchar(255) not null default 'untitled'
|
||||
);
|
||||
GRAPH2
|
||||
);
|
||||
|
||||
$session->db->write(<<GRAPH3
|
||||
create table imagePaletteColors (
|
||||
paletteId varchar(22) binary not null,
|
||||
colorId varchar(22) binary not null,
|
||||
paletteOrder int(11) not null,
|
||||
primary key(paletteId, paletteOrder)
|
||||
);
|
||||
GRAPH3
|
||||
);
|
||||
|
||||
# Insert default palette
|
||||
$session->db->write(<<GR1
|
||||
INSERT INTO `imageColor` VALUES
|
||||
('UVL-iDSq7VTks3RCH2FEWg','Green','#31ca31','99','#31ca31','00'),
|
||||
('3Tf0W_tkAjR902FJcGZxCg','Blue','#007dff','99','#007dff','00'),
|
||||
('fuFripVJ4es4bUBPOq3ENQ','Yellow','#ffda08','99','#ffda08','00'),
|
||||
('n3yfk8JGilmChSer2xuZ0w','Orange','#FF8000','99','#FF8000','00'),
|
||||
('W683fO6r8uHgZ-Z-VodY7w','Red','#FF2000','99','#FF2000','00'),
|
||||
('pSnxDIInB9r0n06q6kKV3w','Purple','#FF00B0','99','#FF00B0','00');
|
||||
GR1
|
||||
);
|
||||
|
||||
$session->db->write(q|INSERT INTO `imagePalette` VALUES ('defaultPalette','Default palette')|);
|
||||
|
||||
$session->db->write(<<GR2
|
||||
INSERT INTO `imagePaletteColors` VALUES
|
||||
('defaultPalette','UVL-iDSq7VTks3RCH2FEWg',1),
|
||||
('defaultPalette','3Tf0W_tkAjR902FJcGZxCg',2),
|
||||
('defaultPalette','fuFripVJ4es4bUBPOq3ENQ',3),
|
||||
('defaultPalette','n3yfk8JGilmChSer2xuZ0w',4),
|
||||
('defaultPalette','W683fO6r8uHgZ-Z-VodY7w',5),
|
||||
('defaultPalette','pSnxDIInB9r0n06q6kKV3w',6);
|
||||
GR2
|
||||
);
|
||||
|
||||
# Create fontmanager tables.
|
||||
$session->db->write(<<GRAPH4
|
||||
create table imageFont (
|
||||
fontId varchar(22) binary not null primary key,
|
||||
name varchar(255),
|
||||
storageId varchar(22),
|
||||
filename varchar(255)
|
||||
);
|
||||
GRAPH4
|
||||
);
|
||||
|
||||
$session->db->write(q|insert into imageFont (fontId, name, filename) values ('defaultFont', 'WebGUI default font', 'default.ttf')|);
|
||||
|
||||
# Update Poll table.
|
||||
$session->db->write('alter table Poll add column graphConfiguration text');
|
||||
$session->db->write('alter table Poll add column generateGraph tinyint(1)');
|
||||
}
|
||||
|
||||
# ---- DO NOT EDIT BELOW THIS LINE ----
|
||||
|
||||
|
|
|
|||
|
|
@ -359,6 +359,15 @@ sub getAdminFunction {
|
|||
op=>"manageCache",
|
||||
group=>"3"
|
||||
},
|
||||
"graphics"=>{
|
||||
title=>{
|
||||
id=>"manage graphics",
|
||||
namespace=>"Graphics",
|
||||
},
|
||||
icon=>"graphics.gif",
|
||||
op=>"listGraphicsOptions",
|
||||
group=>"3",
|
||||
},
|
||||
};
|
||||
if ($id) {
|
||||
return $self->_formatFunction($functions->{$id});
|
||||
|
|
|
|||
|
|
@ -18,6 +18,8 @@ use WebGUI::SQL;
|
|||
use WebGUI::User;
|
||||
use WebGUI::Utility;
|
||||
use WebGUI::Asset::Wobject;
|
||||
use WebGUI::Image::Graph;
|
||||
use WebGUI::Storage::Image;
|
||||
|
||||
our @ISA = qw(WebGUI::Asset::Wobject);
|
||||
|
||||
|
|
@ -149,7 +151,15 @@ sub definition {
|
|||
a20=>{
|
||||
fieldType=>"hidden",
|
||||
defaultValue=>undef
|
||||
}
|
||||
},
|
||||
graphConfiguration=>{
|
||||
fieldType=>"hidden",
|
||||
defaultValue=>undef,
|
||||
},
|
||||
generateGraph=>{
|
||||
fieldType=>"yesNo",
|
||||
defaultValue=>0,
|
||||
},
|
||||
}
|
||||
});
|
||||
return $class->SUPER::definition($session, $definition);
|
||||
|
|
@ -239,6 +249,22 @@ sub getEditForm {
|
|||
-label=>$i18n->get(10),
|
||||
-hoverHelp=>$i18n->get('10 description')
|
||||
) if $self->session->form->process("func") ne 'add';
|
||||
|
||||
|
||||
my $config = {};
|
||||
if ($self->get('graphConfiguration')) {
|
||||
$config = Storable::thaw($self->get('graphConfiguration'));
|
||||
}
|
||||
|
||||
$tabform->addTab('graph', 'Graphing');
|
||||
$tabform->getTab('graph')->yesNo(
|
||||
-name => 'generateGraph',
|
||||
-label => $i18n->get('generate graph'),
|
||||
-hoverHelp => $i18n->get('generate graph description'),
|
||||
-value => $self->getValue('generateGraph'),
|
||||
);
|
||||
$tabform->getTab('graph')->raw(WebGUI::Image::Graph->getGraphingTab($self->session, $config));
|
||||
|
||||
return $tabform;
|
||||
}
|
||||
|
||||
|
|
@ -283,6 +309,10 @@ sub processPropertiesFromFormPost {
|
|||
for ($i=1; $i<=20; $i++) {
|
||||
$property->{'a'.$i} = $answer[($i-1)];
|
||||
}
|
||||
|
||||
my $graph = WebGUI::Image::Graph->processConfigurationForm($self->session);
|
||||
$property->{graphConfiguration} = Storable::freeze($graph->getConfiguration);
|
||||
|
||||
$self->update($property);
|
||||
$self->session->db->write("delete from Poll_answer where assetId=".$self->session->db->quote($self->getId)) if ($self->session->form->process("resetVotes"));
|
||||
}
|
||||
|
|
@ -308,7 +338,7 @@ sub setVote {
|
|||
#-------------------------------------------------------------------
|
||||
sub view {
|
||||
my $self = shift;
|
||||
my (%var, $answer, @answers, $showPoll, $f);
|
||||
my (%var, $answer, @answers, $showPoll, $f, @dataset, @labels);
|
||||
$var{question} = $self->get("question");
|
||||
if ($self->get("active") eq "0") {
|
||||
$showPoll = 0;
|
||||
|
|
@ -343,11 +373,33 @@ sub view {
|
|||
"answer.percent"=>round(100*$tally/$totalResponses),
|
||||
"answer.total"=>($tally+0)
|
||||
});
|
||||
|
||||
push(@dataset, ($tally+0));
|
||||
push(@labels, $self->get('a'.$i));
|
||||
}
|
||||
}
|
||||
randomizeArray(\@answers) if ($self->get("randomizeAnswers"));
|
||||
$var{answer_loop} = \@answers;
|
||||
|
||||
if ($self->getValue('generateGraph')) {
|
||||
my $config = {};
|
||||
if ($self->get('graphConfiguration')) {
|
||||
$config = Storable::thaw($self->get('graphConfiguration'));
|
||||
|
||||
my $graph = WebGUI::Image::Graph->loadByConfiguration($self->session, $config);
|
||||
$graph->addDataset(\@dataset);
|
||||
$graph->setLabels(\@labels);
|
||||
|
||||
$graph->draw;
|
||||
|
||||
my $storage = WebGUI::Storage::Image->createTemp($self->session);
|
||||
my $filename = 'poll'.$self->session->id->generate.".png";
|
||||
$graph->saveToStorageLocation($storage, $filename);
|
||||
|
||||
$var{graphUrl} = $storage->getUrl($filename);
|
||||
$var{hasImageGraph} = 1;
|
||||
}
|
||||
}
|
||||
|
||||
return $self->processTemplate(\%var,undef,$self->{_viewTemplate});
|
||||
}
|
||||
|
||||
|
|
|
|||
208
lib/WebGUI/Image.pm
Normal file
208
lib/WebGUI/Image.pm
Normal file
|
|
@ -0,0 +1,208 @@
|
|||
package WebGUI::Image;
|
||||
|
||||
use strict;
|
||||
use Image::Magick;
|
||||
use WebGUI::Image::Palette;
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getBackgroundColor {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_properties}->{backgroundColorTriplet} || '#ffffff';
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getImageHeight {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_properties}->{height} || 300;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getImageWidth {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_properties}->{width} || 300;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getPalette {
|
||||
my $self = shift;
|
||||
|
||||
if (!defined $self->{_palette}) {
|
||||
$self->{_palette} = WebGUI::Image::Palette->new($self->session, 'defaultPalette');
|
||||
}
|
||||
|
||||
return $self->{_palette};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getXOffset {
|
||||
my $self = shift;
|
||||
|
||||
return $self->getImageWidth / 2; #$self->{_properties}->{xOffset} || $self->getWidth / 2;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getYOffset {
|
||||
my $self = shift;
|
||||
|
||||
return $self->getImageHeight / 2; #$self->{_properties}->{yOffset} || $self->getHeight / 2;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub image {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_image};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
|
||||
my $width = shift || 300;
|
||||
my $height = shift || 300;
|
||||
|
||||
my $img = Image::Magick->new;
|
||||
$img->Read(filename => 'xc:white');
|
||||
|
||||
bless {_image => $img, _session => $session, _properties => {
|
||||
width => $width,
|
||||
height => $height,
|
||||
}
|
||||
}, $class;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub session {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_session};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setBackgroundColor {
|
||||
my $self = shift;
|
||||
my $colorTriplet = shift;
|
||||
|
||||
$self->image->Colorize(fill => $colorTriplet);
|
||||
$self->{_properties}->{backgroundColorTriplet} = $colorTriplet;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setImageHeight {
|
||||
my $self = shift;
|
||||
my $height = shift;
|
||||
|
||||
#$self->image->set(size => $self->getImageWidth.'x'.$height);
|
||||
$self->image->Extent(height => $height);
|
||||
$self->image->Colorize(fill => $self->getBackgroundColor);
|
||||
$self->{_properties}->{height} = $height;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setImageWidth {
|
||||
my $self = shift;
|
||||
my $width = shift;
|
||||
|
||||
#$self->image->set(size => $width.'x'.$self->getImageHeight);
|
||||
$self->image->Extent(width => $width);
|
||||
$self->image->Colorize(fill => $self->getBackgroundColor);
|
||||
$self->{_properties}->{width} = $width;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setPalette {
|
||||
my $self = shift;
|
||||
my $palette = shift;
|
||||
|
||||
$self->{_palette} = $palette;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub saveToFileSystem {
|
||||
my $self = shift;
|
||||
my $path = shift;
|
||||
my $filename = shift || $self->getFilename;
|
||||
|
||||
$self->image->Write($path.'/'.$filename);
|
||||
}
|
||||
|
||||
# This doesn't seem to work...
|
||||
#-------------------------------------------------------------------
|
||||
sub saveToScalar {
|
||||
my $imageContents;
|
||||
my $self = shift;
|
||||
|
||||
open my $fh, ">:scalar", \$imageContents or die;
|
||||
$self->image->Write(file => $fh, filename => 'image.png');
|
||||
close($fh);
|
||||
|
||||
return $imageContents;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub saveToStorageLocation {
|
||||
my $self = shift;
|
||||
my $storage = shift;
|
||||
my $filename = shift || $self->getFilename;
|
||||
|
||||
$self->image->Write($storage->getPath($filename));
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub text {
|
||||
my $self = shift;
|
||||
my %props = @_;
|
||||
|
||||
my $anchorX = $props{x};
|
||||
my $anchorY = $props{y};
|
||||
|
||||
|
||||
my ($x_ppem, $y_ppem, $ascender, $descender, $width, $height, $max_advance) = $self->image->QueryMultilineFontMetrics(%props);
|
||||
|
||||
# Process horizontal alignment
|
||||
if ($props{alignHorizontal} eq 'center') {
|
||||
$props{x} -= ($width / 2);
|
||||
}
|
||||
elsif ($props{alignHorizontal} eq 'right') {
|
||||
$props{x} -= $width;
|
||||
}
|
||||
|
||||
# Process vertical alignment
|
||||
if ($props{alignVertical} eq 'center') {
|
||||
$props{y} -= ($height / 2);
|
||||
}
|
||||
elsif ($props{alignVertical} eq 'bottom') {
|
||||
$props{y} -= $height;
|
||||
}
|
||||
|
||||
# Compensate for ImageMagicks 'ignore gravity when align is set' behaviour...
|
||||
if ($props{align} eq 'Center') {
|
||||
$props{x} += ($width / 2);
|
||||
}
|
||||
elsif ($props{align} eq 'Right') {
|
||||
$props{x} += $width;
|
||||
}
|
||||
|
||||
# Compensate for ImageMagick's 'put all text a line up when align is set' behaviour...
|
||||
$props{y} += $y_ppem;
|
||||
|
||||
# We must delete these keys or else placement can go wrong for some reason...
|
||||
delete($props{alignHorizontal});
|
||||
delete($props{alignVertical});
|
||||
|
||||
$self->image->Annotate(
|
||||
#Leave align => 'Left' here as a default or all text will be overcompensated.
|
||||
align => 'Left',
|
||||
%props,
|
||||
gravity => 'NorthWest',
|
||||
antialias => 'true',
|
||||
);
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
272
lib/WebGUI/Image/Color.pm
Normal file
272
lib/WebGUI/Image/Color.pm
Normal file
|
|
@ -0,0 +1,272 @@
|
|||
package WebGUI::Image::Color;
|
||||
|
||||
use strict;
|
||||
use Color::Calc;
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub canDelete {
|
||||
my $self = shift;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub copy {
|
||||
my $self = shift;
|
||||
|
||||
return WebGUI::Image::Color->new($self->session, 'new', {%{$self->{_properties}}});
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub darken {
|
||||
my $self = shift;
|
||||
|
||||
my $newColor = $self->copy;
|
||||
|
||||
my $c = Color::Calc->new(OutputFormat => 'hex');
|
||||
|
||||
$newColor->setFillTriplet('#'.$c->dark($self->getFillTriplet));
|
||||
$newColor->setStrokeTriplet('#'.$c->dark($self->getStrokeTriplet));
|
||||
|
||||
return $newColor;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub delete {
|
||||
my $self = shift;
|
||||
if ($self->canDelete) {
|
||||
$self->session->db->write('delete from imageColor where colorId=?', [
|
||||
$self->getId,
|
||||
]);
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getFillColor {
|
||||
my $self = shift;
|
||||
|
||||
return $self->getFillTriplet.$self->getFillAlpha;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getFillTriplet {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_properties}->{fillTriplet};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getFillAlpha {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_properties}->{fillAlpha};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getId {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_properties}->{colorId};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getName {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_properties}->{name};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getStrokeColor {
|
||||
my $self = shift;
|
||||
|
||||
return $self->getStrokeTriplet.$self->getStrokeAlpha;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getStrokeTriplet {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_properties}->{strokeTriplet};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getStrokeAlpha {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_properties}->{strokeAlpha};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
my $colorId = shift;
|
||||
my $properties = shift;
|
||||
|
||||
if ($colorId eq 'new') {
|
||||
unless (defined $properties) {
|
||||
$properties = {
|
||||
name => 'untitled',
|
||||
fillTriplet => '#000000',
|
||||
fillAlpha => '00',
|
||||
strokeTriplet => '#000000',
|
||||
strokeAlpha => '00',
|
||||
};
|
||||
}
|
||||
$properties->{colorId} = 'new';
|
||||
} elsif (!defined $properties) {
|
||||
$properties = $session->db->quickHashRef('select * from imageColor where colorId=?', [$colorId]);
|
||||
}
|
||||
|
||||
bless {_properties => $properties, _session => $session}, $class;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub newByPalette {
|
||||
my ($sth, $row, @colors);
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
my $paletteId = shift;
|
||||
|
||||
my $sth = $session->db->read('select imageColor.* from imageColor, imagePaletteColors where '.
|
||||
' imageColor.colorId=imagePaletteColors.colorId and paletteId=?', [
|
||||
$paletteId
|
||||
]);
|
||||
|
||||
while ($row = $sth->hashRef) {
|
||||
push(@colors, WebGUI::Image::Color->new($session, $row->{colorId}, $row));
|
||||
}
|
||||
|
||||
return \@colors;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub session {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_session};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setFillColor {
|
||||
my $self = shift;
|
||||
my $color = shift;
|
||||
|
||||
if ($color =~ m/^(#[\da-f]{6})([\da-f]{2})?$/i) {
|
||||
$self->setFillTriplet($1);
|
||||
$self->setFillAlpha($2 || '00');
|
||||
} else {
|
||||
$self->session->errorHandler->fatal("Invalid fill color: ($color)");
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setFillTriplet {
|
||||
my $self = shift;
|
||||
my $triplet = shift;
|
||||
|
||||
if ($triplet =~ m/^#[\da-f]{6}$/i) {
|
||||
$self->{_properties}->{fillTriplet} = $triplet;
|
||||
$self->update;
|
||||
} else {
|
||||
$self->session->errorHandler->fatal("Invalid fill triplet: ($triplet)");
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setFillAlpha {
|
||||
my $self = shift;
|
||||
my $alpha = shift;
|
||||
|
||||
if ($alpha =~ m/^[\da-f]{2}$/i) {
|
||||
$self->{_properties}->{fillAlpha} = $alpha;
|
||||
$self->update;
|
||||
} else {
|
||||
$self->session->errorHandler->fatal("Invalid fill alpha: ($alpha)");
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setName {
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
|
||||
$self->{_properties}->{name} = $name;
|
||||
$self->update;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setStrokeColor {
|
||||
my $self = shift;
|
||||
my $color = shift;
|
||||
|
||||
if ($color =~ m/^(#[\da-f]{6})([\da-f]{2})?$/i) {
|
||||
$self->setStrokeTriplet($1);
|
||||
$self->setStrokeAlpha($2 || '00');
|
||||
} else {
|
||||
$self->session->errorHandler->fatal("Invalid stroke color: ($color)");
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setStrokeTriplet {
|
||||
my $self = shift;
|
||||
my $triplet = shift;
|
||||
|
||||
if ($triplet =~ m/^#[\da-f]{6}$/i) {
|
||||
$self->{_properties}->{strokeTriplet} = $triplet;
|
||||
$self->update;
|
||||
} else {
|
||||
$self->session->errorHandler->fatal("Invalid stroke triplet: ($triplet)");
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setStrokeAlpha {
|
||||
my $self = shift;
|
||||
my $alpha = shift;
|
||||
|
||||
if ($alpha =~ m/^[\da-f]{2}$/i) {
|
||||
$self->{_properties}->{strokeAlpha} = $alpha;
|
||||
$self->update;
|
||||
} else {
|
||||
$self->session->errorHandler->fatal("Invalid stroke alpha: ($alpha)");
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub update {
|
||||
my $self = shift;
|
||||
|
||||
$self->session->db->write("update imageColor set name=?, fillTriplet=?, fillAlpha=?, strokeTriplet=?, strokeAlpha=? where colorId=?", [
|
||||
$self->getName,
|
||||
$self->getFillTriplet,
|
||||
$self->getFillAlpha,
|
||||
$self->getStrokeTriplet,
|
||||
$self->getStrokeAlpha,
|
||||
$self->getId
|
||||
]);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub save {
|
||||
my $self = shift;
|
||||
|
||||
if ($self->getId eq 'new') {
|
||||
$self->{_properties}->{colorId} = $self->session->id->generate;
|
||||
$self->session->db->write("insert into imageColor (colorId, name, fillTriplet, fillAlpha, strokeTriplet, strokeAlpha) values (?,?,?,?,?,?)", [
|
||||
$self->getId,
|
||||
$self->getName || 'untitled',
|
||||
$self->getFillTriplet || '#000000',
|
||||
$self->getFillAlpha || '00',
|
||||
$self->getStrokeTriplet || '#000000',
|
||||
$self->getStrokeAlpha || '00',
|
||||
]);
|
||||
}
|
||||
|
||||
$self->update;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
151
lib/WebGUI/Image/Font.pm
Normal file
151
lib/WebGUI/Image/Font.pm
Normal file
|
|
@ -0,0 +1,151 @@
|
|||
package WebGUI::Image::Font;
|
||||
|
||||
use strict;
|
||||
use WebGUI::Storage;
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub canDelete {
|
||||
my $self = shift;
|
||||
|
||||
return 0 if ($self->getId =~ m/^default/);
|
||||
return 1;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub delete {
|
||||
my $self = shift;
|
||||
|
||||
if ($self->canDelete) {
|
||||
my $storage = WebGUI::Storage->get($self->session, $self->getStorageId);
|
||||
$storage->deleteFile($self->getFilename);
|
||||
|
||||
$self->session->db->write('delete from imageFont where fontId=?', [
|
||||
$self->getId,
|
||||
]);
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getId {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_properties}->{fontId};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getFontList {
|
||||
my $self = shift;
|
||||
my $session = shift || $self->session;
|
||||
|
||||
return $session->db->buildHashRef('select fontId, name from imageFont');
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getFile {
|
||||
my $self = shift;
|
||||
|
||||
if ($self->getStorageId) {
|
||||
return WebGUI::Storage->get($self->session, $self->getStorageId)->getPath($self->getFilename);
|
||||
} else {
|
||||
return $self->session->config->getWebguiRoot."/lib/default.ttf"
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getFilename {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_properties}->{filename};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getName {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_properties}->{name};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getStorageId {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_properties}->{storageId};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
my $fontId = shift;
|
||||
my $properties = {};
|
||||
|
||||
if ($fontId eq 'new') {
|
||||
$fontId = $session->id->generate;
|
||||
|
||||
$session->db->write('insert into imageFont (fontId) values (?)', [
|
||||
$fontId,
|
||||
]);
|
||||
$properties->{fontId} = $fontId;
|
||||
} else {
|
||||
$properties = $session->db->quickHashRef('select * from imageFont where fontId=?', [
|
||||
$fontId,
|
||||
]);
|
||||
|
||||
unless ($properties->{fontId}) {
|
||||
$properties = $session->db->quickHashRef('select * from imageFont where fontId=?', [
|
||||
'defaultFont',
|
||||
]);
|
||||
}
|
||||
}
|
||||
|
||||
bless {_properties => $properties, _session => $session}, $class;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub session {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_session};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setFilename {
|
||||
my $self = shift;
|
||||
my $filename = shift;
|
||||
|
||||
$self->session->db->write('update imageFont set filename=? where fontId=?', [
|
||||
$filename,
|
||||
$self->getId,
|
||||
]);
|
||||
|
||||
$self->{_properties}->{filename} = $filename;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setName {
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
|
||||
$self->session->db->write('update imageFont set name=? where fontId=?', [
|
||||
$name,
|
||||
$self->getId,
|
||||
]);
|
||||
|
||||
$self->{_properties}->{name} = $name;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setStorageId {
|
||||
my $self = shift;
|
||||
my $storageId = shift;
|
||||
|
||||
$self->session->db->write('update imageFont set storageId=? where fontId=?', [
|
||||
$storageId,
|
||||
$self->getId,
|
||||
]);
|
||||
|
||||
$self->{_properties}->{storageId} = $storageId;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
450
lib/WebGUI/Image/Graph.pm
Normal file
450
lib/WebGUI/Image/Graph.pm
Normal file
|
|
@ -0,0 +1,450 @@
|
|||
package WebGUI::Image::Graph;
|
||||
|
||||
use strict;
|
||||
use WebGUI::Image;
|
||||
use WebGUI::Image::Palette;
|
||||
use WebGUI::Image::Font;
|
||||
use List::Util;
|
||||
|
||||
our @ISA = qw(WebGUI::Image);
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub addDataset {
|
||||
my $self = shift;
|
||||
my $dataset = shift;
|
||||
|
||||
push(@{$self->{_datasets}}, $dataset);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub configurationForm {
|
||||
my $self = shift;
|
||||
|
||||
my $i18n = WebGUI::International->new($self->session, 'Image_Graph');
|
||||
|
||||
my $f = WebGUI::HTMLForm->new($self->session);
|
||||
$f->trClass('Graph');
|
||||
$f->integer(
|
||||
-name => 'graph_imageWidth',
|
||||
-value => $self->getImageWidth,
|
||||
-label => $i18n->get('image width'),
|
||||
);
|
||||
$f->integer(
|
||||
-name => 'graph_imageHeight',
|
||||
-value => $self->getImageHeight,
|
||||
-label => $i18n->get('image height'),
|
||||
);
|
||||
$f->color(
|
||||
-name => 'graph_backgroundColor',
|
||||
-value => $self->getBackgroundColor,
|
||||
-label => $i18n->get('background color'),
|
||||
);
|
||||
$f->selectBox(
|
||||
-name => 'graph_paletteId',
|
||||
-label => $i18n->get('palette'),
|
||||
-value => [ $self->getPalette->getId ],
|
||||
-options=> $self->getPalette->getPaletteList,
|
||||
);
|
||||
$f->float(
|
||||
-name => 'graph_labelOffset',
|
||||
-value => $self->getLabelOffset,
|
||||
-label => $i18n->get('label offset'),
|
||||
);
|
||||
$f->selectBox(
|
||||
-name => 'graph_labelFontId',
|
||||
-value => [ $self->getLabelFont->getId ],
|
||||
-label => $i18n->get('label font'),
|
||||
-options=> WebGUI::Image::Font->getFontList($self->session),
|
||||
);
|
||||
$f->color(
|
||||
-name => 'graph_labelColor',
|
||||
-value => $self->getLabelColor,
|
||||
-label => $i18n->get('label color'),
|
||||
);
|
||||
$f->integer(
|
||||
-name => 'graph_labelFontSize',
|
||||
-value => $self->getLabelFontSize,
|
||||
-label => $i18n->get('label fontsize'),
|
||||
);
|
||||
|
||||
return {'graph' => $f->printRowsOnly};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub drawLabel {
|
||||
my $self = shift;
|
||||
my %properties = @_;
|
||||
|
||||
$self->text(
|
||||
font => $self->getLabelFont->getFile,
|
||||
fill => $self->getLabelColor,
|
||||
style => 'Normal',
|
||||
pointsize => $self->getLabelFontSize,
|
||||
%properties,
|
||||
);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub formNamespace {
|
||||
return "Graph";
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getConfiguration {
|
||||
my $self = shift;
|
||||
|
||||
return {
|
||||
graph_formNamespace => $self->formNamespace,
|
||||
graph_paletteId => $self->getPalette->getId,
|
||||
graph_labelOffset => $self->getLabelOffset,
|
||||
graph_labelFontSize => $self->getLabelFontSize,
|
||||
graph_labelFontId => $self->getLabelFont->getId,
|
||||
graph_labelColor => $self->getLabelColor,
|
||||
graph_imageWidth => $self->getImageWidth,
|
||||
graph_imageHeight => $self->getImageHeight,
|
||||
graph_backgroundColor => $self->getBackgroundColor,
|
||||
};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getGraphingTab {
|
||||
my (%configForms, $output);
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
my $config = shift;
|
||||
|
||||
my (@graphingPlugins, %graphingPlugins, @failedGraphingPlugins);
|
||||
|
||||
my $i18n = WebGUI::International->new($session, 'Image_Graph');
|
||||
|
||||
my $f = WebGUI::HTMLForm->new($session);
|
||||
|
||||
foreach (@{$session->config->get("graphingPlugins")}) {
|
||||
my $plugin = WebGUI::Image::Graph->load($session, $_);
|
||||
if ($plugin) {
|
||||
push(@graphingPlugins, $plugin);
|
||||
$plugin->setConfiguration($config);
|
||||
$graphingPlugins{$plugin->formNamespace} = $_;
|
||||
} else {
|
||||
push(@failedGraphingPlugins, $_);
|
||||
}
|
||||
}
|
||||
|
||||
my $ns = $config->{graph_formNamespace};
|
||||
# payment plugin
|
||||
if (%graphingPlugins) {
|
||||
$session->style->setRawHeadTags(<<EOS
|
||||
<script type="text/javascript">
|
||||
function inNamespace (clas, namespace) {
|
||||
var namespaceParts = namespace.split('_');
|
||||
var s = '';
|
||||
|
||||
for (var i = 0; i < namespaceParts.length; i++) {
|
||||
if (i > 0) {
|
||||
s = s + '_';
|
||||
}
|
||||
s = s + namespaceParts[i];
|
||||
|
||||
if (s == clas) {
|
||||
return true;
|
||||
}
|
||||
}
|
||||
|
||||
return false;
|
||||
}
|
||||
|
||||
function getContainerTag (elem, tagname) {
|
||||
var parent = elem.parentNode;
|
||||
|
||||
while (parent.tagName != tagname) {
|
||||
parent = parent.parentNode;
|
||||
}
|
||||
|
||||
return parent;
|
||||
}
|
||||
|
||||
function switchGraphingFormElements (elem, namespace) {
|
||||
var rowElements = getContainerTag(elem, 'TABLE').getElementsByTagName('TR');
|
||||
|
||||
for (var ix = 0; ix < rowElements.length; ix++) {
|
||||
if (inNamespace(rowElements[ix].className, namespace)) {
|
||||
rowElements[ix].style.display = '';
|
||||
} else {
|
||||
if (rowElements[ix].className.match(/^Graph_/)) {
|
||||
rowElements[ix].style.display = 'none';
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
</script>
|
||||
EOS
|
||||
);
|
||||
|
||||
$f->selectBox(
|
||||
-name => 'graphingPlugin',
|
||||
-options => \%graphingPlugins,
|
||||
-label => $i18n->get('graph type'),
|
||||
#### hoverhelp
|
||||
-hoverHelp => 'Graph type hover',
|
||||
-id => 'graphTypeSelector',
|
||||
-value => [ $config->{graph_formNamespace} ],
|
||||
-extras => 'onchange="switchGraphingFormElements(this, this.value)"'
|
||||
);
|
||||
|
||||
foreach my $currentPlugin (@graphingPlugins) {
|
||||
%configForms = (%configForms, %{$currentPlugin->configurationForm});
|
||||
}
|
||||
} else {
|
||||
$f->raw('<tr><td colspan="2" align="left">'.$i18n->get('no graphing plugins').'</td></tr>');
|
||||
}
|
||||
|
||||
foreach (sort keys %configForms) {
|
||||
$f->raw($configForms{$_});
|
||||
}
|
||||
|
||||
$f->raw('<script type="text/javascript">'.
|
||||
"switchGraphingFormElements(document.getElementById('graphTypeSelector'), '$ns');".
|
||||
'</script>'
|
||||
);
|
||||
|
||||
return $f->printRowsOnly;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getDataset {
|
||||
my $self = shift;
|
||||
my $index = shift;
|
||||
|
||||
return $self->{_datasets} unless (defined $index);
|
||||
|
||||
die "Illegal dataset" if ($index >= scalar(@{$self->{_datasets}}));
|
||||
|
||||
return $self->{_datasets}->[$index];
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getLabel {
|
||||
my $self = shift;
|
||||
my $index = shift;
|
||||
|
||||
return $self->{_labels}->{data} || [] unless (defined $index);
|
||||
return $self->{_labels}->{data}->[$index];
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getLabelColor {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_labels}->{labelColor} || '#333333';
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getLabelDimensions {
|
||||
my $self = shift;
|
||||
my $text = shift;
|
||||
my $properties = shift || {};
|
||||
|
||||
my ($x_ppem, $y_ppem, $ascender, $descender, $width, $height, $max_advance) = $self->image->QueryFontMetrics(
|
||||
font => $self->getLabelFont->getFile,
|
||||
# stroke => $self->getLabelColor,
|
||||
fill => $self->getLabelColor,
|
||||
style => 'Normal',
|
||||
pointsize => $self->getLabelFontSize,
|
||||
%$properties,
|
||||
text => $text,
|
||||
);
|
||||
|
||||
return {width => $width, height => $height};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getLabelFont {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_labels}->{labelFont} || WebGUI::Image::Font->new($self->session);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getLabelFontSize {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_labels}->{labelFontSize} || 20;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getLabelOffset {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_labels}->{labelOffset} || 10;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getMaxValueFromDataset {
|
||||
my $self = shift;
|
||||
|
||||
my ($sum, $maxSum);
|
||||
|
||||
if ($self->getDrawMode eq 'stacked') {
|
||||
my $maxElements = List::Util::max(map {scalar @$_} @{$self->{_datasets}});
|
||||
my $numberOfDatasets = scalar @{$self->{_datasets}};
|
||||
|
||||
for my $currentElement (0 .. $maxElements-1) {
|
||||
$sum = 0;
|
||||
for my $currentDataset (0 .. $numberOfDatasets - 1) {
|
||||
$sum += $self->{_datasets}->[$currentDataset]->[$currentElement];
|
||||
}
|
||||
$maxSum = $sum if ($sum > $maxSum);
|
||||
}
|
||||
} else {
|
||||
$maxSum = List::Util::max(map {(@$_)} @{$self->{_datasets}});
|
||||
}
|
||||
|
||||
return $maxSum;
|
||||
|
||||
return List::Util::max(@{$self->{_dataset}});
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub load {
|
||||
my $self = shift;
|
||||
my $session = shift;
|
||||
my $namespace = shift;
|
||||
|
||||
my $cmd = "use $namespace";
|
||||
eval($cmd);
|
||||
|
||||
$cmd = $namespace.'->new($session)';
|
||||
my $plugin = eval($cmd);
|
||||
return $plugin;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub loadByConfiguration {
|
||||
my $self = shift;
|
||||
my $session = shift;
|
||||
my $config = shift;
|
||||
|
||||
my $namespace = "WebGUI::Image::".$config->{graph_formNamespace};
|
||||
$namespace =~ s/_/::/g;
|
||||
|
||||
$session->errorHandler->fatal("wrong namespace: [$namespace]") unless ($config->{graph_formNamespace} =~ /^[\w\d_]+$/);
|
||||
|
||||
my $plugin = $self->load($session, $namespace);
|
||||
$plugin->setConfiguration($config);
|
||||
|
||||
return $plugin;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub processConfigurationForm {
|
||||
my $self = shift;
|
||||
my $session = shift;
|
||||
|
||||
my $namespace = "WebGUI::Image::".$session->form->process('graphingPlugin');
|
||||
$namespace =~ s/_/::/g;
|
||||
|
||||
my $graph = $self->load($session, $namespace);
|
||||
|
||||
$graph->setConfiguration($session->form->paramsHashRef);
|
||||
|
||||
return $graph;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setBackground {
|
||||
my $self = shift;
|
||||
my $backgroundColor = shift;
|
||||
|
||||
$self->{_properties}->{backgroundColor} = $backgroundColor;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setConfiguration {
|
||||
my $self = shift;
|
||||
my $config = shift;
|
||||
|
||||
$self->setPalette(WebGUI::Image::Palette->new($self->session, $config->{graph_paletteId}));
|
||||
$self->setLabelOffset($config->{graph_labelOffset});
|
||||
$self->setLabelFontSize($config->{graph_labelFontSize});
|
||||
$self->setLabelFont(WebGUI::Image::Font->new($self->session, $config->{graph_labelFontId}));
|
||||
$self->setLabelColor($config->{graph_labelColor});
|
||||
$self->setImageWidth($config->{graph_imageWidth});
|
||||
$self->setImageHeight($config->{graph_imageHeight});
|
||||
$self->setBackgroundColor($config->{graph_backgroundColor});
|
||||
|
||||
};
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setLabelColor {
|
||||
my $self = shift;
|
||||
my $color = shift;
|
||||
|
||||
$self->{_labels}->{labelColor} = $color;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setLabelFont {
|
||||
my $self = shift;
|
||||
my $font = shift;
|
||||
|
||||
$self->{_labels}->{labelFont} = $font;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setLabelFontSize {
|
||||
my $self = shift;
|
||||
my $size = shift;
|
||||
|
||||
$self->{_labels}->{labelFontSize} = $size;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setLabelOffset {
|
||||
my $self = shift;
|
||||
my $offset = shift;
|
||||
|
||||
$self->{_labels}->{labelOffset} = $offset;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setLabels {
|
||||
my $self = shift;
|
||||
my $labels = shift || [];
|
||||
|
||||
$self->{_labels}->{data} = $labels;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub wrapLabelToWidth {
|
||||
my (@words, $part, @lines);
|
||||
my $self = shift;
|
||||
my $text = shift;
|
||||
my $maxWidth = shift;
|
||||
my $properties = shift;
|
||||
|
||||
@words = split(/ +/, $text);
|
||||
|
||||
foreach (@words) {
|
||||
if ($self->getLabelDimensions("$part $_", $properties)->{width} > $maxWidth) {
|
||||
if ($part) {
|
||||
$part =~ s/ $//;
|
||||
push(@lines, $part);
|
||||
$part = "$_ ";
|
||||
} else {
|
||||
push(@lines, $_);
|
||||
$part = '';
|
||||
}
|
||||
} else {
|
||||
$part .= "$_ ";
|
||||
}
|
||||
}
|
||||
$part =~ s/ $//;
|
||||
push(@lines, $part) if ($part);
|
||||
|
||||
return join("\n", @lines);
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
||||
981
lib/WebGUI/Image/Graph/Pie.pm
Normal file
981
lib/WebGUI/Image/Graph/Pie.pm
Normal file
|
|
@ -0,0 +1,981 @@
|
|||
package WebGUI::Image::Graph::Pie;
|
||||
|
||||
use strict;
|
||||
use WebGUI::Image::Graph;
|
||||
use Data::Dumper::Simple;
|
||||
use constant pi => 3.14159265358979;
|
||||
use Data::Dumper;
|
||||
|
||||
our @ISA = qw(WebGUI::Image::Graph);
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub _mod2pi {
|
||||
my $angle = shift;
|
||||
|
||||
if ($angle < 0) {
|
||||
# return 2*pi + $angle - 2*pi*int($angle/(2*pi));
|
||||
} else {
|
||||
return $angle - 2*pi*int($angle/(2*pi));
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub addSlice {
|
||||
my (%slice, $leftMost, $rightMost, $center, $overallStartCorner, $overallEndCorner,
|
||||
$fillColor, $strokeColor, $sideColor);
|
||||
my $self = shift;
|
||||
my $properties = shift;
|
||||
|
||||
my $percentage = $properties->{percentage};
|
||||
|
||||
# Work around a bug in imagemagick where an A path with the same start and end point will segfault.
|
||||
if ($percentage == 1) {
|
||||
$percentage = 0.9999999;
|
||||
}
|
||||
|
||||
my $label = $properties->{label};
|
||||
my $color = $properties->{color};
|
||||
|
||||
my $angle = 2*pi*$percentage;
|
||||
my $startAngle = _mod2pi($self->{_currentAngle}) || _mod2pi(2*pi*$self->getStartAngle/360) || 0;
|
||||
my $stopAngle = _mod2pi($startAngle + $angle);
|
||||
my $avgAngle = _mod2pi((2 * $startAngle + $angle) / 2);
|
||||
|
||||
$self->{_currentAngle} = $stopAngle;
|
||||
|
||||
my $mainStartDraw = 1;
|
||||
my $mainStopDraw = 1;
|
||||
|
||||
$fillColor = $color->getFillColor;
|
||||
$strokeColor = $color->getStrokeColor;
|
||||
|
||||
if ($self->hasShadedSides) {
|
||||
$sideColor = $color->darken->getFillColor;
|
||||
} else {
|
||||
$sideColor = $fillColor;
|
||||
}
|
||||
|
||||
my %sliceData = (
|
||||
# color properties
|
||||
fillColor => $fillColor,
|
||||
strokeColor => $strokeColor,
|
||||
bottomColor => $fillColor, #$properties->{bottomColor} || $properties->{fillColor},
|
||||
topColor => $fillColor, #$properties->{topColor} || $properties->{fillColor},
|
||||
startPlaneColor => $sideColor, #$properties->{startPlaneColor} || $properties->{fillColor},
|
||||
stopPlaneColor => $sideColor, #$properties->{stopPlaneColor} || $properties->{fillColor},
|
||||
rimColor => $sideColor, #$properties->{rimColor} || $properties->{fillColor},
|
||||
|
||||
# geometric properties
|
||||
topHeight => $self->getTopHeight,
|
||||
bottomHeight => $self->getBottomHeight,
|
||||
explosionLength => $self->getExplosionLength,
|
||||
scaleFactor => $self->getScaleFactor,
|
||||
|
||||
# keep the slice number for debugging properties
|
||||
sliceNr => scalar(@{$self->{_slices}}),
|
||||
label => $label,
|
||||
percentage => $percentage,
|
||||
);
|
||||
|
||||
# parttion the slice if it crosses the x-axis
|
||||
%slice = (
|
||||
startAngle => $startAngle,
|
||||
angle => $angle,
|
||||
avgAngle => $avgAngle,
|
||||
stopAngle => $stopAngle,
|
||||
%sliceData
|
||||
);
|
||||
|
||||
my $hopsa = $self->calcCoordinates(\%slice);
|
||||
$sliceData{overallStartCorner} = $hopsa->{startCorner};
|
||||
$sliceData{overallEndCorner} = $hopsa->{endCorner};
|
||||
$sliceData{overallBigCircle} = $hopsa->{bigCircle};
|
||||
|
||||
my $leftIntersect = pi;
|
||||
my $rightIntersect = $leftIntersect+pi;
|
||||
|
||||
if ($startAngle < $leftIntersect) {
|
||||
if ($stopAngle > $leftIntersect || $stopAngle < $startAngle) {
|
||||
%slice = (
|
||||
startAngle => $startAngle,
|
||||
angle => $leftIntersect - $startAngle,
|
||||
stopAngle => $leftIntersect,
|
||||
avgAngle => $avgAngle,
|
||||
####
|
||||
drawStartPlane => 1,
|
||||
drawStopPlane => 0,
|
||||
drawTopPlane => 1,
|
||||
id => scalar(@{$self->{_slices}}),
|
||||
%sliceData
|
||||
);
|
||||
$mainStopDraw = 0;
|
||||
$startAngle = $leftIntersect;
|
||||
|
||||
$leftMost = { %slice, %{$self->calcCoordinates(\%slice)} };
|
||||
|
||||
push (@{$self->{_slices}}, $leftMost);
|
||||
}
|
||||
|
||||
if ($stopAngle < $startAngle) {
|
||||
%slice = (
|
||||
startAngle => $leftIntersect,
|
||||
angle => pi,
|
||||
stopAngle => $rightIntersect,
|
||||
avgAngle => $avgAngle,
|
||||
####
|
||||
drawStartPlane => 0,
|
||||
drawStopPlane => 0,
|
||||
drawTopPlane => 0,
|
||||
id => scalar(@{$self->{_slices}}),
|
||||
%sliceData
|
||||
);
|
||||
$mainStopDraw = 0;
|
||||
$startAngle = 0;
|
||||
|
||||
$center = { %slice, %{$self->calcCoordinates(\%slice)} };
|
||||
|
||||
push (@{$self->{_slices}}, $center);
|
||||
}
|
||||
|
||||
|
||||
%slice = (
|
||||
mainSlice => 1,
|
||||
startAngle => $startAngle,
|
||||
angle => $stopAngle - $startAngle,
|
||||
stopAngle => $stopAngle,
|
||||
avgAngle => $avgAngle,
|
||||
####
|
||||
drawStartPlane => !defined($leftMost->{drawStartPlane}),
|
||||
drawStopPlane => 1,
|
||||
drawTopPlane => !$leftMost->{drawTopPlane},
|
||||
id => scalar(@{$self->{_slices}}),
|
||||
%sliceData
|
||||
);
|
||||
$mainStopDraw = 0;
|
||||
$rightMost = { %slice, %{$self->calcCoordinates(\%slice)} };
|
||||
|
||||
push (@{$self->{_slices}}, $rightMost );
|
||||
} else {
|
||||
if ($stopAngle < $leftIntersect || $stopAngle < $startAngle) {
|
||||
%slice = (
|
||||
startAngle => $startAngle,
|
||||
angle => $rightIntersect - $startAngle,
|
||||
stopAngle => $rightIntersect,
|
||||
avgAngle => $avgAngle,
|
||||
####
|
||||
drawStartPlane => 1,
|
||||
drawStopPlane => 0,
|
||||
drawTopPlane => 0,
|
||||
id => scalar(@{$self->{_slices}}),
|
||||
%sliceData
|
||||
);
|
||||
$mainStopDraw = 0;
|
||||
$startAngle = 0;
|
||||
|
||||
$leftMost = { %slice, %{$self->calcCoordinates(\%slice)} };
|
||||
$overallStartCorner = $leftMost->{startCorner};
|
||||
|
||||
push (@{$self->{_slices}}, $leftMost);
|
||||
}
|
||||
|
||||
if ($stopAngle < $startAngle && $stopAngle > $leftIntersect) {
|
||||
%slice = (
|
||||
startAngle => 0,
|
||||
angle => pi,
|
||||
stopAngle => $leftIntersect,
|
||||
avgAngle => $avgAngle,
|
||||
####
|
||||
drawStartPlane => 0,
|
||||
drawStopPlane => 0,
|
||||
drawTopPlane => 0,
|
||||
id => scalar(@{$self->{_slices}}),
|
||||
%sliceData
|
||||
);
|
||||
$mainStopDraw = 0;
|
||||
$startAngle = $leftIntersect;
|
||||
|
||||
$center = { %slice, %{$self->calcCoordinates(\%slice)} };
|
||||
|
||||
push (@{$self->{_slices}}, $center);
|
||||
}
|
||||
|
||||
|
||||
%slice = (
|
||||
mainSlice => 1,
|
||||
startAngle => $startAngle,
|
||||
angle => $stopAngle - $startAngle,
|
||||
stopAngle => $stopAngle,
|
||||
avgAngle => $avgAngle,
|
||||
####
|
||||
drawStartPlane => !defined($leftMost->{drawStartPlane}),
|
||||
drawStopPlane => 1,
|
||||
drawTopPlane => !$leftMost->{drawTopPlane},
|
||||
id => scalar(@{$self->{_slices}}),
|
||||
%sliceData
|
||||
);
|
||||
$mainStopDraw = 0;
|
||||
$startAngle = $leftIntersect;
|
||||
|
||||
$rightMost = { %slice, %{$self->calcCoordinates(\%slice)} };
|
||||
|
||||
push (@{$self->{_slices}}, $rightMost);
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub calcCoordinates {
|
||||
my ($pieHeight, $pieWidth, $offsetX, $offsetY, $coords);
|
||||
my $self = shift;
|
||||
my $slice = shift;
|
||||
|
||||
$pieHeight = $self->getRadius * cos(2 * pi * $self->getTiltAngle / 360);
|
||||
$pieWidth = $self->getRadius;
|
||||
|
||||
# Translate the origin from the top corner to the center of the image.
|
||||
$offsetX = $self->getXOffset;
|
||||
$offsetY = $self->getYOffset;
|
||||
|
||||
$offsetX += ($self->getRadius/($pieWidth+$pieHeight))*$slice->{explosionLength}*cos($slice->{avgAngle});
|
||||
$offsetY -= ($pieHeight/($pieWidth+$pieHeight))*$slice->{explosionLength}*sin($slice->{avgAngle});
|
||||
|
||||
$coords->{bigCircle} = ($slice->{angle} > pi) ? '1' : '0';
|
||||
$coords->{tip}->{x} = $offsetX;
|
||||
$coords->{tip}->{y} = $offsetY;
|
||||
$coords->{startCorner}->{x} = $offsetX + $pieWidth*$slice->{scaleFactor}*cos($slice->{startAngle});
|
||||
$coords->{startCorner}->{y} = $offsetY - $pieHeight*$slice->{scaleFactor}*sin($slice->{startAngle});
|
||||
$coords->{endCorner}->{x} = $offsetX + $pieWidth*$slice->{scaleFactor}*cos($slice->{stopAngle});
|
||||
$coords->{endCorner}->{y} = $offsetY - $pieHeight*$slice->{scaleFactor}*sin($slice->{stopAngle});
|
||||
|
||||
return $coords;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub configurationForm {
|
||||
my $self = shift;
|
||||
|
||||
my $i18n = WebGUI::International->new($self->session, 'Image_Graph_Pie');
|
||||
|
||||
my $f = WebGUI::HTMLForm->new($self->session);
|
||||
$f->trClass('Graph_Pie');
|
||||
$f->float(
|
||||
-name => 'pie_radius',
|
||||
-value => $self->getRadius,
|
||||
-label => $i18n->get('radius'),
|
||||
);
|
||||
$f->float(
|
||||
-name => 'pie_topHeight',
|
||||
-value => $self->getTopHeight,
|
||||
-label => $i18n->get('pie height'),
|
||||
-hoverHelp => 'Only has effect on 3d pies',
|
||||
);
|
||||
$f->float(
|
||||
-name => 'pie_tiltAngle',
|
||||
-value => $self->getTiltAngle,
|
||||
-label => $i18n->get('tilt angle'),
|
||||
);
|
||||
$f->float(
|
||||
-name => 'pie_startAngle',
|
||||
-value => $self->getStartAngle,
|
||||
-label => $i18n->get('start angle'),
|
||||
);
|
||||
$f->selectBox(
|
||||
-name => 'pie_pieMode',
|
||||
-value => [ $self->getPieMode ],
|
||||
-label => $i18n->get('pie mode'),
|
||||
-options => {
|
||||
normal => $i18n->get('normal'),
|
||||
stepped => $i18n->get('stepped'),
|
||||
},
|
||||
);
|
||||
$f->yesNo(
|
||||
-name => 'pie_shadedSides',
|
||||
-value => $self->hasShadedSides,
|
||||
-label => $i18n->get('shade sides'),
|
||||
);
|
||||
$f->float(
|
||||
-name => 'pie_stickLength',
|
||||
-value => $self->getStickLength,
|
||||
-label => $i18n->get('stick length'),
|
||||
);
|
||||
$f->float(
|
||||
-name => 'pie_stickOffset',
|
||||
-value => $self->getStickOffset,
|
||||
-label => $i18n->get('stick offset'),
|
||||
);
|
||||
$f->color(
|
||||
-name => 'pie_stickColor',
|
||||
-value => $self->getStickColor,
|
||||
-label => $i18n->get('stick color'),
|
||||
);
|
||||
$f->selectBox(
|
||||
-name => 'pie_labelPosition',
|
||||
-value => [ $self->getLabelPosition ],
|
||||
-label => $i18n->get('label position'),
|
||||
-options=> {
|
||||
center => $i18n->get('center'),
|
||||
top => $i18n->get('top'),
|
||||
bottom => $i18n->get('bottom'),
|
||||
},
|
||||
);
|
||||
|
||||
my $configForms = $self->SUPER::configurationForm;
|
||||
$configForms->{'graph_pie'} = $f->printRowsOnly;
|
||||
|
||||
return $configForms;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub draw {
|
||||
my ($currentSlice, $coordinates, $sliceData, $leftPlaneVisible, $rightPlaneVisible);
|
||||
my $self = shift;
|
||||
|
||||
$self->processDataset;
|
||||
|
||||
# Draw slices in the correct order or you'll get an MC Escher.
|
||||
my @slices = sort sortSlices @{$self->{_slices}};
|
||||
|
||||
# First draw the bottom planes and the labels behind the chart.
|
||||
foreach $sliceData (@slices) {
|
||||
# Draw bottom
|
||||
$self->drawBottom($sliceData);
|
||||
|
||||
if (_mod2pi($sliceData->{avgAngle}) > 0 && _mod2pi($sliceData->{avgAngle}) <= pi) {
|
||||
$self->drawLabel($sliceData);
|
||||
}
|
||||
}
|
||||
|
||||
# Second draw the sides
|
||||
# If angle == 0 do a 2d pie
|
||||
if ($self->getTiltAngle != 0) {
|
||||
foreach $sliceData (@slices) { #(sort sortSlices @{$self->{_slices}}) {
|
||||
$leftPlaneVisible = (_mod2pi($sliceData->{startAngle}) <= 0.5*pi || _mod2pi($sliceData->{startAngle} >= 1.5*pi));
|
||||
$rightPlaneVisible = (_mod2pi($sliceData->{stopAngle}) >= 0.5*pi && _mod2pi($sliceData->{stopAngle} <= 1.5*pi));
|
||||
|
||||
if ($leftPlaneVisible && $rightPlaneVisible) {
|
||||
$self->drawRim($sliceData);
|
||||
$self->drawRightSide($sliceData);
|
||||
$self->drawLeftSide($sliceData);
|
||||
} elsif ($leftPlaneVisible && !$rightPlaneVisible) {
|
||||
# right plane invisible
|
||||
$self->drawRightSide($sliceData);
|
||||
$self->drawRim($sliceData);
|
||||
$self->drawLeftSide($sliceData);
|
||||
} elsif (!$leftPlaneVisible && $rightPlaneVisible) {
|
||||
# left plane invisible
|
||||
$self->drawLeftSide($sliceData);
|
||||
$self->drawRim($sliceData);
|
||||
$self->drawRightSide($sliceData);
|
||||
} else {
|
||||
$self->drawLeftSide($sliceData);
|
||||
$self->drawRightSide($sliceData);
|
||||
$self->drawRim($sliceData);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Finally draw the top planes of each slice and the labels that are in front of the chart.
|
||||
foreach $sliceData (@slices) {
|
||||
$self->drawTop($sliceData) if ($self->getTiltAngle != 0);
|
||||
|
||||
if (_mod2pi($sliceData->{avgAngle}) > pi) {
|
||||
$self->drawLabel($sliceData);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub drawBottom {
|
||||
my $self = shift;
|
||||
my $slice = shift;
|
||||
|
||||
$self->drawPieSlice($slice, -1 * $slice->{bottomHeight}, $slice->{bottomColor}) if ($slice->{drawTopPlane});
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub drawLabel {
|
||||
my ($startRadius, $stopRadius, $pieHeight, $pieWidth, $startPointX, $startPointY,
|
||||
$endPointX, $endPointY);
|
||||
my $self = shift;
|
||||
my $slice = shift;
|
||||
|
||||
# Draw labels only once
|
||||
return unless ($slice->{mainSlice});
|
||||
|
||||
$startRadius = $self->getRadius * $slice->{scaleFactor}+ $self->getStickOffset;
|
||||
$stopRadius = $startRadius + $self->getStickLength;
|
||||
|
||||
$pieHeight = $self->getRadius * cos(2 * pi * $self->getTiltAngle / 360);
|
||||
$pieWidth = $self->getRadius;
|
||||
|
||||
$startPointX = $self->getXOffset + ($slice->{explosionLength}*$pieWidth/($pieHeight+$pieWidth)+$startRadius) * cos($slice->{avgAngle});
|
||||
$startPointY = $self->getYOffset - ($slice->{explosionLength}*$pieHeight/($pieHeight+$pieWidth)+$startRadius) * sin($slice->{avgAngle}) * cos(2 * pi * $self->getTiltAngle / 360);
|
||||
$endPointX = $self->getXOffset + ($slice->{explosionLength}*$pieWidth/($pieHeight+$pieWidth)+$stopRadius) * cos($slice->{avgAngle});
|
||||
$endPointY = $self->getYOffset - ($slice->{explosionLength}*$pieHeight/($pieHeight+$pieWidth)+$stopRadius) * sin($slice->{avgAngle}) * cos(2 * pi * $self->getTiltAngle / 360);
|
||||
|
||||
if ($self->getTiltAngle) {
|
||||
if ($self->getLabelPosition eq 'center') {
|
||||
$startPointY -= ($slice->{topHeight} - $slice->{bottomHeight}) / 2;
|
||||
$endPointY -= ($slice->{topHeight} - $slice->{bottomHeight}) / 2;
|
||||
}
|
||||
elsif ($self->getLabelPosition eq 'top') {
|
||||
$startPointY -= $slice->{topHeight};
|
||||
$endPointY -= $slice->{topHeight};
|
||||
}
|
||||
elsif ($self->getLabelPosition eq 'bottom') {
|
||||
$startPointY += $slice->{bottomHeight};
|
||||
$endPointY += $slice->{bottomHeight};
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
# Draw the stick
|
||||
if ($self->getStickLength){
|
||||
$self->image->Draw(
|
||||
primitive => 'Path',
|
||||
stroke => $self->getStickColor,
|
||||
strokewidth => 3,
|
||||
points =>
|
||||
" M $startPointX,$startPointY ".
|
||||
" L $endPointX,$endPointY ",
|
||||
fill => 'none',
|
||||
);
|
||||
}
|
||||
|
||||
# Process the textlabel
|
||||
my $horizontalAlign = 'center';
|
||||
my $align = 'Center';
|
||||
if ($slice->{avgAngle} > 0.5 * pi && $slice->{avgAngle} < 1.5 * pi) {
|
||||
$horizontalAlign = 'right';
|
||||
$align = 'Right';
|
||||
}
|
||||
elsif ($slice->{avgAngle} > 1.5 * pi || $slice->{avgAngle} < 0.5 * pi) {
|
||||
$horizontalAlign = 'left';
|
||||
$align = 'Left';
|
||||
}
|
||||
|
||||
my $verticalAlign = 'center';
|
||||
$verticalAlign = 'bottom' if ($slice->{avgAngle} == 0.5 * pi);
|
||||
$verticalAlign = 'top' if ($slice->{avgAngle} == 1.5 * pi);
|
||||
|
||||
my $anchorX = $endPointX + $self->getLabelOffset;
|
||||
$anchorX = $endPointX - $self->getLabelOffset if ($horizontalAlign eq 'right');
|
||||
|
||||
my $text = $slice->{label} || sprintf('%.1f', $slice->{percentage}*100).' %';
|
||||
|
||||
my $maxWidth = $anchorX;
|
||||
$maxWidth = $self->getImageWidth - $anchorX if ($slice->{avgAngle} > 1.5 * pi || $slice->{avgAngle} < 0.5 * pi);
|
||||
|
||||
$self->SUPER::drawLabel(
|
||||
text => $self->wrapLabelToWidth($text, $maxWidth),
|
||||
alignHorizontal => $horizontalAlign,
|
||||
align => $align,
|
||||
alignVertical => $verticalAlign,
|
||||
x => $anchorX,
|
||||
y => $endPointY,
|
||||
);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub drawLeftSide {
|
||||
my $self = shift;
|
||||
my $slice = shift;
|
||||
|
||||
$self->drawSide($slice) if ($slice->{drawStartPlane});
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub drawPieSlice {
|
||||
my (%tip, %startCorner, %endCorner, $pieWidth, $pieHeight, $bigCircle,
|
||||
$strokePath);
|
||||
my $self = shift;
|
||||
my $slice = shift;
|
||||
my $offset = shift || 0;
|
||||
my $fillColor = shift;
|
||||
|
||||
%tip = (
|
||||
x => $slice->{tip}->{x},
|
||||
y => $slice->{tip}->{y} - $offset,
|
||||
);
|
||||
%startCorner = (
|
||||
x => $slice->{overallStartCorner}->{x},
|
||||
y => $slice->{overallStartCorner}->{y} - $offset,
|
||||
);
|
||||
%endCorner = (
|
||||
x => $slice->{overallEndCorner}->{x},
|
||||
y => $slice->{overallEndCorner}->{y} - $offset,
|
||||
);
|
||||
|
||||
$pieWidth = $self->getRadius;
|
||||
$pieHeight = $self->getRadius * cos(2 * pi * $self->getTiltAngle / 360);
|
||||
$bigCircle = $slice->{overallBigCircle};
|
||||
|
||||
$self->image->Draw(
|
||||
primitive => 'Path',
|
||||
stroke => $slice->{strokeColor},
|
||||
points =>
|
||||
" M $tip{x},$tip{y} ".
|
||||
" L $startCorner{x},$startCorner{y} ".
|
||||
" A $pieWidth,$pieHeight 0 $bigCircle,0 $endCorner{x},$endCorner{y} ".
|
||||
" Z ",
|
||||
fill => $fillColor,
|
||||
);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub drawRightSide {
|
||||
my $self = shift;
|
||||
my $slice = shift;
|
||||
|
||||
$self->drawSide($slice, 'endCorner', $slice->{stopPlaneColor}) if ($slice->{drawStopPlane});
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub drawRim {
|
||||
my (%startSideTop, %startSideBottom, %endSideTop, %endSideBottom,
|
||||
$pieWidth, $pieHeight, $bigCircle);
|
||||
my $self = shift;
|
||||
my $slice = shift;
|
||||
|
||||
%startSideTop = (
|
||||
x => $slice->{startCorner}->{x},
|
||||
y => $slice->{startCorner}->{y} - $slice->{topHeight}
|
||||
);
|
||||
%startSideBottom = (
|
||||
x => $slice->{startCorner}->{x},
|
||||
y => $slice->{startCorner}->{y} + $slice->{bottomHeight}
|
||||
);
|
||||
%endSideTop = (
|
||||
x => $slice->{endCorner}->{x},
|
||||
y => $slice->{endCorner}->{y} - $slice->{topHeight}
|
||||
);
|
||||
%endSideBottom = (
|
||||
x => $slice->{endCorner}->{x},
|
||||
y => $slice->{endCorner}->{y} + $slice->{bottomHeight}
|
||||
);
|
||||
|
||||
$pieWidth = $self->getRadius;
|
||||
$pieHeight = $self->getRadius * cos(2 * pi * $self->getTiltAngle / 360);
|
||||
$bigCircle = $slice->{bigCircle};
|
||||
|
||||
# Draw curvature
|
||||
$self->image->Draw(
|
||||
primitive => 'Path',
|
||||
stroke => $slice->{strokeColor},
|
||||
points =>
|
||||
" M $startSideBottom{x},$startSideBottom{y} ".
|
||||
" A $pieWidth,$pieHeight 0 $bigCircle,0 $endSideBottom{x},$endSideBottom{y} ".
|
||||
" L $endSideTop{x}, $endSideTop{y} ".
|
||||
" A $pieWidth,$pieHeight 0 $bigCircle,1 $startSideTop{x},$startSideTop{y}".
|
||||
" Z",
|
||||
fill => $slice->{rimColor},
|
||||
);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub drawSide {
|
||||
my (%tipTop, %tipBottom, %rimTop, %rimBottom);
|
||||
my $self = shift;
|
||||
my $slice = shift;
|
||||
my $cornerName = shift || 'startCorner';
|
||||
my $color = shift || $slice->{startPlaneColor};
|
||||
|
||||
%tipTop = (
|
||||
x => $slice->{tip}->{x},
|
||||
y => $slice->{tip}->{y} - $slice->{topHeight}
|
||||
);
|
||||
%tipBottom = (
|
||||
x => $slice->{tip}->{x},
|
||||
y => $slice->{tip}->{y} + $slice->{bottomHeight}
|
||||
);
|
||||
%rimTop = (
|
||||
x => $slice->{$cornerName}->{x},
|
||||
y => $slice->{$cornerName}->{y} - $slice->{topHeight}
|
||||
);
|
||||
%rimBottom = (
|
||||
x => $slice->{$cornerName}->{x},
|
||||
y => $slice->{$cornerName}->{y} + $slice->{bottomHeight}
|
||||
);
|
||||
|
||||
$self->image->Draw(
|
||||
primitive => 'Path',
|
||||
stroke => $slice->{strokeColor},
|
||||
points =>
|
||||
" M $tipBottom{x},$tipBottom{y} ".
|
||||
" L $rimBottom{x},$rimBottom{y} ".
|
||||
" L $rimTop{x},$rimTop{y} ".
|
||||
" L $tipTop{x},$tipTop{y} ".
|
||||
" Z ",
|
||||
fill => $color,
|
||||
);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub drawTop {
|
||||
my $self = shift;
|
||||
my $slice = shift;
|
||||
|
||||
$self->drawPieSlice($slice, $slice->{topHeight}, $slice->{topColor}) if ($slice->{drawTopPlane});
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub formNamespace {
|
||||
my $self = shift;
|
||||
|
||||
return $self->SUPER::formNamespace.'_Pie';
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getBottomHeight {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_pieProperties}->{bottomHeight} || 0;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getConfiguration {
|
||||
my $self = shift;
|
||||
|
||||
my $config = $self->SUPER::getConfiguration;
|
||||
|
||||
$config->{pie_radius} = $self->getRadius;
|
||||
$config->{pie_tiltAngle} = $self->getTiltAngle;
|
||||
$config->{pie_startAngle} = $self->getStartAngle;
|
||||
$config->{pie_shadedSides} = $self->hasShadedSides;
|
||||
$config->{pie_topHeight} = $self->getTopHeight;
|
||||
$config->{pie_stickLength} = $self->getStickLength;
|
||||
$config->{pie_stickOffset} = $self->getStickOffset;
|
||||
$config->{pie_stickColor} = $self->getStickColor;
|
||||
$config->{pie_labelPosition} = $self->getLabelPosition;
|
||||
$config->{pie_pieMode} = $self->getPieMode;
|
||||
return $config;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getDataset {
|
||||
my $self = shift;
|
||||
|
||||
return $self->SUPER::getDataset(0);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getExplosionLength {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_pieProperties}->{explosionLength} || 0;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getLabels {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_labels}->{data};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getLabelPosition {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_pieProperties}->{labelPosition} || 'top';
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getPieMode {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_pieProperties}->{pieMode} || 'normal';
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getRadius {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_pieProperties}->{radius} || 80;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getScaleFactor {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_pieProperties}->{scaleFactor} || 1;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getSlice {
|
||||
my $self = shift;
|
||||
my $slice = shift || (scalar(@{$self->{_slices}}) - 1);
|
||||
|
||||
return $self->{_slices}->[$slice];
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getStartAngle {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_pieProperties}->{startAngle} || 0;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getStickColor {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_pieProperties}->{stickColor} || '#333333';
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getStickLength {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_pieProperties}->{stickLength} || 0;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getStickOffset {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_pieProperties}->{stickOffset} || 0;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getTiltAngle {
|
||||
my $self = shift;
|
||||
my $angle = shift;
|
||||
|
||||
return $self->{_pieProperties}->{tiltAngle} || 55;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getTopHeight {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_pieProperties}->{topHeight} || 20;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub hasShadedSides {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_pieProperties}->{shadedSides} || '0';
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub new {
|
||||
my $class = shift;
|
||||
|
||||
my $self = $class->SUPER::new(@_);
|
||||
$self->{_slices} = [];
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub processDataset {
|
||||
my $self = shift;
|
||||
my $total = 0;
|
||||
foreach (@{$self->getDataset}) {
|
||||
$total += $_;
|
||||
}
|
||||
|
||||
my $dataIndex = 0;
|
||||
|
||||
my $stepsize = ($self->getTopHeight + $self->getBottomHeight) / scalar(@{$self->getDataset});
|
||||
foreach (@{$self->getDataset}) {
|
||||
$dataIndex;
|
||||
|
||||
$self->addSlice({
|
||||
percentage => $_ / $total,
|
||||
label => $self->getLabel($dataIndex),
|
||||
color => $self->getPalette->getNextColor,
|
||||
}) if ($_);
|
||||
|
||||
$self->setTopHeight($self->getTopHeight - $stepsize) if ($self->getPieMode eq 'stepped');
|
||||
|
||||
$dataIndex++;
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setBottomHeight {
|
||||
my $self = shift;
|
||||
my $height = shift;
|
||||
|
||||
$self->{_pieProperties}->{bottomHeight} = $height;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setCenter {
|
||||
my $self = shift;
|
||||
my $xCenter = shift || 0;
|
||||
my $yCenter = shift || 0;
|
||||
|
||||
$self->{_pieProperties}->{xOffset} = $xCenter;
|
||||
$self->{_pieProperties}->{yOffset} = $yCenter;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setConfiguration {
|
||||
my $self = shift;
|
||||
my $config = shift;
|
||||
|
||||
$self->SUPER::setConfiguration($config);
|
||||
|
||||
$self->setRadius($config->{pie_radius});
|
||||
$self->setTiltAngle($config->{pie_tiltAngle});
|
||||
$self->setStartAngle($config->{pie_startAngle});
|
||||
$self->setShadedSides($config->{pie_shadedSides});
|
||||
$self->setTopHeight($config->{pie_topHeight});
|
||||
$self->setStickLength($config->{pie_stickLength});
|
||||
$self->setStickOffset($config->{pie_stickOffset});
|
||||
$self->setStickColor($config->{pie_stickColor});
|
||||
$self->setLabelPosition($config->{pie_labelPosition});
|
||||
$self->setPieMode($config->{pie_pieMode});
|
||||
|
||||
return $config;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setExplosionLength {
|
||||
my $self = shift;
|
||||
my $offset = shift;
|
||||
|
||||
$self->{_pieProperties}->{explosionLength} = $offset;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setLabelPosition {
|
||||
my $self = shift;
|
||||
my $position = shift;
|
||||
|
||||
$self->{_pieProperties}->{labelPosition} = $position;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setPieMode {
|
||||
my $self = shift;
|
||||
my $mode = shift;
|
||||
|
||||
$self->{_pieProperties}->{pieMode} = $mode;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setRadius {
|
||||
my $self = shift;
|
||||
my $radius = shift;
|
||||
my $innerRadius = shift;
|
||||
|
||||
$self->{_pieProperties}->{radius} = $radius;
|
||||
$self->{_pieProperties}->{innerRadius} = $innerRadius;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setStartAngle {
|
||||
my $self = shift;
|
||||
my $angle = shift;
|
||||
|
||||
$self->{_pieProperties}->{startAngle} = $angle;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setShadedSides {
|
||||
my $self = shift;
|
||||
my $onOff = shift;
|
||||
|
||||
$self->{_pieProperties}->{shadedSides} = $onOff;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setStickColor {
|
||||
my $self = shift;
|
||||
my $color = shift;
|
||||
|
||||
$self->{_pieProperties}->{stickColor} = $color;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setStickLength {
|
||||
my $self = shift;
|
||||
my $length = shift;
|
||||
|
||||
$self->{_pieProperties}->{stickLength} = $length;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setStickOffset {
|
||||
my $self = shift;
|
||||
my $offset = shift || 0;
|
||||
|
||||
$self->{_pieProperties}->{stickOffset} = $offset;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setTiltAngle {
|
||||
my $self = shift;
|
||||
my $angle = shift;
|
||||
|
||||
$angle = 0 if ($angle < 0);
|
||||
$angle = 90 if ($angle > 90);
|
||||
|
||||
$self->{_pieProperties}->{tiltAngle} = $angle;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setTopHeight {
|
||||
my $self = shift;
|
||||
my $height = shift;
|
||||
|
||||
$self->{_pieProperties}->{topHeight} = $height;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub sortSlices {
|
||||
my ($startA, $stopA, $startB, $stopB, $distA, $distB);
|
||||
my $self = shift;
|
||||
|
||||
my $aStartAngle = $a->{startAngle};
|
||||
my $aStopAngle = $a->{stopAngle};
|
||||
my $bStartAngle = $b->{startAngle};
|
||||
my $bStopAngle = $b->{stopAngle};
|
||||
|
||||
# If sliceA and sliceB are in different halfplanes sorting is easy...
|
||||
return -1 if ($aStartAngle < pi && $bStartAngle >= pi);
|
||||
return 1 if ($aStartAngle >= pi && $bStartAngle < pi);
|
||||
|
||||
if ($aStartAngle < pi) {
|
||||
if ($aStopAngle <= 0.5*pi && $bStopAngle <= 0.5* pi) {
|
||||
# A and B in quadrant I
|
||||
return 1 if ($aStartAngle < $bStartAngle);
|
||||
return -1;
|
||||
} elsif ($aStartAngle >= 0.5*pi && $bStartAngle >= 0.5*pi) {
|
||||
# A and B in quadrant II
|
||||
return 1 if ($aStartAngle > $bStartAngle);
|
||||
return -1;
|
||||
} elsif ($aStartAngle < 0.5*pi && $aStopAngle >= 0.5*pi) {
|
||||
# A in both quadrant I and II
|
||||
return -1;
|
||||
} else {
|
||||
# B in both quadrant I and II
|
||||
return 1;
|
||||
}
|
||||
} else {
|
||||
if ($aStopAngle <= 1.5*pi && $bStopAngle <= 1.5*pi) {
|
||||
# A and B in quadrant III
|
||||
return 1 if ($aStopAngle > $bStopAngle);
|
||||
return -1;
|
||||
} elsif ($aStartAngle >= 1.5*pi && $bStartAngle >= 1.5*pi) {
|
||||
# A and B in quadrant IV
|
||||
return 1 if ($aStartAngle < $bStartAngle);
|
||||
return -1;
|
||||
} elsif ($aStartAngle <= 1.5*pi && $aStopAngle >= 1.5*pi) {
|
||||
# A in both quadrant III and IV
|
||||
return 1;
|
||||
} else {
|
||||
# B in both quadrant III and IV
|
||||
return -1;
|
||||
}
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
394
lib/WebGUI/Image/Graph/XYGraph.pm
Normal file
394
lib/WebGUI/Image/Graph/XYGraph.pm
Normal file
|
|
@ -0,0 +1,394 @@
|
|||
package WebGUI::Image::Graph::XYGraph;
|
||||
|
||||
use strict;
|
||||
use WebGUI::Image::Graph;
|
||||
use WebGUI::International;
|
||||
use List::Util;
|
||||
use POSIX;
|
||||
|
||||
our @ISA = qw(WebGUI::Image::Graph);
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub configurationForm {
|
||||
my ($configForms, $f);
|
||||
my $self = shift;
|
||||
|
||||
my $i18n = WebGUI::International->new($self->session, 'Image_Graph_XYGraph');
|
||||
|
||||
$configForms = $self->SUPER::configurationForm;
|
||||
|
||||
$f = WebGUI::HTMLForm->new($self->session);
|
||||
$f->trClass('Graph_XYGraph');
|
||||
$f->integer(
|
||||
name => 'xyGraph_chartWidth',
|
||||
value => $self->getChartWidth,
|
||||
label => $i18n->get('chart width'),
|
||||
);
|
||||
$f->integer(
|
||||
name => 'xyGraph_chartHeight',
|
||||
value => $self->getChartHeight,
|
||||
label => $i18n->get('chart height'),
|
||||
);
|
||||
$f->yesNo(
|
||||
name => 'xyGraph_drawLabels',
|
||||
value => $self->showLabels,
|
||||
label => $i18n->get('draw labels'),
|
||||
);
|
||||
$f->yesNo(
|
||||
name => 'xyGraph_drawAxis',
|
||||
value => $self->showAxis,
|
||||
label => $i18n->get('draw axis'),
|
||||
);
|
||||
$f->color(
|
||||
name => 'xyGraph_axisColor',
|
||||
value => $self->getAxisColor,
|
||||
label => $i18n->get('axis color'),
|
||||
);
|
||||
$f->yesNo(
|
||||
name => 'xyGraph_drawRulers',
|
||||
value => $self->showRulers,
|
||||
label => $i18n->get('draw rulers'),
|
||||
);
|
||||
$f->color(
|
||||
name => 'xyGraph_rulerColor',
|
||||
value => $self->getRulerColor,
|
||||
label => $i18n->get('ruler color'),
|
||||
);
|
||||
$f->selectBox(
|
||||
name => 'xyGraph_drawMode',
|
||||
value => [ $self->getDrawMode ],
|
||||
label => $i18n->get('draw mode'),
|
||||
multiple=> 0,
|
||||
options => {
|
||||
sideBySide => 'Side by side',
|
||||
stacked => 'Stacked (cumulative',
|
||||
},
|
||||
);
|
||||
$f->float(
|
||||
name => 'xyGraph_yGranularity',
|
||||
value => $self->getYGranularity,
|
||||
label => $i18n->get('y granularity'),
|
||||
);
|
||||
|
||||
$configForms->{'graph_xygraph'} = $f->printRowsOnly;
|
||||
return $configForms;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub draw {
|
||||
my $self = shift;
|
||||
|
||||
# Automagically set the chart offset.
|
||||
my $maxYLabelWidth = List::Util::max(map {$self->getLabelDimensions($_)->{width}} @{$self->getYLabels});
|
||||
$self->setChartOffset({
|
||||
x=> $maxYLabelWidth + 2*$self->getLabelOffset,
|
||||
y=> $self->getLabelOffset
|
||||
});
|
||||
|
||||
$self->drawRulers if ($self->showRulers);
|
||||
$self->drawGraph;
|
||||
$self->drawAxis if ($self->showAxis);
|
||||
$self->drawLabels if ($self->showLabels);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub drawAxis {
|
||||
my $self = shift;
|
||||
|
||||
my $chartOffset = $self->getChartOffset;
|
||||
$self->image->Draw(
|
||||
primitive => 'Path',
|
||||
stroke => $self->getAxisColor,
|
||||
points =>
|
||||
" M ".$chartOffset->{x}.",".$chartOffset->{y}.
|
||||
" L ".$chartOffset->{x}.",".($self->getChartHeight + $chartOffset->{y}).
|
||||
" L ".($self->getChartWidth + $chartOffset->{x}).",".($self->getChartHeight + $chartOffset->{y})
|
||||
);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub drawLabels {
|
||||
my $self = shift;
|
||||
my $location = shift;
|
||||
|
||||
my %anchorPoint = %{$self->getFirstAnchorLocation};# %$location;
|
||||
|
||||
# Draw x-axis labels
|
||||
foreach (@{$self->getLabel}) {
|
||||
my $text = $self->wrapLabelToWidth($_, $self->getAnchorSpacing->{x});
|
||||
$self->drawLabel(
|
||||
text => $text,
|
||||
alignHorizontal => 'center',
|
||||
alignVertical => 'top',
|
||||
align => 'Center',
|
||||
x => $anchorPoint{x},
|
||||
y => $anchorPoint{y},
|
||||
);
|
||||
|
||||
$anchorPoint{x} += $self->getAnchorSpacing->{x}; #$groupWidth + $self->getGroupSpacing;
|
||||
$anchorPoint{y} += $self->getAnchorSpacing->{y};
|
||||
}
|
||||
|
||||
# Draw y-axis labels
|
||||
$anchorPoint{x} = $self->getChartOffset->{x} - $self->getLabelOffset;
|
||||
$anchorPoint{y} = $self->getChartOffset->{y} + $self->getChartHeight;
|
||||
# for (1 .. $self->getYRange / $self->getYGranularity) {
|
||||
foreach (@{$self->getYLabels}) {
|
||||
$self->drawLabel(
|
||||
text => $_,
|
||||
alignHorizontal => 'right',
|
||||
alignVertical => 'center',
|
||||
x => $anchorPoint{x}, #$self->getChartOffset->{x} - $self->getLabelOffset,
|
||||
y => $anchorPoint{y}, #$self->getChartOffset->{y} + $self->getChartHeight - $self->getPixelsPerUnit * $_*$self->getYGranularity,
|
||||
);
|
||||
$anchorPoint{y} -= $self->getPixelsPerUnit * $self->getYGranularity
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub drawRulers {
|
||||
my $self = shift;
|
||||
|
||||
my $chartOffset = $self->getChartOffset;
|
||||
my $dist = $self->getLabelOffset;
|
||||
|
||||
for (1 .. $self->getYRange / $self->getYGranularity) {
|
||||
$self->image->Draw(
|
||||
primitive => 'Path',
|
||||
stroke => $self->getRulerColor,
|
||||
points =>
|
||||
" M ".$chartOffset->{x}.",".($chartOffset->{y}+$self->getChartHeight - $self->getPixelsPerUnit * $_*$self->getYGranularity).
|
||||
" L ".($chartOffset->{x}+$self->getChartWidth).",".($chartOffset->{y}+$self->getChartHeight - $self->getPixelsPerUnit * $_*$self->getYGranularity)
|
||||
);
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub formNamespace {
|
||||
my $self = shift;
|
||||
|
||||
return $self->SUPER::formNamespace.'_XYGraph';
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getAxisColor {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_axisProperties}->{axisColor} || '#222222';
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getChartHeight {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_properties}->{chartHeight};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getChartOffset {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_properties}->{chartOffset} || { x=>0, y=>0 }
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getChartWidth {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_properties}->{chartWidth};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getConfiguration {
|
||||
my $self = shift;
|
||||
|
||||
my $config = $self->SUPER::getConfiguration;
|
||||
|
||||
$config->{xyGraph_chartWidth} = $self->getChartWidth;
|
||||
$config->{xyGraph_chartHeight} = $self->getChartHeight;
|
||||
$config->{xyGraph_drawLabels} = $self->showLabels;
|
||||
$config->{xyGraph_drawAxis} = $self->showAxis;
|
||||
$config->{xyGraph_drawRulers} = $self->showRulers;
|
||||
$config->{xyGraph_drawMode} = $self->getDrawMode;
|
||||
$config->{xyGraph_yGranularity} = $self->getYGranularity;
|
||||
|
||||
return $config;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getDrawMode {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_barProperties}->{drawMode} || 'sideBySide';
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getPixelsPerUnit {
|
||||
my $self = shift;
|
||||
|
||||
return $self->getChartHeight / $self->getYRange;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getRulerColor {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_axisProperties}->{rulerColor} || '#777777';
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getYGranularity {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_properties}->{yGranularity} || 50;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getYLabels {
|
||||
my $self = shift;
|
||||
|
||||
my @yLabels;
|
||||
for (0 .. $self->getYRange / $self->getYGranularity) {
|
||||
push(@yLabels, $_ * $self->getYGranularity);
|
||||
}
|
||||
|
||||
return \@yLabels;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getYRange {
|
||||
my $self = shift;
|
||||
|
||||
return $self->getYGranularity*ceil($self->getMaxValueFromDataset / $self->getYGranularity) || 1;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setAxisColor {
|
||||
my $self = shift;
|
||||
my $color = shift;
|
||||
|
||||
$self->{_axisProperties}->{axisColor} = $color;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setChartHeight {
|
||||
my $self = shift;
|
||||
my $height = shift;
|
||||
|
||||
$self->{_properties}->{chartHeight} = $height;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setChartOffset {
|
||||
my $self = shift;
|
||||
my $point = shift;
|
||||
|
||||
$self->{_properties}->{chartOffset} = {%$point};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setChartWidth {
|
||||
my $self = shift;
|
||||
my $width = shift;
|
||||
|
||||
$self->{_properties}->{chartWidth} =$width;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setConfiguration {
|
||||
my $self = shift;
|
||||
my $config = shift;
|
||||
|
||||
$self->SUPER::setConfiguration($config);
|
||||
|
||||
$self->setChartWidth($config->{xyGraph_chartWidth});
|
||||
$self->setChartHeight($config->{xyGraph_chartHeight});
|
||||
$self->setShowLabels($config->{xyGraph_drawLabels});
|
||||
$self->setShowAxis($config->{xyGraph_drawAxis});
|
||||
$self->setShowRulers($config->{xyGraph_drawRulers});
|
||||
$self->setDrawMode($config->{xyGraph_drawMode});
|
||||
$self->setYGranularity($config->{xyGraph_yGranularity});
|
||||
$self->setAxisColor($config->{xyGraph_axisColor});
|
||||
$self->setRulerColor($config->{xyGraph_rulerColor});
|
||||
|
||||
return $config;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setDrawMode {
|
||||
my $self = shift;
|
||||
my $mode = shift;
|
||||
|
||||
if ($mode eq 'stacked' || $mode eq 'sideBySide') {
|
||||
$self->{_barProperties}->{drawMode} = $mode;
|
||||
} else {
|
||||
$self->{_barProperties}->{drawMode} = 'sideBySide';
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setRulerColor {
|
||||
my $self = shift;
|
||||
my $color = shift;
|
||||
|
||||
$self->{_axisProperties}->{rulerColor} = $color;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setShowAxis {
|
||||
my $self = shift;
|
||||
my $yesNo = shift;
|
||||
|
||||
$self->{_properties}->{showAxis} = $yesNo;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setShowLabels {
|
||||
my $self = shift;
|
||||
my $yesNo = shift;
|
||||
|
||||
$self->{_properties}->{showLabels} = $yesNo;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setShowRulers {
|
||||
my $self = shift;
|
||||
my $yesNo = shift;
|
||||
|
||||
$self->{_properties}->{showRulers} = $yesNo;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setYGranularity {
|
||||
my $self = shift;
|
||||
my $granularity = shift;
|
||||
|
||||
$self->{_properties}->{yGranularity} = $granularity;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub showAxis {
|
||||
my $self = shift;
|
||||
|
||||
return 1 unless (defined $self->{_properties}->{showAxis});
|
||||
return $self->{_properties}->{showAxis};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub showLabels {
|
||||
my $self = shift;
|
||||
|
||||
return 1 unless (defined $self->{_properties}->{showLabels});
|
||||
return $self->{_properties}->{showLabels};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub showRulers {
|
||||
my $self = shift;
|
||||
|
||||
return 1 unless (defined $self->{_properties}->{showRulers});
|
||||
return $self->{_properties}->{showRulers};
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
224
lib/WebGUI/Image/Graph/XYGraph/Bar.pm
Normal file
224
lib/WebGUI/Image/Graph/XYGraph/Bar.pm
Normal file
|
|
@ -0,0 +1,224 @@
|
|||
package WebGUI::Image::Graph::XYGraph::Bar;
|
||||
|
||||
use strict;
|
||||
use WebGUI::Image::Graph::XYGraph;
|
||||
use List::Util;
|
||||
use POSIX;
|
||||
use Data::Dumper;
|
||||
|
||||
our @ISA = qw(WebGUI::Image::Graph::XYGraph);
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub configurationForm {
|
||||
my $self = shift;
|
||||
|
||||
my $i18n = WebGUI::International->new($self->session, 'Image_Graph_XYGraph_Bar');
|
||||
|
||||
my $configForms = $self->SUPER::configurationForm;
|
||||
my $f = WebGUI::HTMLForm->new($self->session);
|
||||
$f->trClass('Graph_XYGraph_Bar');
|
||||
$f->float(
|
||||
name => 'xyGraph_bar_barSpacing',
|
||||
value => $self->getBarSpacing,
|
||||
label => $i18n->get('bar spacing'),
|
||||
);
|
||||
$f->float(
|
||||
name => 'xyGraph_bar_groupSpacing',
|
||||
value => $self->getGroupSpacing,
|
||||
label => $i18n->get('group spacing'),
|
||||
);
|
||||
|
||||
$configForms->{'graph_xygraph_bar'} = $f->printRowsOnly;
|
||||
|
||||
return $configForms;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub drawBar {
|
||||
my $self = shift;
|
||||
my $bar = shift;
|
||||
my $location = shift;
|
||||
my $barWidth = shift;
|
||||
|
||||
my $barHeight = $bar->{height} * $self->getPixelsPerUnit;
|
||||
|
||||
$self->image->Draw(
|
||||
primitive => 'Path',
|
||||
stroke => $bar->{strokeColor},
|
||||
points =>
|
||||
" M ".$location->{x}.",".$location->{y}.
|
||||
" L ".$location->{x}.",".($location->{y}-$barHeight).
|
||||
" L ".($location->{x}+$barWidth).",".($location->{y}-$barHeight).
|
||||
" L ".($location->{x}+$barWidth).",".$location->{y},
|
||||
fill => $bar->{fillColor},
|
||||
);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub drawGraph {
|
||||
my ($currentBar, %location);
|
||||
my $self = shift;
|
||||
|
||||
$self->processDataSet;
|
||||
|
||||
my $numberOfGroups = List::Util::max(map {scalar @$_} @{$self->{_datasets}});
|
||||
my $numberOfDatasets = scalar @{$self->{_datasets}};
|
||||
my $groupWidth = ($self->getChartWidth - ($numberOfGroups-1) * $self->getGroupSpacing) / $numberOfGroups;
|
||||
|
||||
my $barWidth = $groupWidth;
|
||||
$barWidth = ($groupWidth - ($numberOfDatasets - 1) * $self->getBarSpacing) / $numberOfDatasets if ($self->getDrawMode eq 'sideBySide');
|
||||
|
||||
$location{x} = $self->getChartOffset->{x} ;
|
||||
$location{y} = $self->getChartOffset->{y} + $self->getChartHeight;
|
||||
foreach $currentBar (@{$self->{_bars}}) {
|
||||
if ($self->getDrawMode eq 'stacked') {
|
||||
$self->drawStackedBar($currentBar, \%location, $barWidth);
|
||||
} else {
|
||||
$self->drawSideBySideBar($currentBar, \%location, $barWidth);
|
||||
}
|
||||
|
||||
$location{x} += $groupWidth + $self->getGroupSpacing;
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub drawSideBySideBar {
|
||||
my $self = shift;
|
||||
my $bars = shift;
|
||||
my $location = shift;
|
||||
my $barWidth = shift;
|
||||
|
||||
my %thisLocation = %$location;
|
||||
|
||||
foreach (@$bars) {
|
||||
$self->drawBar($_, \%thisLocation, $barWidth);
|
||||
$thisLocation{x} += $barWidth + $self->getBarSpacing;
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub drawStackedBar {
|
||||
my $self = shift;
|
||||
my $bars = shift;
|
||||
my $location = shift;
|
||||
my $barWidth = shift;
|
||||
|
||||
my %thisLocation = %$location;
|
||||
foreach (@$bars) {
|
||||
$self->drawBar($_, \%thisLocation, $barWidth);
|
||||
$thisLocation{y} -= $_->{height} * $self->getPixelsPerUnit;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub formNamespace {
|
||||
my $self = shift;
|
||||
|
||||
return $self->SUPER::formNamespace.'_Bar';
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getAnchorSpacing {
|
||||
my $self = shift;
|
||||
|
||||
my $numberOfGroups = List::Util::max(map {scalar @$_} @{$self->getDataset});
|
||||
|
||||
my $spacing = ($self->getChartWidth - ($numberOfGroups-1) * $self->getGroupSpacing) / $numberOfGroups + $self->getGroupSpacing;
|
||||
|
||||
return {
|
||||
x => $spacing,
|
||||
y => 0,
|
||||
};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getBarSpacing {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_barProperties}->{barSpacing} || 0;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getConfiguration {
|
||||
my $self = shift;
|
||||
|
||||
my $config = $self->SUPER::getConfiguration;
|
||||
|
||||
$config->{xyGraph_bar_barSpacing} = $self->getBarSpacing;
|
||||
$config->{xyGraph_bar_groupSpacing} = $self->getGroupSpacing;
|
||||
|
||||
return $config;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getGroupSpacing {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_barProperties}->{groupSpacing} || $self->getBarSpacing;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getFirstAnchorLocation {
|
||||
my $self = shift;
|
||||
|
||||
return {
|
||||
x => $self->getChartOffset->{x} + ($self->getAnchorSpacing->{x} - $self->getGroupSpacing) / 2,
|
||||
y => $self->getChartOffset->{y} + $self->getChartHeight
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub processDataSet {
|
||||
my ($barProperties);
|
||||
my $self = shift;
|
||||
|
||||
my $palette = $self->getPalette;
|
||||
|
||||
my $maxElements = List::Util::max(map {scalar @$_} @{$self->{_datasets}});
|
||||
my $numberOfDatasets = scalar @{$self->{_datasets}};
|
||||
|
||||
for my $currentElement (0 .. $maxElements-1) {
|
||||
my @thisSet = ();
|
||||
for my $currentDataset (0 .. $numberOfDatasets - 1) {
|
||||
push(@thisSet, {
|
||||
height => $self->{_datasets}->[$currentDataset]->[$currentElement] || 0,
|
||||
fillColor => $palette->getColor($currentDataset)->getFillColor,
|
||||
strokeColor => $palette->getColor($currentDataset)->getStrokeColor,
|
||||
});
|
||||
}
|
||||
push(@{$self->{_bars}}, [ @thisSet ]);
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setBarSpacing {
|
||||
my $self = shift;
|
||||
my $gap = shift;
|
||||
|
||||
$self->{_barProperties}->{barSpacing} = $gap;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setConfiguration {
|
||||
my $self = shift;
|
||||
my $config = shift;
|
||||
|
||||
$self->SUPER::setConfiguration($config);
|
||||
|
||||
$self->setBarSpacing($config->{xyGraph_bar_barSpacing});
|
||||
$self->setGroupSpacing($config->{xyGraph_bar_groupSpacing});
|
||||
|
||||
return $config;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setGroupSpacing {
|
||||
my $self = shift;
|
||||
my $gap = shift;
|
||||
|
||||
$self->{_barProperties}->{groupSpacing} = $gap;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
107
lib/WebGUI/Image/Graph/XYGraph/Line.pm
Normal file
107
lib/WebGUI/Image/Graph/XYGraph/Line.pm
Normal file
|
|
@ -0,0 +1,107 @@
|
|||
package WebGUI::Image::Graph::XYGraph::Line;
|
||||
|
||||
use strict;
|
||||
use WebGUI::Image::Graph::XYGraph;
|
||||
use List::Util;
|
||||
use POSIX;
|
||||
use Data::Dumper;
|
||||
|
||||
our @ISA = qw(WebGUI::Image::Graph::XYGraph);
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub drawGraph {
|
||||
my ($currentBar, %location);
|
||||
my $self = shift;
|
||||
|
||||
$self->processDataSet;
|
||||
|
||||
my $numberOfGroups = List::Util::max(map {scalar @$_} @{$self->{_datasets}});
|
||||
my $interval = $self->getChartWidth / ($numberOfGroups - 1);
|
||||
|
||||
%location = %{$self->getChartOffset};
|
||||
$location{y} += $self->getChartHeight;
|
||||
|
||||
foreach (@{$self->{_lines}}) {
|
||||
$self->drawLine($_, \%location, $interval);
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub drawLine {
|
||||
my $self = shift;
|
||||
my $line = shift;
|
||||
my $location = shift;
|
||||
my $interval = shift;
|
||||
|
||||
my %currentLocation = %$location;
|
||||
|
||||
|
||||
my $dataCounter;
|
||||
my $path;# = " M ".$currentLocation{x}.",".$currentLocation{y};
|
||||
foreach (@{$line->{dataset}}) {
|
||||
$path .= ($dataCounter++) ? " L " : " M ";
|
||||
$path .= $currentLocation{x}.",".($currentLocation{y} - $_*$self->getPixelsPerUnit);
|
||||
|
||||
$currentLocation{x} += $interval;
|
||||
}
|
||||
|
||||
$self->image->Draw(
|
||||
primitive => 'Path',
|
||||
stroke => $line->{strokeColor},
|
||||
points => $path,
|
||||
fill => 'none',
|
||||
);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub formNamespace {
|
||||
my $self = shift;
|
||||
|
||||
return $self->SUPER::formNamespace.'_Line';
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getAnchorSpacing {
|
||||
my $self = shift;
|
||||
|
||||
my $numberOfGroups = List::Util::max(map {scalar @$_} @{$self->getDataset});
|
||||
|
||||
my $spacing = $self->getChartWidth / ($numberOfGroups - 1);
|
||||
|
||||
return {
|
||||
x => $spacing,
|
||||
y => 0,
|
||||
};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getFirstAnchorLocation {
|
||||
my $self = shift;
|
||||
|
||||
return {
|
||||
x => $self->getChartOffset->{x},
|
||||
y => $self->getChartOffset->{y} + $self->getChartHeight
|
||||
}
|
||||
}
|
||||
|
||||
# palette nog laten werken!
|
||||
#-------------------------------------------------------------------
|
||||
sub processDataSet {
|
||||
my ($barProperties);
|
||||
my $self = shift;
|
||||
|
||||
# my $maxElements = List::Util::max(map {scalar @$_} @{$self->{_datasets}});
|
||||
# my $numberOfDatasets = scalar @{$self->{_datasets}};
|
||||
|
||||
my $palette = $self->getPalette;
|
||||
foreach (@{$self->{_datasets}}) {
|
||||
push (@{$self->{_lines}}, {
|
||||
dataset => $_,
|
||||
strokeColor => $palette->getColor->getStrokeColor,
|
||||
});
|
||||
$palette->getNextColor;
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
220
lib/WebGUI/Image/Palette.pm
Normal file
220
lib/WebGUI/Image/Palette.pm
Normal file
|
|
@ -0,0 +1,220 @@
|
|||
package WebGUI::Image::Palette;
|
||||
|
||||
use strict;
|
||||
use WebGUI::Image::Color;
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub addColor {
|
||||
my $self = shift;
|
||||
my $color = shift;
|
||||
|
||||
$color->save;
|
||||
|
||||
$self->session->db->write('insert into imagePaletteColors (paletteId, colorId, paletteOrder) values (?,?,?)', [
|
||||
$self->getId,
|
||||
$color->getId,
|
||||
$self->getNumberOfColors + 1
|
||||
]);
|
||||
|
||||
push (@{$self->{_palette}}, $color);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub canDelete {
|
||||
my $self = shift;
|
||||
|
||||
return 0 if ($self->getId =~ /^default/);
|
||||
return 1;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub canEdit {
|
||||
my $self = shift;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub delete {
|
||||
my $self = shift;
|
||||
|
||||
if ($self->canDelete) {
|
||||
$self->session->db->write('delete from imagePaletteColors where paletteId=?', [
|
||||
$self->getId,
|
||||
]);
|
||||
$self->session->db->write('delete from imagePalette where paletteId=?', [
|
||||
$self->getId,
|
||||
]);
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getColor {
|
||||
my $self = shift;
|
||||
my $index = shift || $self->getPaletteIndex;
|
||||
|
||||
return $self->{_palette}->[$index];
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getColorsInPalette {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_palette};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getDefaultPaletteId {
|
||||
my $self = shift;
|
||||
|
||||
return 'defaultPalette';
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getId {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_properties}->{paletteId};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getName {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_properties}->{name};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getNextColor {
|
||||
my $self = shift;
|
||||
|
||||
my $index = $self->getPaletteIndex + 1;
|
||||
$index = 0 if ($index >= $self->getNumberOfColors);
|
||||
|
||||
$self->setPaletteIndex($index);
|
||||
return $self->getColor;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getNumberOfColors {
|
||||
my $self = shift;
|
||||
|
||||
return scalar(@{$self->{_palette}});
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getPaletteIndex {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_paletteIndex};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getPaletteList {
|
||||
my $self = shift;
|
||||
my $session = shift || $self->session;
|
||||
|
||||
return $session->db->buildHashRef('select paletteId, name from imagePalette');
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getPreviousColor {
|
||||
my $self = shift;
|
||||
|
||||
my $index = $self->{_paletteIndex} - 1;
|
||||
$index = $self->getNumberOfColors - 1 if ($index < 0);
|
||||
|
||||
$self->setPaletteIndex($index);
|
||||
return $self->getColor($index);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub new {
|
||||
my ($properties, $colors);
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
my $paletteId = shift;
|
||||
my $name = shift || 'untitled';
|
||||
|
||||
if ($paletteId eq 'new') {
|
||||
$paletteId = $session->id->generate;
|
||||
$session->db->write('insert into imagePalette (paletteId, name) values (?,?)', [
|
||||
$paletteId,
|
||||
$name
|
||||
]);
|
||||
$properties = {
|
||||
paletteId => $paletteId,
|
||||
name => 'paletteName',
|
||||
};
|
||||
$colors = [];
|
||||
} else {
|
||||
$properties = $session->db->quickHashRef('select * from imagePalette where paletteId = ?', [
|
||||
$paletteId,
|
||||
]);
|
||||
|
||||
unless ($properties->{paletteId}) {
|
||||
$properties = $session->db->quickHashRef('select * from imagePalette where paletteId = ?', [
|
||||
'defaultPalette' #$self->getDefaultPaletteId
|
||||
]);
|
||||
$paletteId = 'defaultPalette';
|
||||
}
|
||||
|
||||
$colors = WebGUI::Image::Color->newByPalette($session, $paletteId);
|
||||
}
|
||||
|
||||
bless {_paletteIndex => 0, _palette => $colors, _properties => $properties, _session => $session}, $class;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub removeColor {
|
||||
my $self = shift;
|
||||
my $color = shift;
|
||||
|
||||
my $newColors = shift;
|
||||
|
||||
foreach (@{$self->{_palette}}) {
|
||||
push(@$newColors, $_) unless ($_->getId eq $color->getId);
|
||||
}
|
||||
$self->{_palette} = $newColors;
|
||||
|
||||
$self->session->db->write('delete from imagePaletteColors where paletteId=? and colorId=?', [
|
||||
$self->getId,
|
||||
$color->getId,
|
||||
]);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub session {
|
||||
my $self = shift;
|
||||
|
||||
return $self->{_session};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setName {
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
|
||||
$self->session->db->write('update imagePalette set name=? where paletteId=?', [
|
||||
$name,
|
||||
$self->getId,
|
||||
]);
|
||||
|
||||
$self->{_properties}->{name} = $name;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub setPaletteIndex {
|
||||
my $self = shift;
|
||||
my $index = shift;
|
||||
|
||||
$self->{_paletteIndex} = $index;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub swapColors {
|
||||
#### Implementeren!
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
|
@ -284,6 +284,21 @@ sub getOperations {
|
|||
'promoteWorkflowActivity' => 'WebGUI::Operation::Workflow',
|
||||
'runWorkflow' => 'WebGUI::Operation::Workflow',
|
||||
'showRunningWorkflows' => 'WebGUI::Operation::Workflow',
|
||||
|
||||
'addColorToPalette' => 'WebGUI::Operation::Graphics',
|
||||
'addColorToPaletteSave' => 'WebGUI::Operation::Graphics',
|
||||
'deleteFont' => 'WebGUI::Operation::Graphics',
|
||||
'deletePalette' => 'WebGUI::Operation::Graphics',
|
||||
'editColor' => 'WebGUI::Operation::Graphics',
|
||||
'editColorSave' => 'WebGUI::Operation::Graphics',
|
||||
'editFont' => 'WebGUI::Operation::Graphics',
|
||||
'editFontSave' => 'WebGUI::Operation::Graphics',
|
||||
'editPalette' => 'WebGUI::Operation::Graphics',
|
||||
'editPaletteSave' => 'WebGUI::Operation::Graphics',
|
||||
'listGraphicsOptions' => 'WebGUI::Operation::Graphics',
|
||||
'listFonts' => 'WebGUI::Operation::Graphics',
|
||||
'listPalettes' => 'WebGUI::Operation::Graphics',
|
||||
'removeColorFromPalette' => 'WebGUI::Operation::Graphics',
|
||||
};
|
||||
}
|
||||
|
||||
|
|
|
|||
407
lib/WebGUI/Operation/Graphics.pm
Normal file
407
lib/WebGUI/Operation/Graphics.pm
Normal file
|
|
@ -0,0 +1,407 @@
|
|||
package WebGUI::Operation::Graphics;
|
||||
|
||||
use strict;
|
||||
use WebGUI::Image::Palette;
|
||||
use WebGUI::Image::Color;
|
||||
use WebGUI::Image::Font;
|
||||
use WebGUI::Storage;
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub _submenu {
|
||||
my $session = shift;
|
||||
my $i18n = WebGUI::International->new($session, "Graphics");
|
||||
|
||||
my $workarea = shift;
|
||||
my $title = shift;
|
||||
$title = $i18n->get($title) if ($title);
|
||||
my $help = shift;
|
||||
my $ac = WebGUI::AdminConsole->new($session,"graphics");
|
||||
if ($help) {
|
||||
$ac->setHelp($help, 'Commerce');
|
||||
}
|
||||
$ac->addSubmenuItem($session->url->page('op=listPalettes'), $i18n->get('manage palettes'));
|
||||
$ac->addSubmenuItem($session->url->page('op=listFonts'), $i18n->get('manage fonts'));
|
||||
$ac->addSubmenuItem($session->url->page('op=editPalette&pid=new'), $i18n->get('add palette'));
|
||||
$ac->addSubmenuItem($session->url->page('op=editFont&fid=new'), $i18n->get('add font'));
|
||||
|
||||
return $ac->render($workarea, $i18n->get('manage graphics'));
|
||||
}
|
||||
|
||||
#### hoverhelp
|
||||
#-------------------------------------------------------------------
|
||||
sub _getColorForm {
|
||||
my ($f, $color);
|
||||
my $session = shift;
|
||||
my $colorId = shift;
|
||||
|
||||
my $i18n = WebGUI::International->new($session, "Graphics");
|
||||
|
||||
$color = WebGUI::Image::Color->new($session, $colorId);
|
||||
|
||||
my $f = WebGUI::HTMLForm->new($session);
|
||||
$f->text(
|
||||
-name => 'colorName',
|
||||
-value => $color->getName,
|
||||
-label => $i18n->get('color name'),
|
||||
);
|
||||
$f->color(
|
||||
-name => 'fillTriplet',
|
||||
-value => $color->getFillTriplet,
|
||||
-label => $i18n->get('fill color'),
|
||||
-maxlength => 7,
|
||||
-size => 7,
|
||||
);
|
||||
$f->text(
|
||||
-name => 'fillAlpha',
|
||||
-value => $color->getFillAlpha,
|
||||
-label => $i18n->get('fill alpha'),
|
||||
-maxlength => 2,
|
||||
-size => 2,
|
||||
);
|
||||
$f->color(
|
||||
-name => 'strokeTriplet',
|
||||
-value => $color->getStrokeTriplet,
|
||||
-label => $i18n->get('stroke color'),
|
||||
-maxlength => 7,
|
||||
-size => 7,
|
||||
);
|
||||
$f->text(
|
||||
-name => 'strokeAlpha',
|
||||
-value => $color->getStrokeAlpha,
|
||||
-label => $i18n->get('stroke alpha'),
|
||||
-maxlength => 2,
|
||||
-size => 2,
|
||||
);
|
||||
|
||||
return $f->printRowsOnly;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_addColorToPalette {
|
||||
my ($f);
|
||||
my $session = shift;
|
||||
|
||||
return $session->privilege->adminOnly() unless ($session->user->isInGroup(3));
|
||||
|
||||
$f = WebGUI::HTMLForm->new($session);
|
||||
$f->hidden(
|
||||
-name => 'op',
|
||||
-value => 'addColorToPaletteSave',
|
||||
);
|
||||
$f->hidden(
|
||||
-name => 'pid',
|
||||
-value => $session->form->process('pid'),
|
||||
);
|
||||
$f->hidden(
|
||||
-name => 'cid',
|
||||
-value => $session->form->process('cid'),
|
||||
);
|
||||
$f->raw(_getColorForm($session, $session->form->process('cid')));
|
||||
$f->submit;
|
||||
|
||||
return _submenu($session, $f->print);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_addColorToPaletteSave {
|
||||
my $session = shift;
|
||||
|
||||
return $session->privilege->adminOnly() unless ($session->user->isInGroup(3));
|
||||
|
||||
my $color = WebGUI::Image::Color->new($session, $session->form->process('cid'));
|
||||
if ($session->form->process('cid') eq 'new') {
|
||||
$color->setFillTriplet($session->form->process('fillTriplet'));
|
||||
$color->setFillAlpha($session->form->process('fillAlpha'));
|
||||
$color->setStrokeTriplet($session->form->process('strokeTriplet'));
|
||||
$color->setStrokeAlpha($session->form->process('strokeAlpha'));
|
||||
}
|
||||
my $palette = WebGUI::Image::Palette->new($session, $session->form->process('pid'));
|
||||
|
||||
$palette->addColor($color);
|
||||
|
||||
return www_editPalette($session, $palette->getId);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_deleteFont {
|
||||
my $session = shift;
|
||||
|
||||
return $session->privilege->adminOnly() unless ($session->user->isInGroup(3));
|
||||
|
||||
my $font = WebGUI::Image::Font->new($session, $session->form->process('fid'));
|
||||
$font->delete;
|
||||
|
||||
return www_listFonts($session);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_deletePalette {
|
||||
my $session = shift;
|
||||
|
||||
return $session->privilege->adminOnly() unless ($session->user->isInGroup(3));
|
||||
|
||||
my $palette = WebGUI::Image::Palette->new($session, $session->form->process('pid'));
|
||||
$palette->delete;
|
||||
|
||||
return www_listPalettes($session);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_editColor {
|
||||
my ($f);
|
||||
my $session = shift;
|
||||
|
||||
return $session->privilege->adminOnly() unless ($session->user->isInGroup(3));
|
||||
|
||||
my $colorId = $session->form->process('cid');
|
||||
return www_listPalettes($session) if ($colorId eq 'new');
|
||||
|
||||
$f = WebGUI::HTMLForm->new($session);
|
||||
$f->hidden(
|
||||
-name => 'op',
|
||||
-value => 'editColorSave',
|
||||
);
|
||||
$f->hidden(
|
||||
-name => 'pid',
|
||||
-value => $session->form->process('pid'),
|
||||
);
|
||||
$f->hidden(
|
||||
-name => 'cid',
|
||||
-value => $colorId,
|
||||
);
|
||||
$f->raw(_getColorForm($session, $colorId));
|
||||
$f->submit;
|
||||
|
||||
return _submenu($session, $f->print);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_editColorSave {
|
||||
my $session = shift;
|
||||
|
||||
return $session->privilege->adminOnly() unless ($session->user->isInGroup(3));
|
||||
|
||||
my $colorId = $session->form->process('cid');
|
||||
return www_listPalettes($session) if ($colorId eq 'new');
|
||||
|
||||
my $color = WebGUI::Image::Color->new($session, $colorId);
|
||||
|
||||
$color->setName($session->form->process('colorName'));
|
||||
$color->setFillTriplet($session->form->process('fillTriplet'));
|
||||
$color->setFillAlpha($session->form->process('fillAlpha'));
|
||||
$color->setStrokeTriplet($session->form->process('strokeTriplet'));
|
||||
$color->setStrokeAlpha($session->form->process('strokeAlpha'));
|
||||
|
||||
return www_editPalette($session, $session->form->process('pid'));
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_editFont {
|
||||
my ($f, $fontName);
|
||||
my $session = shift;
|
||||
|
||||
return $session->privilege->adminOnly() unless ($session->user->isInGroup(3));
|
||||
|
||||
my $i18n = WebGUI::International->new($session, "Graphics");
|
||||
|
||||
unless ($session->form->process('fid') eq 'new') {
|
||||
my $font = WebGUI::Image::Font->new($session, $session->form->process('fid'));
|
||||
$fontName = $font->getName;
|
||||
}
|
||||
|
||||
$f = WebGUI::HTMLForm->new($session);
|
||||
$f->hidden(
|
||||
-name => 'op',
|
||||
-value => 'editFontSave',
|
||||
);
|
||||
$f->hidden(
|
||||
-name => 'fid',
|
||||
-value => $session->form->process('fid'),
|
||||
);
|
||||
$f->text(
|
||||
-name => 'fontName',
|
||||
-value => $fontName,
|
||||
-label => $i18n->get('font name'),
|
||||
);
|
||||
$f->file(
|
||||
-name => 'fontFile',
|
||||
-label => $i18n->get('font file'),
|
||||
);
|
||||
$f->submit;
|
||||
|
||||
return _submenu($session, $f->print);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_editFontSave {
|
||||
my $session = shift;
|
||||
|
||||
return $session->privilege->adminOnly() unless ($session->user->isInGroup(3));
|
||||
|
||||
if ($session->form->process('fid') eq 'new') {
|
||||
my $storage = WebGUI::Storage->create($session, 'new');
|
||||
my $filename = $storage->addFileFromFormPost('fontFile');
|
||||
if ($filename) {
|
||||
my $font = WebGUI::Image::Font->new($session, 'new');
|
||||
$font->setName($session->form->process('fontName'));
|
||||
$font->setStorageId($storage->getId);
|
||||
$font->setFilename($filename);
|
||||
}
|
||||
}
|
||||
|
||||
return www_listFonts($session);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_editPalette {
|
||||
my ($name, $palette, $output, $color);
|
||||
my $session = shift;
|
||||
my $paletteId = shift || $session->form->process('pid');
|
||||
|
||||
return $session->privilege->adminOnly() unless ($session->user->isInGroup(3));
|
||||
|
||||
my $i18n = WebGUI::International->new($session, 'Graphics');
|
||||
|
||||
unless ($paletteId eq 'new') {
|
||||
$palette = WebGUI::Image::Palette->new($session, $paletteId);
|
||||
$name = $palette->getName;
|
||||
};
|
||||
|
||||
my $f = WebGUI::HTMLForm->new($session);
|
||||
$f->hidden(
|
||||
-name => 'op',
|
||||
-value => 'editPaletteSave',
|
||||
);
|
||||
$f->hidden(
|
||||
-name => 'pid',
|
||||
-value => $paletteId,
|
||||
);
|
||||
$f->text(
|
||||
-name => 'paletteName',
|
||||
-value => $name,
|
||||
-label => $i18n->get('palette name'),
|
||||
);
|
||||
$f->submit;
|
||||
$output = $f->print;
|
||||
unless ($paletteId eq 'new') {
|
||||
my $palette = WebGUI::Image::Palette->new($session, $paletteId);
|
||||
|
||||
$output .= '<table>';
|
||||
$output .= '<th><td>'.$i18n->get('fill color').'</td><td>'.$i18n->get('stroke color').'</td></th>';
|
||||
foreach $color (@{$palette->getColorsInPalette}) {
|
||||
$output .= '<tr>';
|
||||
$output .= '<td>';
|
||||
$output .= $session->icon->delete('op=removeColorFromPalette&pid='.$palette->getId.'&cid='.$color->getId);
|
||||
$output .= $session->icon->edit('op=editColor&pid='.$palette->getId.'&cid='.$color->getId);
|
||||
$output .= '</td>';
|
||||
$output .= '<td width="30" border="1" height="30" bgcolor="'.$color->getFillTriplet.'"></td>';
|
||||
$output .= '<td width="30" border="1" height="30" bgcolor="'.$color->getStrokeTriplet.'"></td>';
|
||||
$output .= '</tr>';
|
||||
}
|
||||
$output .= '</table>';
|
||||
|
||||
$output .= '<a href="'.$session->url->page('op=addColorToPalette&cid=new&pid='.$palette->getId).'">'.$i18n->get('add color').'</a><br>';
|
||||
}
|
||||
|
||||
return _submenu($session, $output);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_editPaletteSave {
|
||||
my $session = shift;
|
||||
|
||||
return $session->privilege->adminOnly() unless ($session->user->isInGroup(3));
|
||||
|
||||
my $palette = WebGUI::Image::Palette->new($session, $session->form->process('pid'));
|
||||
$palette->setName($session->form->process('paletteName'));
|
||||
|
||||
return www_editPalette($session, $palette->getId);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_listGraphicsOptions {
|
||||
my ($output);
|
||||
my $session = shift;
|
||||
|
||||
return $session->privilege->adminOnly() unless ($session->user->isInGroup(3));
|
||||
|
||||
my $i18n = WebGUI::International->new($session, 'Graphics');
|
||||
|
||||
$output .= '<a href="'.$session->url->page('op=listPalettes').'">'.$i18n->get('manage palettes').'</a><br />';
|
||||
$output .= '<a href="'.$session->url->page('op=listFonts').'">'.$i18n->get('manage fonts').'</a><br />';
|
||||
|
||||
return _submenu($session, $output);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_listPalettes {
|
||||
my ($output);
|
||||
my $session = shift;
|
||||
|
||||
return $session->privilege->adminOnly() unless ($session->user->isInGroup(3));
|
||||
|
||||
my $i18n = WebGUI::International->new($session, 'Graphics');
|
||||
|
||||
my $palettes = WebGUI::Image::Palette->getPaletteList($session);
|
||||
|
||||
$output .= '<table>';
|
||||
$output .= '<th><td>'.$i18n->get('palette name').'</td></th>';
|
||||
foreach (keys %$palettes) {
|
||||
$output .= '<tr>';
|
||||
$output .= '<td>';
|
||||
$output .= $session->icon->delete('op=deletePalette&pid='.$_);
|
||||
$output .= $session->icon->edit('op=editPalette&pid='.$_);
|
||||
$output .= '</td>';
|
||||
$output .= '<td>'.$palettes->{$_}.'</td>';
|
||||
$output .= '</tr>';
|
||||
}
|
||||
$output .= '</table>';
|
||||
|
||||
$output .= '<a href="'.$session->url->page('op=editPalette&pid=new').'">'.$i18n->get('add color').'</a><br>';
|
||||
|
||||
return _submenu($session, $output);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_listFonts {
|
||||
my ($output);
|
||||
my $session = shift;
|
||||
|
||||
return $session->privilege->adminOnly() unless ($session->user->isInGroup(3));
|
||||
|
||||
my $i18n = WebGUI::International->new($session, 'Graphics');
|
||||
|
||||
my %fonts = $session->db->buildHash('select fontId, name from imageFont');
|
||||
|
||||
$output .= '<table>';
|
||||
$output .= '<th><td></td><td>'.$i18n->get('font name').'</td></th>';
|
||||
foreach (keys %fonts) {
|
||||
$output .= '<tr>';
|
||||
$output .= '<td>';
|
||||
$output .= $session->icon->delete('op=deleteFont&fid='.$_);
|
||||
# $output .= $session->icon->edit('op=editFont&fid='.$_);
|
||||
$output .= '</td>';
|
||||
$output .= '<td>'.$fonts{$_}.'</td>';
|
||||
$output .= '</tr>';
|
||||
}
|
||||
$output .= '</table>';
|
||||
|
||||
$output .= '<a href="'.$session->url->page('op=editFont&fid=new').'">'.$i18n->get('add font').'</a><br>';
|
||||
|
||||
return _submenu($session, $output);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_removeColorFromPalette {
|
||||
my $session = shift;
|
||||
|
||||
return $session->privilege->adminOnly() unless ($session->user->isInGroup(3));
|
||||
|
||||
my $palette = WebGUI::Image::Palette->new($session, $session->form->process('pid'));
|
||||
$palette->removeColor(WebGUI::Image::Color->new($session, $session->form->process('cid')));
|
||||
|
||||
return www_editPalette($session, $session->form->process('pid'));
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
|
@ -65,9 +65,9 @@ sub addFileFromCaptcha {
|
|||
my $image = Image::Magick->new();
|
||||
$image->Set(size=>'105x26');
|
||||
$image->ReadImage('xc:white');
|
||||
$image->AddNoise(noise=>"Multiplicative");
|
||||
# $image->AddNoise(noise=>"Multiplicative");
|
||||
$image->Annotate(font=>$self->session->config->getWebguiRoot."/lib/default.ttf", pointsize=>30, skewY=>0, skewX=>0, gravity=>'center', fill=>'white', antialias=>'true', text=>$challenge);
|
||||
$image->Blur(geometry=>"1");
|
||||
# $image->Blur(geometry=>"1");
|
||||
$image->Set(type=>"Grayscale");
|
||||
$image->Border(fill=>'black', width=>1, height=>1);
|
||||
$image->Write($self->getPath($filename));
|
||||
|
|
|
|||
|
|
@ -198,6 +198,16 @@ width is 150 pixels.|,
|
|||
lastUpdated => 1031514049
|
||||
},
|
||||
|
||||
'generate graph' => {
|
||||
message => q|Generate image graph|,
|
||||
lastUpdated => 1031514049,
|
||||
},
|
||||
|
||||
'generate graph description' => {
|
||||
message => q|Set this switch to 'on' to enable generation of
|
||||
an image graph.|,
|
||||
lastUpdated => 1031514049,
|
||||
},
|
||||
};
|
||||
|
||||
1;
|
||||
|
|
|
|||
62
lib/WebGUI/i18n/English/Graphics.pm
Normal file
62
lib/WebGUI/i18n/English/Graphics.pm
Normal file
|
|
@ -0,0 +1,62 @@
|
|||
package WebGUI::i18n::English::Graphics;
|
||||
|
||||
our $I18N = {
|
||||
'manage graphics' => {
|
||||
message => q|Graphics|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'manage palettes' => {
|
||||
message => q|Manage palettes|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'manage fonts' => {
|
||||
message => q|Manage fonts|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'add palette' => {
|
||||
message => q|Add a new palette|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'add font' => {
|
||||
message => q|Add a new font|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'color name' => {
|
||||
message => q|Color name|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'fill color' => {
|
||||
message => q|Fill color|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'fill alpha' => {
|
||||
message => q|Fill transparency|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'stroke color' => {
|
||||
message => q|Stroke color|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'stroke alpha' => {
|
||||
message => q|Stroke transparency|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'font name' => {
|
||||
message => q|Font name|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'font file' => {
|
||||
message => q|Font file|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'palette name' => {
|
||||
message => q|Palette name|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'add color' => {
|
||||
message => q|Add a color to this palette.|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
};
|
||||
|
||||
1;
|
||||
42
lib/WebGUI/i18n/English/Image_Graph.pm
Normal file
42
lib/WebGUI/i18n/English/Image_Graph.pm
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
package WebGUI::i18n::English::Image_Graph;
|
||||
|
||||
our $I18N = {
|
||||
'image width' => {
|
||||
message => q|Image width|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'image height' => {
|
||||
message => q|Image height|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'background color' => {
|
||||
message => q|Background color|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'palette' => {
|
||||
message => q|Palette|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'label offset' => {
|
||||
message => q|Label offset|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'label font' => {
|
||||
message => q|Font|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'label color' => {
|
||||
message => q|Label color|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'label fontsize' => {
|
||||
message => q|Font size|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'graph type' => {
|
||||
message => q|Graph type|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
};
|
||||
|
||||
1;
|
||||
66
lib/WebGUI/i18n/English/Image_Graph_Pie.pm
Normal file
66
lib/WebGUI/i18n/English/Image_Graph_Pie.pm
Normal file
|
|
@ -0,0 +1,66 @@
|
|||
package WebGUI::i18n::English::Image_Graph_Pie;
|
||||
|
||||
our $I18N = {
|
||||
'radius' => {
|
||||
message => q|Radius|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'pie height' => {
|
||||
message => q|Pie height|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'tilt angle' => {
|
||||
message => q|Tilt angle (0 degrees for 2d pies|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'start angle' => {
|
||||
message => q|Start angle|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'shade sides' => {
|
||||
message => q|Shade sides?|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'stick length' => {
|
||||
message => q|Stick length (0 to disable sticks)|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'stick offset' => {
|
||||
message => q|Stick offset|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'stick color' => {
|
||||
message => q|Stick color|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'label position' => {
|
||||
message => q|Label position|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'top' => {
|
||||
message => q|Top|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'bottom' => {
|
||||
message => q|Bottom|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'center' => {
|
||||
message => q|Center|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'pie mode' => {
|
||||
message => q|Pie mode|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'normal' => {
|
||||
message => q|Normal|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'stepped' => {
|
||||
message => q|Stepped|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
};
|
||||
|
||||
1;
|
||||
43
lib/WebGUI/i18n/English/Image_Graph_XYGraph.pm
Normal file
43
lib/WebGUI/i18n/English/Image_Graph_XYGraph.pm
Normal file
|
|
@ -0,0 +1,43 @@
|
|||
package WebGUI::i18n::English::Image_Graph_XYGraph;
|
||||
|
||||
our $I18N = {
|
||||
'chart width' => {
|
||||
message => q|Chart width|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'chart height' => {
|
||||
message => q|Chart height|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'draw labels' => {
|
||||
message => q|Draw labels|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'draw axis' => {
|
||||
message => q|Draw axis|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'draw rulers' => {
|
||||
message => q|Draw rulers|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'draw mode' => {
|
||||
message => q|Draw mode|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'y granularity' => {
|
||||
message => q|Vertical step size|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'axis color' => {
|
||||
message => q|Axis color|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'ruler color' => {
|
||||
message => q|Ruler color|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
|
||||
};
|
||||
|
||||
1;
|
||||
15
lib/WebGUI/i18n/English/Image_Graph_XYGraph_Bar.pm
Normal file
15
lib/WebGUI/i18n/English/Image_Graph_XYGraph_Bar.pm
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
package WebGUI::i18n::English::Image_Graph_XYGraph_Bar;
|
||||
|
||||
our $I18N = {
|
||||
'bar spacing' => {
|
||||
message => q|Bar spacing|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
'group spacing' => {
|
||||
message => q|Group spacing|,
|
||||
lastUpdated => 1131394070,
|
||||
},
|
||||
};
|
||||
|
||||
1;
|
||||
|
||||
|
|
@ -89,6 +89,9 @@ checkModule("POE::Component::Client::UserAgent", 0.06);
|
|||
checkModule("Data::Structure::Util",0.11);
|
||||
checkModule("Apache2::Request",2.06);
|
||||
checkModule("Cache::Memcached",1.15,2);
|
||||
checkModule("POSIX");
|
||||
checkModule("List::Util");
|
||||
checkModule("Color::Calc");
|
||||
|
||||
###################################
|
||||
# Checking WebGUI
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue