From: dxforth@gmail.com   
      
   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   
      
   --- SoupGate-DOS v1.05   
    * Origin: you cannot sedate... all the things you hate (1:229/2)