Self-checking numeric entry

\ Self-checking numeric entry.  Input consists of either decimal
\ byte values (hex if preceded by '$') separated by spaces, or
\ the equivalent ASCII characters (including control-chars).
\ Input is terminated by <RETURN> key.
\
\ Note:
\ - editing is limited to numeric mode
\ - first key determines whether mode is numeric or ASCII
\ - the two modes cannot be mixed
\
\ Main words
\ .STR GET# GET$

[undefined] DXFORTH [if]
: END  postpone exit  postpone then ; immediate
: NOT 0= ;
: BETWEEN ( n1|u1 n2|u2 n3|u3 -- f )  1+ swap within 0= ;
: UPCASE ( c -- c' )
  dup [char] a [char] z between if $20 xor - then ;
: >DIGIT ( c base -- u true | c false )  \ case-sensitive
  over [char] 0 -  dup 10 16 within if  drop else  dup 16 u>
  if 7 - then  dup rot u< if nip true end  then drop false ;
: BEEP  ( 7 emit) ;
[then]

20 constant max$  \ input buffer size

create ibuf  max$ allot  \ input buffer

: .hb ( u -- )  hex  s>d <# # # #> type space  decimal ;

8 constant <bs>   13 constant <cr>

: visible? ( c -- flag )  bl 127 within ;

: .chr ( c -- )
  case
    10  of ." <LF>"    endof  <cr> of ." <CR>"   endof
    27  of ." <ESC>"   endof  bl   of ." <SP>"   endof
    127 of ." <DEL>"   endof
    dup bl <         if  ." Ctrl-"  [char] @ +    else
    dup visible? not if  [char] $ emit  .hb  end  then
    dup  emit
  endcase  space ;

: .dec ( adr len -- )
  ."  ("  begin  dup while  over c@ 0 .r  1 /string
  dup while  space  repeat then  2drop  ." ) " ;

: .STR ( adr len -- )
  dup if
    2dup  bounds ?do  i c@ .chr  loop  .dec
  end  2drop  ." <none> " ;

variable #digit  \ #digits entered

: /field ( -- )
  #digit @  begin  dup while
    <bs> emit  space  <bs> emit  1-
  repeat  #digit ! ;

: +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  0 #digit !  0 swap  begin
    case [char] $ of ." $"  hex  key  endof  dup endcase
    upcase  dup bl <>  over <cr> <>  and while
    dup visible? if  dup emit  1 #digit +!  then
    +digit if  beep  /field  drop 0  then  key
  repeat  decimal ;

: GET# ( -- n )  key build# drop ;

variable len   0 value maxchr

: room? ( -- f )  len @  maxchr <  ;

: +chr ( c -- )  ibuf len @ +  c!  1 len +! ;

: do-num ( c -- )
  begin  room? while
    build#  swap  #digit @ if  +chr  else  drop  then
    <cr> = if end  space  key
  repeat  drop ;

: do-asc ( c -- )
  begin  dup <cr> -  room?  and while
    dup .chr  +chr  key
  repeat  drop ;

: digit? ( c -- f )
  dup [char] $ =  swap [char] 0 [char] 9 between  or ;

\ Input a string either as ASCII characters or decimal/hex
\ bytes separated by spaces.  Control characters allowed.
: GET$ ( maxlen -- adr len )
  to maxchr  len off
  key  dup digit? if  do-num  else  do-asc  then
  ibuf len @ ;