package Complex;
use Carp;
#a '_' prefix on variables is a common way to indicate private
# variables. (Note that in Perl nothing is actually private
# ... well that is a lie - you can use encapsulation to make
# variables private, so if you want really private variables
# then go read Damian Conway's "Object Oriented Perl" ).
sub _REAL {0} #_REAL is a constant '0'
sub _IMAG {1} #_IMAG is a constant '1'
sub new
{
my $class = shift; #get class name ('Complex')
my $real = shift; #get first argument
my $img = shift; #get second argument
my $self = [$real, $img]; #create anon array with arguments
bless $self, $class; #bless the array as a Complex object
return $self; #return our new object
}
sub AUTOLOAD
{
my $sub = $AUTOLOAD; #get global $AUTOLOAD function name
my $self = shift; #get the current object
my $value = shift; #get an optional parameter
$sub =~ s/.*://; #strip off package name
#let the system handle 'DESTROY' function calls
return if $sub =~ /DESTROY/;
#make function call upper case to match our constants
my $sub = uc($sub);
#call the function (should be 'REAL' or 'IMAG' which will
# return 0 or 1 respectively). The eval will trap runtime
# errors in case someone calls a function that is not _REAL
# or _IMAG.
my $position = eval("&_".$sub);
#if the position is not a number then they called something
# bogus like $obj->print, which would call &_PRINT from the
# eval, then $postion would be 'undef'
unless( $position =~ /\d/ )
{
croak("Subroutine undefined: \"$AUTOLOAD\"");
}
#if no parameter then they just want the Real or Imag value
# returned instead of set.
if( not defined $value )
{
#return the value associated with the position in the array
# that was returned from the eval above.
return $self->[$position];
}
else
{
#a value was passed in, so assign it to the position in the
# array that was returned from the eval above. This
# returns $value also, which is not strictly needed;
return $self->[$position] = $value;
}
}
####
use Complex;
#create a new object
my $x = new Complex;
#create a new object with initial values
my $y = new Complex(5, -3);
$x->Real(3); #set $x's real part to '3'
$x->Imag(-5); #set $x's imaginary part to '-5'
print $x->Real." ".$y->Imag; #prints '3 -3'
##
##
use overload
"\"\"" => \&Cmp_string,
"+" => \&Cmp_add,
"*" => \&Cmp_multiply;
##
##
print $x; #prints '3 - 5I'
my $str = "$x"; #$str = '3 - 5I'
##
##
$x = $x + $y;
$y = $x + 2;
$y = 2 + $x;
##
##
$y = $x * $x;
$y = $x * 2;
$y = 2 * $x;
##
##
sub Cmp_string
{
#get the object
my $a = shift;
#figure out what sign to put between the real
# and imaginary part. I do this so we don't get
# something like '3 + -5I', although it fairly
# irrelevant
my $sign = ($a->Imag > 0) ? " + " : " - ";
#return a string that looks like '3 - 5I'
return $a->Real.$sign.abs($a->Imag)."I";
}
sub Cmp_add
{
#get the calling object; $a is always the Complex object, it
# does not matter if we call '$x + 2' or '2 + $x' or
# '$x + $y' ... this $a will always be $x.
my $a = shift;
#get the second object, either a number or an object
my $b = shift;
#if $b is not a Complex object do the simple math
unless( $b->isa( 'Complex' ) )
{
#return a new Complex object after doing the simple
# arithmetic
return new Complex( $a->Real + $b, $a->Imag );
}
#return a new Complex object after doing the 'complex'
# arithmetic
return new Complex($a->Real+$b->Real, $a->Imag+$b->Imag);
}
sub Cmp_multiply
{
#get the calling object; $a is always the Complex object, it
# does not matter if we call '$x * 2' or '2 * $x' or
# '$x * $y' ... this $a will always be $x.
my $a = shift;
#get the second object, either a number or an object
my $b = shift;
unless( $b->isa( 'Complex' ) )
{
#return a new Complex object after doing the simple
# arithmetic
return new Complex( $a->Real * $b, $a->Imag * $b);
}
#figure out the new real and imaginary parts. Good'ol
# FOIL method anybody?
my $real = ($a->Real * $b->Real) + ($a->Imag * $b->Imag * -1);
my $imag = ($a->Real * $b->Imag) + ($a->Imag * $b->Real);
#return a new Complex object after doing the 'complex'
# arithmetic
return new Complex($real, $imag);
}
##
##
package Complex;
use Carp;
use strict;
use vars '$AUTOLOAD';
use overload
"\"\"" => \&Cmp_string,
"+" => \&Cmp_add,
"*" => \&Cmp_multiply;
#a '_' prefix on variables is a common way to indicate private
# variables. (Note that in Perl nothing is actually private
# ... well that is a lie - you can use encapsulation to make
# variables private, so if you want really private variables
# then go read Damian Conway's "Object Oriented Perl" ).
sub _REAL {0} #_REAL is a constant '0'
sub _IMAG {1} #_IMAG is a constant '1'
sub new
{
my $class = shift; #get class name ('Complex')
my $real = shift; #get first argument
my $img = shift; #get second argument
my $self = [$real, $img]; #create anon array with arguments
bless $self, $class; #bless the array as a Complex object
return $self; #return our new object
}
sub AUTOLOAD
{
my $sub = $AUTOLOAD; #get global $AUTOLOAD function name
my $self = shift; #get the current object
my $value = shift; #get an optional parameter
$sub =~ s/.*://; #strip off package name
#let the system handle 'DESTROY' function calls
return if $sub =~ /DESTROY/;
#make function call upper case to match our constants
my $sub = uc($sub);
#call the function (should be 'REAL' or 'IMAG' which will
# return 0 or 1 respectively). The eval will trap runtime
# errors in case someone calls a function that is not _REAL
# or _IMAG.
my $position = eval("&_".$sub);
#if the position is not a number then they called something
# bogus like $obj->print, which would call &_PRINT from the
# eval, then $postion would be 'undef'
unless( $position =~ /\d/ )
{
croak("Subroutine undefined: \"$AUTOLOAD\"");
}
#if no parameter then they just want the Real or Imag value
# returned instead of set.
if( not defined $value )
{
#return the value associated with the position in the array
# that was returned from the eval above.
return $self->[$position];
}
else
{
#a value was passed in, so assign it to the position in the
# array that was returned from the eval above. This
# returns $value also, which is not strictly needed;
return $self->[$position] = $value;
}
}
sub Cmp_string
{
#get the object
my $a = shift;
#figure out what sign to put between the real
# and imaginary part. I do this so we don't get
# something like '3 + -5I', although it fairly
# irrelevant
my $sign = ($a->Imag > 0) ? " + " : " - ";
#return a string that looks like '3 - 5I'
return $a->Real.$sign.abs($a->Imag)."I";
}
sub Cmp_add
{
#get the calling object; $a is always the Complex object, it
# does not matter if we call '$x + 2' or '2 + $x' or
# '$x + $y' ... this $a will always be $x.
my $a = shift;
#get the second object, either a number or an object
my $b = shift;
#if $b is not a Complex object do the simple math
unless( $b->isa( 'Complex' ) )
{
#return a new Complex object after doing the simple
# arithmetic
return new Complex( $a->Real + $b, $a->Imag );
}
#return a new Complex object after doing the 'complex'
# arithmetic
return new Complex($a->Real+$b->Real, $a->Imag+$b->Imag);
}
sub Cmp_multiply
{
#get the calling object; $a is always the Complex object, it
# does not matter if we call '$x * 2' or '2 * $x' or
# '$x * $y' ... this $a will always be $x.
my $a = shift;
#get the second object, either a number or an object
my $b = shift;
unless( $b->isa( 'Complex' ) )
{
#return a new Complex object after doing the simple
# arithmetic
return new Complex( $a->Real * $b, $a->Imag * $b);
}
#figure out the new real and imaginary parts. Good'ol
# FOIL method anybody?
my $real = ($a->Real * $b->Real) + ($a->Imag * $b->Imag * -1);
my $imag = ($a->Real * $b->Imag) + ($a->Imag * $b->Real);
#return a new Complex object after doing the 'complex'
# arithmetic
return new Complex($real, $imag);
}
#module exit status
1;