From 27af7de00ca8506a67633b3b78e16b6c05ffcdac Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Sun, 30 Apr 2006 22:40:23 +0000 Subject: [PATCH] Adding the graphing engine. --- docs/changelog/6.x.x.txt | 1 + docs/gotcha.txt | 3 + .../wgtemplate_default_poll.tmpl | 24 +- docs/upgrades/upgrade_6.8.8-6.99.0.pl | 76 ++ lib/WebGUI/AdminConsole.pm | 9 + lib/WebGUI/Asset/Wobject/Poll.pm | 58 +- lib/WebGUI/Image.pm | 208 ++++ lib/WebGUI/Image/Color.pm | 272 +++++ lib/WebGUI/Image/Font.pm | 151 +++ lib/WebGUI/Image/Graph.pm | 450 ++++++++ lib/WebGUI/Image/Graph/Pie.pm | 981 ++++++++++++++++++ lib/WebGUI/Image/Graph/XYGraph.pm | 394 +++++++ lib/WebGUI/Image/Graph/XYGraph/Bar.pm | 224 ++++ lib/WebGUI/Image/Graph/XYGraph/Line.pm | 107 ++ lib/WebGUI/Image/Palette.pm | 220 ++++ lib/WebGUI/Operation.pm | 15 + lib/WebGUI/Operation/Graphics.pm | 407 ++++++++ lib/WebGUI/Storage/Image.pm | 4 +- lib/WebGUI/i18n/English/Asset_Poll.pm | 10 + lib/WebGUI/i18n/English/Graphics.pm | 62 ++ lib/WebGUI/i18n/English/Image_Graph.pm | 42 + lib/WebGUI/i18n/English/Image_Graph_Pie.pm | 66 ++ .../i18n/English/Image_Graph_XYGraph.pm | 43 + .../i18n/English/Image_Graph_XYGraph_Bar.pm | 15 + sbin/testEnvironment.pl | 3 + 25 files changed, 3830 insertions(+), 15 deletions(-) create mode 100644 lib/WebGUI/Image.pm create mode 100644 lib/WebGUI/Image/Color.pm create mode 100644 lib/WebGUI/Image/Font.pm create mode 100644 lib/WebGUI/Image/Graph.pm create mode 100644 lib/WebGUI/Image/Graph/Pie.pm create mode 100644 lib/WebGUI/Image/Graph/XYGraph.pm create mode 100644 lib/WebGUI/Image/Graph/XYGraph/Bar.pm create mode 100644 lib/WebGUI/Image/Graph/XYGraph/Line.pm create mode 100644 lib/WebGUI/Image/Palette.pm create mode 100644 lib/WebGUI/Operation/Graphics.pm create mode 100644 lib/WebGUI/i18n/English/Graphics.pm create mode 100644 lib/WebGUI/i18n/English/Image_Graph.pm create mode 100644 lib/WebGUI/i18n/English/Image_Graph_Pie.pm create mode 100644 lib/WebGUI/i18n/English/Image_Graph_XYGraph.pm create mode 100644 lib/WebGUI/i18n/English/Image_Graph_XYGraph_Bar.pm diff --git a/docs/changelog/6.x.x.txt b/docs/changelog/6.x.x.txt index e3ec3d9b2..20006ff6b 100644 --- a/docs/changelog/6.x.x.txt +++ b/docs/changelog/6.x.x.txt @@ -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) diff --git a/docs/gotcha.txt b/docs/gotcha.txt index 53d05bfc7..b28990986 100644 --- a/docs/gotcha.txt +++ b/docs/gotcha.txt @@ -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. diff --git a/docs/upgrades/templates-6.99.0/wgtemplate_default_poll.tmpl b/docs/upgrades/templates-6.99.0/wgtemplate_default_poll.tmpl index b6b65adfc..db05e6eec 100644 --- a/docs/upgrades/templates-6.99.0/wgtemplate_default_poll.tmpl +++ b/docs/upgrades/templates-6.99.0/wgtemplate_default_poll.tmpl @@ -27,16 +27,20 @@ - -
- - - - - -
^Spacer(1,1);  % ()
- -
: + + + + +
+ + + + + +
^Spacer(1,1);  % ()
+ +
: + diff --git a/docs/upgrades/upgrade_6.8.8-6.99.0.pl b/docs/upgrades/upgrade_6.8.8-6.99.0.pl index 84a483d13..d181d524b 100644 --- a/docs/upgrades/upgrade_6.8.8-6.99.0.pl +++ b/docs/upgrades/upgrade_6.8.8-6.99.0.pl @@ -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(<db->write(<db->write(<db->write(<db->write(q|INSERT INTO `imagePalette` VALUES ('defaultPalette','Default palette')|); + + $session->db->write(<db->write(<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 ---- diff --git a/lib/WebGUI/AdminConsole.pm b/lib/WebGUI/AdminConsole.pm index 2893bba11..99bdb124e 100644 --- a/lib/WebGUI/AdminConsole.pm +++ b/lib/WebGUI/AdminConsole.pm @@ -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}); diff --git a/lib/WebGUI/Asset/Wobject/Poll.pm b/lib/WebGUI/Asset/Wobject/Poll.pm index 795124464..f33d96f64 100644 --- a/lib/WebGUI/Asset/Wobject/Poll.pm +++ b/lib/WebGUI/Asset/Wobject/Poll.pm @@ -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}); } diff --git a/lib/WebGUI/Image.pm b/lib/WebGUI/Image.pm new file mode 100644 index 000000000..9ed1f7241 --- /dev/null +++ b/lib/WebGUI/Image.pm @@ -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; + diff --git a/lib/WebGUI/Image/Color.pm b/lib/WebGUI/Image/Color.pm new file mode 100644 index 000000000..380b9fd9c --- /dev/null +++ b/lib/WebGUI/Image/Color.pm @@ -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; + diff --git a/lib/WebGUI/Image/Font.pm b/lib/WebGUI/Image/Font.pm new file mode 100644 index 000000000..4e252c53b --- /dev/null +++ b/lib/WebGUI/Image/Font.pm @@ -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; + diff --git a/lib/WebGUI/Image/Graph.pm b/lib/WebGUI/Image/Graph.pm new file mode 100644 index 000000000..0ec5d4eac --- /dev/null +++ b/lib/WebGUI/Image/Graph.pm @@ -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(< + 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'; + } + } + } + } + +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(''.$i18n->get('no graphing plugins').''); + } + + foreach (sort keys %configForms) { + $f->raw($configForms{$_}); + } + + $f->raw('' + ); + + 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; + + diff --git a/lib/WebGUI/Image/Graph/Pie.pm b/lib/WebGUI/Image/Graph/Pie.pm new file mode 100644 index 000000000..e83c6888e --- /dev/null +++ b/lib/WebGUI/Image/Graph/Pie.pm @@ -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; + diff --git a/lib/WebGUI/Image/Graph/XYGraph.pm b/lib/WebGUI/Image/Graph/XYGraph.pm new file mode 100644 index 000000000..ed85e6580 --- /dev/null +++ b/lib/WebGUI/Image/Graph/XYGraph.pm @@ -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; + diff --git a/lib/WebGUI/Image/Graph/XYGraph/Bar.pm b/lib/WebGUI/Image/Graph/XYGraph/Bar.pm new file mode 100644 index 000000000..8f00cd0e9 --- /dev/null +++ b/lib/WebGUI/Image/Graph/XYGraph/Bar.pm @@ -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; + diff --git a/lib/WebGUI/Image/Graph/XYGraph/Line.pm b/lib/WebGUI/Image/Graph/XYGraph/Line.pm new file mode 100644 index 000000000..e470c7777 --- /dev/null +++ b/lib/WebGUI/Image/Graph/XYGraph/Line.pm @@ -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; + diff --git a/lib/WebGUI/Image/Palette.pm b/lib/WebGUI/Image/Palette.pm new file mode 100644 index 000000000..e11b44fa5 --- /dev/null +++ b/lib/WebGUI/Image/Palette.pm @@ -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; + diff --git a/lib/WebGUI/Operation.pm b/lib/WebGUI/Operation.pm index 2795fd6f6..af7ffe8e4 100644 --- a/lib/WebGUI/Operation.pm +++ b/lib/WebGUI/Operation.pm @@ -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', }; } diff --git a/lib/WebGUI/Operation/Graphics.pm b/lib/WebGUI/Operation/Graphics.pm new file mode 100644 index 000000000..0aa2114a6 --- /dev/null +++ b/lib/WebGUI/Operation/Graphics.pm @@ -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 .= ''; + $output .= ''; + foreach $color (@{$palette->getColorsInPalette}) { + $output .= ''; + $output .= ''; + $output .= ''; + $output .= ''; + $output .= ''; + } + $output .= '
'.$i18n->get('fill color').''.$i18n->get('stroke color').'
'; + $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 .= '
'; + + $output .= ''.$i18n->get('add color').'
'; + } + + 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 .= ''.$i18n->get('manage palettes').'
'; + $output .= ''.$i18n->get('manage fonts').'
'; + + 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 .= ''; + $output .= ''; + foreach (keys %$palettes) { + $output .= ''; + $output .= ''; + $output .= ''; + $output .= ''; + } + $output .= '
'.$i18n->get('palette name').'
'; + $output .= $session->icon->delete('op=deletePalette&pid='.$_); + $output .= $session->icon->edit('op=editPalette&pid='.$_); + $output .= ''.$palettes->{$_}.'
'; + + $output .= ''.$i18n->get('add color').'
'; + + 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 .= ''; + $output .= ''; + foreach (keys %fonts) { + $output .= ''; + $output .= ''; + $output .= ''; + $output .= ''; + } + $output .= '
'.$i18n->get('font name').'
'; + $output .= $session->icon->delete('op=deleteFont&fid='.$_); +# $output .= $session->icon->edit('op=editFont&fid='.$_); + $output .= ''.$fonts{$_}.'
'; + + $output .= ''.$i18n->get('add font').'
'; + + 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; + diff --git a/lib/WebGUI/Storage/Image.pm b/lib/WebGUI/Storage/Image.pm index ae8cb5f37..c0b2f5aa4 100644 --- a/lib/WebGUI/Storage/Image.pm +++ b/lib/WebGUI/Storage/Image.pm @@ -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)); diff --git a/lib/WebGUI/i18n/English/Asset_Poll.pm b/lib/WebGUI/i18n/English/Asset_Poll.pm index 88d3afe87..750cebcdf 100644 --- a/lib/WebGUI/i18n/English/Asset_Poll.pm +++ b/lib/WebGUI/i18n/English/Asset_Poll.pm @@ -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; diff --git a/lib/WebGUI/i18n/English/Graphics.pm b/lib/WebGUI/i18n/English/Graphics.pm new file mode 100644 index 000000000..d0fbb2588 --- /dev/null +++ b/lib/WebGUI/i18n/English/Graphics.pm @@ -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; diff --git a/lib/WebGUI/i18n/English/Image_Graph.pm b/lib/WebGUI/i18n/English/Image_Graph.pm new file mode 100644 index 000000000..125673191 --- /dev/null +++ b/lib/WebGUI/i18n/English/Image_Graph.pm @@ -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; diff --git a/lib/WebGUI/i18n/English/Image_Graph_Pie.pm b/lib/WebGUI/i18n/English/Image_Graph_Pie.pm new file mode 100644 index 000000000..a7ce61503 --- /dev/null +++ b/lib/WebGUI/i18n/English/Image_Graph_Pie.pm @@ -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; diff --git a/lib/WebGUI/i18n/English/Image_Graph_XYGraph.pm b/lib/WebGUI/i18n/English/Image_Graph_XYGraph.pm new file mode 100644 index 000000000..73b2bdfaf --- /dev/null +++ b/lib/WebGUI/i18n/English/Image_Graph_XYGraph.pm @@ -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; diff --git a/lib/WebGUI/i18n/English/Image_Graph_XYGraph_Bar.pm b/lib/WebGUI/i18n/English/Image_Graph_XYGraph_Bar.pm new file mode 100644 index 000000000..d4d0a2c50 --- /dev/null +++ b/lib/WebGUI/i18n/English/Image_Graph_XYGraph_Bar.pm @@ -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; + diff --git a/sbin/testEnvironment.pl b/sbin/testEnvironment.pl index cdb3ae430..37fe5adea 100644 --- a/sbin/testEnvironment.pl +++ b/sbin/testEnvironment.pl @@ -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