File Coverage

blib/lib/GD/Dashboard.pm

Criterion	Covered	Total	%
statement	4	51	7.8
branch	0	6	0.0
condition	0	3	0.0
subroutine	2	12	16.6
pod			n/a
total	6	72	8.3

package GD::Dashboard;

use strict;
#use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

$GD::Dashboard::VERSION = '0.04';


# Preloaded methods go here.


#
# Constructor options:
#
# FNAME
# QUALITY
#
sub new
{
   my $proto = shift;

   my $self = {
      METERS  => {},
      FNAME => '',
      QUALITY => 100
   };


   # load in options supplied to new()
   for (my $x = 0; $x <= $#_; $x += 2)
   {
      my $opt = uc($_[$x]);

      defined($_[($x + 1)]) or die "Dashboard->new() called with odd number of option parameters - should be of the form option => value";
      $self->{$opt} = $_[($x + 1)];
   }

   bless($self);
   return $self;
}

#
# There can be many meters on a graphic.  To specify them,
# you create a new meter, then pass it to this function,
# along with its name.  All meters will be referred to by
# name.
#
sub add_meter
{
   my ($self,$name,$meter) = @_;
   $self->{METERS}->{$name} = $meter;
}

#
# Why would you want to use get_meter?  A couple of reasons.
# First, you might have called add_meter(new Dashboard::Gauge()).
# Second, if you have multiple dash layouts, you have probably
# written the code so that you don't have access to the original
# meter variables at the point where you need to set them.
#
sub get_meter
{
   my ($self,$name) = @_;
   $self->{METERS}->{$name};
}

sub gdimage
{
   my ($self) = @_;
   my ($aref) = $self->{METERS};
   my $fname = $self->{FNAME};

   if (!defined($fname) || $fname eq '')
   {
      warn("GD::Dashboard::gdimage(): You must set FNAME in constructor first!") ;
      return undef;
   }

   # Get canvas from specified background graphics
   my $im;

   if ($self->{FNAME} =~ /png$/ )
   {
      $im = GD::Image->newFromPng($self->{FNAME});
   }
   else
   {
      $im = GD::Image->newFromJpeg($self->{FNAME});
   }

   # Draw all my meters
   for my $m (keys(%{$aref}))
   {
      my $m2 = $aref->{$m};
      $m2->write_gdimagehandle($im);
   }

   $im;
}

sub png
{
   my ($self) = @_;

   my $im = $self->gdimage;

   return $im->png();
}

sub jpeg
{
   my ($self) = @_;

   my $im = $self->gdimage;

   return $im->jpeg($self->{QUALITY});
}

#
# Is anything wrong with me using this filehandle (HG1) ?
#
sub write_jpeg
{
   my ($self,$fname) = @_;

   open (HG1,'>'.$fname);
   binmode HG1;
   print HG1 $self->jpeg();
   close HG1;
}

sub write_png
{
   my ($self,$fname) = @_;

   open (HG1,'>'.$fname);
   binmode HG1;
   print HG1 $self->png();
   close HG1;
}

package GD::Dashboard::Base;

# insert base class for meters here.....

# All meters should support:
#      MIN => 0,
#      MAX => 100,
#      VAL => 50,
#      NX => 0,
#      NY => 0,
#      QUALITY => 100,

sub jpeg
{
}

sub write_jpeg
{
}

package GD::Dashboard::Gauge;

use GD;


#
# Constructor Options
#
# MIN
# MAX
# VAL
# NX
# NY
# NLEN
# NWIDTH
# NA1
# NA2
# NCOLOR
# QUALITY
# FNAME
# COUNTERCLOCKWISE
#
sub new
{
   my $proto = shift;

   my $self = {
      FNAME => '',
      MIN => 0,
      MAX => 100,
      VAL => 50,
      NX => 0,
      NY => 0,
      NLEN => 0,
      NWIDTH=>2,
      NA1=>0,
      NA2=>0,
      NCOLOR => [ 0, 0, 255 ],
      QUALITY => 100,
      COUNTERCLOCKWISE => 0
   };


   # load in options supplied to new()
   for (my $x = 0; $x <= $#_; $x += 2)
   {
      my $opt = uc($_[$x]);

      defined($_[($x + 1)]) or die "Dashboard::Gauge->new() called with odd number of option parameters - should be of the form option => value";
      $self->{$opt} = $_[($x + 1)];
   }

   bless($self);
   return $self;
}

sub write_gdimagehandle
{
   my ($self,$im) = @_;
   $self->_draw_needle($im);
}

#sub jpeg
#{
#   my ($self) = @_;
#
#   my $im = GD::Image->newFromJpeg($self->{FNAME});
#
#   $self->write_gdimagehandle($im);
#
#   return $im->jpeg(100);
#}
#
#sub write_jpeg
#{
#   my ($self,$fname) = @_;
#
#   open (HG1,'>'.$fname);
#   binmode HG1;
#   print HG1 $self->jpeg();
#   close HG1;
#}

sub set_reading
{
   my ($self,$val) = @_;

   warn "Warning: set_reading called with value less than minimum." if $val < $self->{MIN};
   warn "Warning: set_reading called with value greater than maximum." if $val > $self->{MAX};

   $self->{VAL} = $val;
}


sub _draw_needle
{
   my ($self,$im) = @_;
   my ($x,$y);
   my $pi = 3.141592;

   # Must compute x,y coords for tip of needle.
   # Angle system for GD is in degrees, 0 is straight up,
   # and they increase clockwise.  Sigh.  Angle system
   # for perl is in radians, 0 is as it is defined
   # traditionally in math, angles increase counterclockwise.
   #

   my $norm =  ($self->{VAL}-$self->{MIN}) / ($self->{MAX} - $self->{MIN} );
   my $angle_width;

   if ( $self->{NA1} > $self->{NA2} )
   {
      if ($self->{COUNTERCLOCKWISE})
      {
         $angle_width = (2*$pi) - ($self->{NA1}-$self->{NA2}) ;
      }
      else
      {
         $angle_width =($self->{NA1}-$self->{NA2}) ;
      }
   }
   else
   {
      if ($self->{COUNTERCLOCKWISE})
      {
         $angle_width = ($self->{NA2}-$self->{NA1}) ;
      }
      else
      {
         $angle_width = (2*$pi - ($self->{NA2}-$self->{NA1}) );
      }
   }

   my $angle;
   if ($self->{COUNTERCLOCKWISE}==1)
   {
      $angle = $self->{NA1} + $norm * $angle_width;
   }
   else
   {
      $angle = $self->{NA1} - $norm * $angle_width;
   }

   $x = $self->{NX} + $self->{NLEN} * cos($angle);
   $y = $self->{NY} - $self->{NLEN} * sin($angle);

   # To draw a line with a width other than 1, you actually need
   # to create an image brush.  Sigh.
   #
      my $brush = _prepare_brush($self->{NWIDTH}, $self->{NCOLOR});
      $im->setBrush($brush);

   # draw the needle!
   #
      $im->line($self->{NX},$self->{NY},$x,$y,gdBrushed);

   # how to clean up the brush?
}



#####################
#
# Private functions
#
#####################

##  set the gdBrush object to trick GD into drawing fat lines
sub _prepare_brush
{
  my ($radius, $ref_color) = @_;
  my (@rgb, $brush, $white, $newcolor);

  # get the rgb values for the desired color
#  @rgb = (0,0,255);
#  @rgb = (255,0,128);
   @rgb = @{$ref_color};
  # create the new image
  $brush = GD::Image->new ($radius*2, $radius*2);

  # get the colors, make the background transparent
#  $white = $brush->colorAllocate (255,255,255);
  $white = $brush->colorAllocate (0,0,0);
  $newcolor = $brush->colorAllocate (@rgb);
  $brush->transparent ($white);

  # draw the circle
  $brush->arc ($radius-1, $radius-1, $radius, $radius, 0, 360, $newcolor);

  # set the new image as the main object's brush
  return $brush;
}



package GD::Dashboard::WarningLight;

#
# TRANSPARENT
# NX
# NY
# FNAME
# VAL
#
sub new
{
   my $proto = shift;

   my $self = {
      VAL => 0,       # 0=off, 1=on
      NX => 0,
      NY => 0,
      FNAME => ''
   };


   # load in options supplied to new()
   for (my $x = 0; $x <= $#_; $x += 2)
   {
      my $opt = uc($_[$x]);

      defined($_[($x + 1)]) or die "Dashboard::WarningLight->new() called with odd number of option parameters - should be of the form option => value";
      $self->{$opt} = $_[($x + 1)];
   }

   bless($self);
   return $self;
}

sub write_gdimagehandle
{
   my ($self,$im) = @_;

   if ($self->{VAL} == 1)
   {
      # load the current image
      my $im2 = GD::Image->newFromJpeg($self->{FNAME});
      my ($w,$h) = $im2->getBounds();

      if (defined($self->{TRANSPARENT}))
      {
         my $white = $im2->colorClosest(255,255,255);  #TODO this should be a param
         $im2->transparent($white);
      }
      $im->copy($im2,$self->{NX},$self->{NY},0,0,$w,$h);
   }
}


sub set_reading
{
   my ($self,$val) = @_;

   $self->{VAL} = $val;
}

package GD::Dashboard::HorizontalBar;

# Options:
#   TRANSPARENT = [ r,g,b ]
#   SPACING = N
#   MIN
#   MAX
#
sub new
{
   my $proto = shift;

   my $self = {
      MIN => 0,
      MAX => 100,
      VAL => 50,
      NX => 0,
      NY => 0,
      QUALITY => 100,
      DIRECTION=>0,
      BARS=>[],
      SPACING => 0
   };


   # load in options supplied to new()
   for (my $x = 0; $x <= $#_; $x += 2)
   {
      my $opt = uc($_[$x]);

      defined($_[($x + 1)]) or die "Dashboard::HorizontalBar->new() called with odd number of option parameters - should be of the form option => value";
      $self->{$opt} = $_[($x + 1)];
   }

   bless($self);
   return $self;
}

sub add_bars
{
   my ($self,$cnt,$fname,$fnameoff) = @_;
   if (!defined($fnameoff)) { $fnameoff = ''; }
   push @{$self->{BARS}}, { CNT=>$cnt,FNAME=>$fname,FNAME_OFF=>$fnameoff} ;
}

sub set_reading
{
   my ($self,$val) = @_;

#   warn "Warning: set_reading called with value less than minimum." if $val < $self->{MIN};
#   warn "Warning: set_reading called with value greater than maximum." if $val > $self->{MAX};

   $self->{VAL} = $val;
}

sub write_gdimagehandle
{
   my ($self,$im) = @_;

   # How many bars do we have?
   my $barcnt = 0;
   for my $href (@{$self->{BARS}}) { $barcnt += $href->{CNT}; }

   # How many must we display?
   my $norm =  $self->{VAL} / ($self->{MIN} + $self->{MAX} );
   my $disp = int ($barcnt * $norm);

   # OK copy the graphics as necessary
   my $x = $self->{NX};
   for my $href (@{$self->{BARS}})
   {
      # load the current image
      my $im2 = GD::Image->newFromJpeg($href->{FNAME});

      if (defined($self->{TRANSPARENT}))
      {
         my $white = $im2->colorClosest(255,255,255);  #TODO this should be a param
         $im2->transparent($white);
      }

      my ($w,$h) = $im2->getBounds();


      my $cnt = $href->{CNT};
      while ($disp>0 && $cnt>0)
      {
         $im->copy($im2,$x,$self->{NY},0,0,$w,$h);
         $x += $w + $self->{SPACING};
         $disp--;
         $barcnt--;
         $cnt--;
      }

      # Now load up dark image and use it if necessary
      my $fn2 = $href->{FNAME_OFF};
      if (defined($fn2) && $fn2 ne '')
      {
         my $im3 = GD::Image->newFromJpeg($fn2);

         if (defined($self->{TRANSPARENT}))
         {
            my $wt = $im2->colorClosest(255,255,255);  #TODO this should be a param
            $im3->transparent($wt);
         }
         my ($w,$h) = $im2->getBounds();

         while ($cnt>0)
         {
            $im->copy($im3,$x,$self->{NY},0,0,$w,$h);
            $x += $w + $self->{SPACING};
            $cnt--;
         }
      }
   }


}





# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__