Date: Sat, 8 Mar 2025 19:02:28 +0100
MIME-Version: 1.0
User-Agent: Mozilla Thunderbird
Subject: Re: (FG.) FG.R (was Re: Bring your Forth to work)
Newsgroups: comp.lang.forth
References: <ea7cb66aa2699a5038e525bff68bb96ace214265@i2pn2.org>
 <932430feaabe2b354e9eabaa0239a520e47b1fde@i2pn2.org>
Content-Language: en-US
From: Hans Bezemer <the.beez.speaks@gmail.com>
In-Reply-To: <932430feaabe2b354e9eabaa0239a520e47b1fde@i2pn2.org>
Content-Type: text/plain; charset=UTF-8; format=flowed
Content-Transfer-Encoding: 7bit
Message-ID: <nnd$68ffe8d6$4668e7f2@4073c1c13abf3a0b>
Organization: KPN B.V.
Path: ...!2.eu.feeder.erje.net!feeder.erje.net!feeder2.feed.ams11.usenet.farm!feed.usenet.farm!feed.abavia.com!abe007.abavia.com!abp004.abavia.com!news.kpn.nl!not-for-mail
Lines: 68
Injection-Date: Sat, 08 Mar 2025 19:02:28 +0100
Injection-Info: news.kpn.nl; mail-complaints-to="abuse@kpn.com"
Bytes: 3423

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
>