package CORBA::Fixed;
# Perl5.004 and earlier complain about $self->{s}, so we use
# $self->{'s'} throughout (ugly...)
'+' => \&add,
'-' => \&subtract,
'*' => \&mul,
'/' => \&div,
'<=>' => \&compare,
'""' => \&stringify;
require Math::BigInt;
sub _construct {
my ($class, $value, $scale) = @_;
bless {
v => $value,
's' => $scale,
}, $class;
}
sub from_string {
my ($class, $str) = @_;
my ($leading,$rest) = $str =~ /^(\s*[+-]?\d+)(?:\.(\d+)*)?/;
if (!defined $leading) {
return CORBA::Fixed->_construct(0,0);
} else {
$rest = defined $rest ? $rest : "";
$str = $leading.$rest;
my $n = 0;
if ($str =~ /(0+)$/) {
$n = length($1);
if ($str =~ /^\s*[+-]?0+$/) { # Don't trim off the only zero
$n--;
}
substr($str,-$n,$n) = "";
}
return CORBA::Fixed->_construct (Math::BigInt->new($str), length($rest)-$n);
}
}
sub new {
my ($class, $v, $scale) = @_;
CORBA::Fixed->_construct (Math::BigInt->new($v), $scale);
}
sub add {
my ($a, $b) = @_;
if (!UNIVERSAL::isa($b, "CORBA::Fixed")) {
$b = CORBA::Fixed->from_string($b);
}
my ($v, $s);
if ($a->{'s'} > $b->{'s'}) {
$s = $a->{'s'};
$v = $a->{v} + ($b->{v}.("0" x ($a->{'s'} - $b->{'s'})));
} else {
$s = $b->{'s'};
$v = $b->{v} + ($a->{v}.("0" x ($b->{'s'} - $a->{'s'})));
}
CORBA::Fixed->_construct ($v, $s);
}
sub subtract {
my ($a, $b, $reverse) = @_;
if (!UNIVERSAL::isa($b, "CORBA::Fixed")) {
$b = CORBA::Fixed->from_string($b);
}
if ($reverse) {
($a, $b) = ($b, $a);
}
my ($v, $s);
{
local $^W = 0; # BigInt.pm problems
if ($a->{'s'} > $b->{'s'}) {
$s = $a->{'s'};
$v = $a->{v} - ($b->{v}.("0" x ($a->{'s'} - $b->{'s'})));
} else {
$s = $b->{'s'};
$v = ($a->{v}.("0" x ($b->{'s'} - $a->{'s'}))) - $b->{v};
}
}
CORBA::Fixed->_construct ($v, $s);
}
sub compare {
my ($a, $b, $reverse) = @_;
if (!UNIVERSAL::isa($b, "CORBA::Fixed")) {
$b = CORBA::Fixed->from_string($b);
}
if ($reverse) {
($a, $b) = ($b, $a);
}
if ($a->{'s'} > $b->{'s'}) {
$a->{v} <=> ($b->{v}.("0" x ($a->{'s'} - $b->{'s'})));
} else {
($a->{v}.("0" x ($b->{'s'} - $a->{'s'}))) <=> $b->{v};
}
}
sub mul {
my ($a, $b) = @_;
if (!UNIVERSAL::isa($b, "CORBA::Fixed")) {
$b = CORBA::Fixed->from_string($b);
}
CORBA::Fixed->_construct ($a->{v}*$b->{v}, $a->{'s'}+$b->{'s'});
}
sub div {
my ($a, $b) = @_;
if (!UNIVERSAL::isa($b, "CORBA::Fixed")) {
$b = CORBA::Fixed->from_string($b);
}
if ($reverse) {
($a, $b) = ($b, $a);
}
# calculate to 31 places
my $s = ($a->{'s'} - $b->{'s'});
my $v1 = $a->{v};
my $v2 = $b->{v};
my $pad = (31 - (length($v1) - length($v2)));
if ($pad > 0) {
$v1 = new Math::BigInt ($v1.("0" x $pad));
$s += $pad;
}
{
local $^W = 0; # BigInt.pm problems
CORBA::Fixed->_construct ($v1/$v2, $s);
}
}
# Turn the number into a form suitable for turning into a
# ORBit FixedValue
sub to_digits {
my ($self, $ndigits, $scale) = @_;
my $value = $self->{v};
my $vstr = "$value";
if ($self->{'s'} > $scale) {
my $rest = substr($vstr, -($self->{'s'} - $scale));
substr($vstr, -($self->{'s'} - $scale)) = "";
# Banker's rounding
if (length ($rest) > 0) {
my $half = new Math::BigInt ("5".('0' x (length ($rest)-1)));
$rest = new Math::BigInt ($rest);
$value = new Math::BigInt ($vstr);
if ($rest == $half) {
$vstr = "" . new Math::BigInt ($value + ((substr($vstr,-1) % 2) ? 1 : 0));
} else {
$vstr = "" . new Math::BigInt ($value + (($rest < $half) ? 0 : 1));
}
}
} else {
$vstr .= '0' x ($scale - $self->{'s'});
}
# pad or truncate to the requested number of digits
my $len = length ($vstr) - 1;
if ($len < $ndigits) {
return substr($vstr,0,1) . ('0' x ($ndigits - $len) ) . substr($vstr,1);
} else {
return substr($vstr,0,1) . substr($vstr,-$ndigits);
}
}
sub stringify {
my $self = shift;
my $vstr = "$self->{v}";
my $scale = $self->{'s'};
if ($scale > 0) {
return substr($vstr,0,length($vstr)-$scale).".".substr($vstr,-$scale);
} else {
return $vstr . ('0' x -$scale);
}
}
1;
=head1 NAME
CORBA::ORBit::Fixed - Fixed point arithmetic for CORBA.
=head1 SYNOPSIS
use CORBA:::ORBit::Fixed;
$a = new CORBA::Fixed "+123454", 3
print $a + 1.0 # produces "+124.454"
=head1 DESCRIPTION
CORBA::ORBit::Fixed implements arithmetic operations on fixed point
numbers. It is meant to be used in conjuction with the CORBA::ORBit
module, but could conceivable be useful otherwise. Note that
the file is called C<CORBA::ORBit::Fixed>, but it implements the
generic package C<CORBA::Fixed>.
=head1 Internal representation
Internally, numbers are as represented as a pair of a C<Math::BigInt>
multiple precision integer, and a integer scale. (positive or
negative).
=head1 Arithmetic operations
Addition, subtraction, and multiplication are carried out
precisely. For adddition and subtraction, of two numbers
with scales C<s1> and C<s2>, the resulting scale is C<MAX(s1,s2)>.
For multiplication the resulting scale is C<s1+s2>.
Division is carried out to 31 decimals places, with additional
digits truncated without rounding.
=head1 Methods in C<CORBA::ORBit::Fixed>
=over 4
Aside from overloaded C<+>, C<->, C<*>, C</> C<<=>> and C<"">
operations, C<CORBA::ORBit::Fixed> provides the following methods:
=item new STRING SCALE
Given a string (as suitable for input to C<Math::BigInt>), and
a scale, create a fixed-point value with the digits and sign
of STRING, and the scale SCALE.
=item from_string STRING
Create a CORBA::Fixed object from a string according to the
rules in the CORBA manual for fixed literals. That is,
the scale is given by the number of digits to the right
of the decimal point, I<ignoring trailing zeros>. If the
number has no non-zero digits to the right of the decimal
point, the scale will be the negative of the number of
trailing zeros to the left of the decimal point.
=item to_digits ( NDIGITS, SCALE )
Gives the digits (with a leading C<+> or C<-> sign) of the
the object's value, rounded to the SCALE, and padded to
NDIGITS.
=item
=back
=head1 AUTHOR
Owen Taylor <otaylor@gtk.org>
=head1 SEE ALSO
perl(1).
=cut