package provide packedDecimal 0.1
namespace eval packedDecimal {
namespace export add subtract multiply divide setDecimals
variable decimals 2
variable formatString {%d.%2.2d}
variable carry 100
}
proc packedDecimal::add {a b} {
variable decimals
variable formatString
scan $a %d.%d a1 a2
scan $b %d.%d b1 b2
incr a2 $b2
if {[string length $a2] > $decimals} then {
incr a1 1
set a2 [string range $a2 1 end]
}
incr a1 $b1
return [format $formatString $a1 $a2]
}
proc packedDecimal::subtract {a b} {
variable decimals
variable formatString
variable carry
scan $a %d.%d a1 a2
scan $b %d.%d b1 b2
incr a2 -$b2
if {$a2 < 0} then {
incr b1 1
set a2 [expr {$carry + $a2}]
}
incr a1 -$b1
return [format $formatString $a1 $a2]
}
# This is not really right yet!
proc packedDecimal::roundingRule {a b} {
variable carry
while {$b >= $carry/2} {
incr a 1
incr b -$carry
}
return [list $a $b]
}
# Does not handle negative values - DKF
proc packedDecimal::multiply {a b} {
variable decimals
variable formatString
variable carry
scan $a %u.%u a1 a2
scan $b %u.%u b1 b2
set c1 [expr {$a1*$b1}]
set c2 [expr {$a1*$b2 + $b1*$a2}]
set c3 [expr {$a2*$b2}]
foreach {c2 c3} [roundingRule $c2 $c3] {break}
foreach {c1 c2} [roundingRule $c1 $c2] {break}
if {$c2 < 0} {
incr c1 -1
incr c2 $carry
}
return [format $formatString $c1 $c2]
}
proc packedDecimal::divide {a b} {
variable decimals
variable formatString
return -code error {Sorry, Divide is not yet implemented!}
}
proc packedDecimal::setDecimals {a} {
variable decimals
variable formatString
variable carry 100
set formatString [format {%%d.%%%d.%dd} $a $a]
set decimals $a
set carry [format "1%${a}.${a}d" 0]
return;
}
proc packedDecimal::getDecimals {} {
variable decimals
return $decimals
}AM A FAQ that deals with decimal arithmetic can be found at [1]. There is also a formal specification available (and an implementation in C, with a "renewable" licence) [2].
beernutmark I have worked up a Decimal Arithmetic Package for tcl 8.5
Sarnold I have been doing some Decimal arithmetic with bignums.
Gerald Lester
