1. Forum
  2. Usenet
  3. COMP.LANG.FORTH

  • Self-checking numeric entry

    From dxforth@21:1/5 to All on Sat Mar 4 12:39:30 2023
    I've extracted this from an application I wrote. Perhaps there's something
    in it you can use. I modified it use ANS CASE and it seems to work. The
    BEEP routine is defined as a no-op - change it as required for your system.

    https://pastebin.com/H8Pj89Ui

    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)
  • From dxforth@21:1/5 to dxforth on Sat Mar 4 15:52:40 2023
    On 4/03/2023 12:39 pm, dxforth wrote:
    I've extracted this from an application I wrote.  Perhaps there's something in it you can use.  I modified it use ANS CASE and it seems to work.  The BEEP routine is defined as a no-op - change it as required for your system.

    https://pastebin.com/H8Pj89Ui

    There's a bug in the preamble. Should be:

    : UPCASE ( c -- c' )
    dup [char] a [char] z between if $20 xor then ;

    Missing:

    : OFF ( a -- ) 0 swap ! ;

    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)
  • From dxforth@21:1/5 to dxforth on Sun Mar 5 14:50:08 2023
    On 4/03/2023 3:52 pm, dxforth wrote:
    On 4/03/2023 12:39 pm, dxforth wrote:
    I've extracted this from an application I wrote.  Perhaps there's something >> in it you can use.  I modified it use ANS CASE and it seems to work.  The >> BEEP routine is defined as a no-op - change it as required for your system. >>
    https://pastebin.com/H8Pj89Ui

    There's a bug in the preamble.  Should be:

    : UPCASE ( c -- c' )
      dup [char] a [char] z between if $20 xor then ;

    Missing:

    : OFF ( a -- )  0 swap ! ;

    Reviewing the code I noticed numeric entry could be more robust.
    The following changes will do that. Use GET# ( -- n ) to test.

    : /field ( n -- 0 )
    drop #digit @ begin dup while
    <bs> emit space <bs> emit 1-
    repeat decimal #digit off ;

    : .visible ( c -- )
    dup visible? if emit 1 #digit +! end drop ;

    : ?$ ( n c -- n' c' )
    case [char] $ of
    /field hex [char] $ .visible key
    endof dup endcase ;

    : +digit ( u c -- u' err )
    base @ >digit if swap base @ * + dup 255 u> end
    drop true ;

    : build# ( c -- n c2 ) \ cr or bl exits
    decimal #digit off 0 swap begin
    dup bl <> over <cr> <> and while
    ?$ upcase dup .visible
    +digit if beep /field then key
    repeat decimal ;

    It shouldn't take much effort to extend the package to handle integers, including signed, over a range as specified by the programmer.

    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)