Re: (FG.) FG.R (was Re: Bring your Forth to work)

On 7/03/2025 12:43 pm, dxf wrote:

...
Turns out I needed a new function to duplicate the output.  I must have
run into the same issue before as a decade ago I defined FG.R etc which
simulates Fortran's 'G' format output.  The original had some quirks so
I've taken the opportunity to update it.
...

A slightly improved version that avoids a calculation.  The latter
was always superfluous but I couldn't see a way of removing it without
increasing code elsewhere ... until now.  Also removed is the '1 MAX'
since 'zero significant digits' represents an ambiguous condition.

\ Purpose: derive a floating-point output function with
\ characteristics similar to Fortran's 'G' format.  Useful
\ for displaying tables of formatted results.
\
\ Assumes the function:
\  (FS.) ( r n -- a u )
\ Convert r to a string a u in scientific notation to n
\ decimal places.  Both '.' and 'E' must be present in the
\ returned string (NAN/INFs excepted).
\
\ Public domain (no warranty)

\ Misc tools
\ SCAN ( a u char -- a2 u2 )  common usage
: (NUMBER) ( a u -- ud a' u' )  0 0 2swap >number ;
: /SIGN ( a u -- a' u' f ) \ skip leading sign if exists
  dup if  over c@  dup [char] + =   swap [char] - =
  dup >r  or  negate /string  r> exit  then  0 ;
: /NUMBER ( a u -- a' u' d|ud )
  /sign >r (number) 2swap r> if dnegate then ;
: CSKIP  1 /string ;
: 2NIP  2swap 2drop ;
: S.R ( a u wid -- ) over - spaces type ;

\ Main

0 value d  0 value e  \ location of '.' 'E'

\ Convert real number r to string with n digits of precision.
\ Use fixed-point if exponent -1 to n or scientific otherwise.
: (FG.) ( r n -- c-addr u )
  dup >r  1- (fs.)  2dup [char] . scan  ?dup if ( not nan/inf)
    over to d  [char] E scan  over to e  cskip
    /number 2nip d>s  dup -1 r@ within if ( fixed-point)
      >r  [char] .  d  dup r@ 0< 2* 1+ +  over r@ abs move
      r@ + c!  ( a u) drop e over -  r>
    then
  then  r> 2drop ;

: FG.R ( r n u -- )  >r (fg.) r> s.r ; \ print right-justified

\ behead d e