home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / tutor / l5p190 < prev    next >
Encoding:
Text File  |  1990-07-15  |  2.8 KB  |  83 lines
  1. \      ╔════════════════════════════════════════════════════╗
  2. \      ║ Lesson 5 Part 190  F-PC 3.5 Tutorial by Jack Brown ║
  3. \      ╚════════════════════════════════════════════════════╝
  4.  
  5. \ JB#EDIT.SEQ  Part 4 of 4
  6.  
  7. \ Fetch a floating number using field with of n  using adr  for
  8. \ and input buffer.  Invalid input is marked by ?  and user is
  9. \ required to repeat until he makes a valid number.
  10. : (#FED)  ( P: adr n -- ) ( F: -- r )
  11.         CUR@ ED_FCONVERT              \ cur adr n dn
  12.         >R >R                         \ Save double number.
  13.         1+ ROT + CUR!                 \ Restore cursor.
  14.         DROP R> R> FLOAT ;            \ Recover our number.
  15.  
  16. \ Edit double number at current cursor position using field with
  17. \ field with of w.   Input buffer is at TPAD
  18. : WF#ED   ( adr w -- )
  19.         >R
  20.         TPAD 1+  32 CHFL FILL
  21.         R@ TPAD C!
  22.         DUP F@ FDUP F0=
  23.         IF   FDROP
  24.         ELSE FDUP R@ 2- (..) ?DUP 0=
  25.              IF DROP ?NONAN1
  26.                  IF R@ 6 - (E.)
  27.                  ELSE (.NAN)
  28.                  THEN
  29.              ELSE FDROP
  30.              THEN             \ adr  adr" len
  31.              TPAD 1+ SWAP R@ MIN CMOVE
  32.         THEN
  33.         TPAD     R> (#FED)  F! ;
  34.  
  35. \ Edit floating  number at current cursor position using default
  36. \ field with of 16.   Input buffer is at TPAD
  37. : F#ED   ( adr -- )
  38.         16 WF#ED ;
  39.  
  40. \ As above but cursor & field width are specified on the stack.
  41. : XYWF#ED  ( adr x y w   -- )
  42.         -ROT AT WF#ED ;
  43.  
  44. \ Input floating point number with field width on stack
  45. \ and leave resulting floating point number on the floating point stack.
  46. : WF#IN  ( P: w -- )  ( F: -- r )
  47.         0.  SNUM F!   SNUM SWAP WF#ED   SNUM F@  ;
  48.  
  49. \ Input floating point number and leave on floating point stack.
  50. : F#IN  ( F: --  r )
  51.         16 WF#IN ;
  52.  
  53. \ Input floating point number at cursor postion x y using a field width w
  54. \ and leave the resulting floating point number on the floating point stack.
  55. : XYWF#IN  ( P: x y w -- ) ( F: -- r )
  56.            -ROT AT WF#IN ;
  57.  
  58. comment:
  59.   VARIABLE SS     123    SS  !
  60.   DOUBLE
  61.  2VARIABLE DD     123.45 DD 2!
  62.   FLOATING
  63.  FVARIABLE FF     123.45 FF F!
  64.  
  65. : TEST  ( -- )
  66. CLS
  67. CR ." Testing single variable editing."
  68. CR SS            S#ED ( adr -- )        SS @ .
  69. CR SS 8         WS#ED ( adr w -- )      SS @ .
  70. CR SS 40 10 8 XYWS#ED ( adr x y w -- )  SS @ .
  71. CLS
  72. CR ." Testing double variable editing."
  73. CR DD            D#ED ( adr -- )        DD 2@ D.
  74. CR DD 8         WD#ED ( adr w -- )      DD 2@ D.
  75. CR DD 40 10 8 XYWD#ED ( adr x y w -- )  DD 2@ D.
  76. CLS
  77. CR ." Testing floating point variable editing."
  78. CR FF             F#ED ( adr -- )        FF F@ ..
  79. CR FF 12         WF#ED ( adr w -- )      FF F@ ..
  80. CR FF 40 10 12 XYWF#ED ( adr x y w -- )  FF F@ ..  ;
  81. comment;
  82.  
  83.