home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / cylinder.pm < prev    next >
Encoding:
Perl POD Document  |  2002-12-06  |  4.2 KB  |  127 lines
  1. # $File: //depot/RG/rg/lib/RG/lib/GD/Graph/cylinder.pm $ $Author: autrijus $
  2. # $Revision: #3 $ $Change: 370 $ $DateTime: 2002/07/17 20:38:38 $
  3.  
  4. package GD::Graph::cylinder;
  5.  
  6. use strict;
  7.  
  8. use GD::Graph::axestype3d;
  9. use GD::Graph::utils qw(:all);
  10. use GD::Graph::colour qw(:colours);
  11.  
  12. use base qw/GD::Graph::bars3d/;
  13. $GD::Graph::cylinder::VERSION = '0.63';
  14.  
  15. my %Defaults = (
  16.     # Spacing between the bars
  17.     bar_spacing     => 0,
  18.  
  19.     # The 3-d extrusion depth of the bars
  20.     bar_depth => 10,
  21. );
  22.  
  23. sub initialise
  24. {
  25.     my $self = shift;
  26.  
  27.     my $rc = $self->SUPER::initialise();
  28.     $self->set(correct_width => 1);
  29.  
  30.     while( my($key, $val) = each %Defaults ) { 
  31.         $self->{$key} = $val 
  32.     } # end while
  33.  
  34.     return $rc;
  35. } # end initialise
  36.  
  37. sub draw_bar_h {
  38.     my $self = shift;
  39.     my $g = shift;
  40.     my( $l, $t, $r, $b, $dsci, $brci, $neg ) = @_;
  41.     my $fnord = $g->colorAllocate(0,0,0);
  42.  
  43.     my $depth = $self->{bar_depth};
  44.  
  45.     my ($lighter, $darker) = ($dsci, $dsci);
  46.     if ($self->{'3d_shading'}) {
  47.     $lighter = $self->{'3d_highlights'}[$dsci];
  48.     $darker = $self->{'3d_shadows'}[$dsci];
  49.     }
  50.     $g->line($l+$depth, $t+1, $r+$depth, $t+1, $dsci);
  51.     $g->line($l+$depth, $b, $r+$depth, $b, $dsci);
  52.     $g->arc($r+$depth, ($t+$b)/2, $depth*2, ($b-$t), 270, 90, $dsci);
  53.     $g->arc($l+$depth, ($t+$b)/2, $depth*2, ($b-$t), 90, 270, $dsci);
  54.     # find border
  55.     my $foo = $l+$depth;
  56.     --$foo
  57.     until $foo == $l || $g->getPixel($foo, $t+($b-$t)/5) == $dsci;
  58.     my $bar = $foo+1;
  59.     ++$bar
  60.     until $bar == $foo || $g->getPixel($bar, $t+($b-$t)/5) == $dsci;
  61.     $g->line($foo, $t+($b-$t)/5, $bar, $t+($b-$t)/5, $dsci);
  62.     $g->line($foo, $b-($b-$t)/5, $bar, $b-($b-$t)/5, $dsci);
  63.     $g->fillToBorder($l+$depth, ($t+$b)/2, $dsci, $dsci);
  64.     $g->arc($l+$depth, ($b+$t)/2, $depth*2, ($b-$t), 90, 270, $dsci);
  65.     if ($foo < $bar + 3) {
  66.     $g->fillToBorder(($l+$r)/2+$depth, $t+($b-$t)/5-1, $dsci, $lighter)
  67.         unless $g->getPixel(($l+$r)/2+$depth, $t+($b-$t)/5-1) == $dsci;
  68.     $g->fillToBorder(($l+$r)/2+$depth, $b-($b-$t)/5+1, $dsci, $darker)
  69.         unless $g->getPixel(($l+$r)/2+$depth, $b-($b-$t)/5+1) == $dsci;
  70.     $g->fillToBorder(($l+$r)/2, ($t+$b)/2, $dsci, $dsci);
  71.     }
  72.     $g->arc($l+$depth, ($b+$t)/2, $depth*2, ($b-$t), 90, 270, $brci);
  73.     $g->arc($r+$depth, ($b+$t)/2, $depth*2, ($b-$t), 0, 360, $brci);
  74.     $g->line($l+$depth, $t+1, $r+$depth, $t+1, $brci);
  75.     $g->line($l+$depth, $b, $r+$depth, $b, $brci);
  76.     $g->fillToBorder($r+$depth, ($b+$t)/2, $brci, $dsci);
  77. }
  78.  
  79. sub draw_bar {
  80.     my $self = shift;
  81.     return $self->draw_bar_h(@_) if $self->{rotate_chart};
  82.     my $g = shift;
  83.     my( $l, $t, $r, $b, $dsci, $brci, $neg ) = @_;
  84.     my $fnord = $g->colorAllocate(0,0,0);
  85.  
  86.     my $depth = $self->{bar_depth};
  87.  
  88.     my ($lighter, $darker) = ($dsci, $dsci);
  89.     if ($self->{'3d_shading'}) {
  90.         $lighter = $self->{'3d_highlights'}[$dsci];
  91.         $darker = $self->{'3d_shadows'}[$dsci];
  92.     }
  93.  
  94.     $g->line($l+1, $t-$depth, $l+1, $b-$depth, $dsci);
  95.     $g->line($r, $t-$depth, $r, $b-$depth, $dsci);
  96.  
  97.     $g->arc(($l+$r)/2, $t-$depth, ($r-$l), $depth*2, 180, 360, $dsci);
  98.     $g->arc(($l+$r)/2, $b-$depth, ($r-$l), $depth*2, 0, 180, $dsci);
  99.     # find border
  100.     my $foo = $b-$depth+1;
  101.     ++$foo
  102.         until $foo == $b || $g->getPixel($l+($r-$l)/5,$foo) == $dsci;
  103.     my $bar = $foo-1;
  104.     --$bar
  105.         until $bar == $foo || $g->getPixel($l+($r-$l)/5,$bar) == $dsci;
  106.     $g->line($l+($r-$l)/5, $bar, $l+($r-$l)/5, $foo, $dsci);
  107.     $g->line($r-($r-$l)/5, $bar, $r-($r-$l)/5, $foo, $dsci);
  108.     $g->fillToBorder(($l+$r)/2, $t-$depth, $dsci, $dsci);
  109.     $g->arc(($l+$r)/2, $b-$depth, ($r-$l), $depth*2, 0, 180, $dsci);
  110.     if ($foo > $bar + 3) {
  111.         $g->fillToBorder($l+($r-$l)/5-1, ($foo+$bar)/2, $dsci, $lighter)
  112.         unless $g->getPixel($l+($r-$l)/5-1, ($foo+$bar)/2) == $dsci;
  113.         $g->fillToBorder($r-($r-$l)/5+1, ($foo+$bar)/2, $dsci, $darker)
  114.         unless $g->getPixel($r-($r-$l)/5+1, ($foo+$bar)/2) == $dsci;
  115.         $g->fillToBorder(($l+$r)/2, ($t+$b)/2, $dsci, $dsci);
  116.     }
  117.     $g->arc(($l+$r)/2, $b-$depth, ($r-$l), $depth*2, 0, 180, $brci);
  118.     $g->arc(($l+$r)/2, $t-$depth, ($r-$l), $depth*2, 0, 360, $brci);
  119.     $g->line($l+1, $t-$depth, $l+1, $b-$depth, $brci);
  120.     $g->line($r, $t-$depth, $r, $b-$depth, $brci);
  121.     $g->fillToBorder(($l+$r)/2, $t-$depth, $brci, $dsci);
  122. }
  123.  
  124. 1;
  125.  
  126.  
  127.