home bbs files messages ]

Forums before death by AOL, social media and spammers... "We can't have nice things"

   comp.lang.forth      Forth programmers eat a lot of Bratwurst      117,927 messages   

[   << oldest   |   < older   |   list   |   newer >   |   newest >>   ]

   Message 117,134 of 117,927   
   Hans Bezemer to All   
   Re: (FG.) FG.R (was Re: Bring your Forth   
   08 Mar 25 19:02:28   
   
   From: the.beez.speaks@gmail.com   
      
   On 08-03-2025 02:57, dxf wrote:   
   Ed, as usual - thank you!   
   Of course, I had to iron out the /STRING and BOOL tricks - but I   
   managed. ;-)   
      
   BTW, I call ( a n -- a+1 n-1) CHOP and ( a n -- a n-1) CLIP. They're   
   dear and well respected friends of mine. I rarely use /STRING myself.   
      
   Hans Bezemer   
      
   > 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)   

[   << oldest   |   < older   |   list   |   newer >   |   newest >>   ]


(c) 1994,  bbs@darkrealms.ca