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