|
Re: new fdot?
|
John Peters
|
Apr 25, 2003 11:24 PDT
|
Did we pick up on this?
John
----- Original Message -----
From: "Petrus Prawirodidjojo" <mug-@indosat.net.id>
To: <Win32-@topica.com>
Sent: Thursday, May 30, 2002 11:52 PM
Subject: new fdot?
| | John,
Can this fdot replace the original fdot ? This one has thousand
separators,
and interpret significand not as # of digits right to the decimal point.
This one needs decimal point character and thousand separators character
for
internationalization, but I think somebody else know the proper way to
do it
in Win32Forth.
I still have fs. fe. fm. (where digits to the right of dp is grouped in
5
separated by space), and f.r ( width #_digits_right_dp -- ) ( F: r -- )
prints right aligned for business purpose. Any needs for these?
Regards,
Petrus.
\ F. ( -- ) ( F: r -- ) 12.6.2.1427
\ display f tos in normal notation, use scientific if necessary
\ 2002 by Petrus Prawirodidjojo
\ -.0trailing ( c-addr1 u1 -- c-addr1 u2 )
\ discard trailing .000
: -.0trailing ( c-addr1 u1 -- c-addr1 u2 )
0 over 0 ?do
2 pick i + c@
over 0= if
[char] . = if drop i then
else
[char] 0 = 0= if drop i 1+ then
then
loop
dup 0= if drop else swap drop then ;
: f.
[ 18 2 + ] literal $ftemp c!
$ftemp 3 + precision 1 max 18 min represent if
$ftemp precision + 3 + 18 precision - [char] 0 fill
if [char] - else bl then $ftemp 1+ c!
dup 18 > over -5 < or if
$ftemp 3 + c@ $ftemp 2 + c!
[char] . $ftemp 3 + c!
$ftemp count -.0trailing swap drop $ftemp c!
[char] E $ftemp c+place
1-
dup 0< if [char] - else [char] + then >r
abs s>d <# # # # #s r> hold #> $ftemp +place
else
dup 0 > if
dup 1- 3 /
dup 20 + $ftemp c!
over $ftemp + 3 + over over +
over over 18 6 pick - move
2 pick 0 ?do
over i 1+ 3 * -
over i 1+ 3 * - i 1+ -
dup >r 3 move r>
i 0= if drop else [char] , swap 3 + c! then
loop
$ftemp 3 + dup 1-
5 pick 3 mod dup 0= if 3 + then move
2 pick 0= 0= if 3 pick 3 mod dup 0= if 3 + then
$ftemp 2 + + [char] , swap c! then
[char] . swap 1- c!
drop 2drop
else
abs dup 21 + $ftemp c!
$ftemp 3 + over 4 + $ftemp + 18 move
[char] 0 $ftemp 2 + c!
[char] . $ftemp 3 + c!
0 ?do [char] 0 $ftemp i + 4 + c! loop
then
$ftemp count -.0trailing swap drop $ftemp c!
then
else
$ftemp precision + 3 + 18 precision - blank
if [char] - else bl then $ftemp 1+ c!
18 $ftemp c! $ftemp 3 + $ftemp 2 + 18 move
drop then
$ftemp count -trailing type space ;
|
|
|
 |
|
