\      ͻ
\       Lesson 5 Part 190  F-PC 3.5 Tutorial by Jack Brown 
\      ͼ

\ JB#EDIT.SEQ  Part 4 of 4

\ Fetch a floating number using field with of n  using adr  for
\ and input buffer.  Invalid input is marked by ?  and user is
\ required to repeat until he makes a valid number.
: (#FED)  ( P: adr n -- ) ( F: -- r )
        CUR@ ED_FCONVERT              \ cur adr n dn
        >R >R                         \ Save double number.
        1+ ROT + CUR!                 \ Restore cursor.
        DROP R> R> FLOAT ;            \ Recover our number.

\ Edit double number at current cursor position using field with
\ field with of w.   Input buffer is at TPAD
: WF#ED   ( adr w -- )
        >R
        TPAD 1+  32 CHFL FILL
        R@ TPAD C!
        DUP F@ FDUP F0=
        IF   FDROP
        ELSE FDUP R@ 2- (..) ?DUP 0=
             IF DROP ?NONAN1
                 IF R@ 6 - (E.)
                 ELSE (.NAN)
                 THEN
             ELSE FDROP
             THEN             \ adr  adr" len
             TPAD 1+ SWAP R@ MIN CMOVE
        THEN
        TPAD     R> (#FED)  F! ;

\ Edit floating  number at current cursor position using default
\ field with of 16.   Input buffer is at TPAD
: F#ED   ( adr -- )
        16 WF#ED ;

\ As above but cursor & field width are specified on the stack.
: XYWF#ED  ( adr x y w   -- )
        -ROT AT WF#ED ;

\ Input floating point number with field width on stack
\ and leave resulting floating point number on the floating point stack.
: WF#IN  ( P: w -- )  ( F: -- r )
        0.  SNUM F!   SNUM SWAP WF#ED   SNUM F@  ;

\ Input floating point number and leave on floating point stack.
: F#IN  ( F: --  r )
        16 WF#IN ;

\ Input floating point number at cursor postion x y using a field width w
\ and leave the resulting floating point number on the floating point stack.
: XYWF#IN  ( P: x y w -- ) ( F: -- r )
           -ROT AT WF#IN ;

comment:
  VARIABLE SS     123    SS  !
  DOUBLE
 2VARIABLE DD     123.45 DD 2!
  FLOATING
 FVARIABLE FF     123.45 FF F!

: TEST  ( -- )
CLS
CR ." Testing single variable editing."
CR SS            S#ED ( adr -- )        SS @ .
CR SS 8         WS#ED ( adr w -- )      SS @ .
CR SS 40 10 8 XYWS#ED ( adr x y w -- )  SS @ .
CLS
CR ." Testing double variable editing."
CR DD            D#ED ( adr -- )        DD 2@ D.
CR DD 8         WD#ED ( adr w -- )      DD 2@ D.
CR DD 40 10 8 XYWD#ED ( adr x y w -- )  DD 2@ D.
CLS
CR ." Testing floating point variable editing."
CR FF             F#ED ( adr -- )        FF F@ ..
CR FF 12         WF#ED ( adr w -- )      FF F@ ..
CR FF 40 10 12 XYWF#ED ( adr x y w -- )  FF F@ ..  ;
comment;

