home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / tutor / l5p160 < prev    next >
Text File  |  1990-07-15  |  6KB  |  100 lines
  1. \      ╔════════════════════════════════════════════════════╗
  2. \      ║ Lesson 5 Part 160  F-PC 3.5 Tutorial by Jack Brown ║
  3. \      ╚════════════════════════════════════════════════════╝
  4. \
  5. \ JB#EDIT part 1 of 4: capture the next four messages and make
  6. \
  7. \ your copy of JB#EDIT.SEQ or download  JB#LEDIT.ZIP from BCFB
  8. \ File:          JB#EDIT.SEQ
  9. \ Original Date: September 12, 1988
  10. \ Last Modified: April 20, 1990
  11. \ Author:        Jack W. Brown
  12. \ Function:      Single, Double, and Floating Variable editing
  13. \                and numeric input.
  14. \ Note:          Floating point operators assume VP-Planner floating
  15. \                point routines are loaded.  VPSFP101.ZIP or later.
  16.  
  17. CR .( Requires VP-Planner Floating point to be loaded. )
  18.  
  19. \ ┌────────────────────────────────────────────────────────────────────┐
  20. \ │                 Description                                        │
  21. \ ├────────────────────────────────────────────────────────────────────┤
  22. \ │  One characteristic ( perhaps novel ) of these operators is        │
  23. \ │  that they take the address of a variable ( single, double or      │
  24. \ │  floating ) and allow the user to edit the contents of the         │
  25. \ │  variable.                                                         │
  26. \ │                                                                    │
  27. \ │  VARIABLE A   123 A !     followed by:                             │
  28. \ │  A S#ED                   would display  123 on the screen         │
  29. \ │                           in a default field 6 spaces wide.        │
  30. \ │                                                                    │
  31. \ │  User could then edit or modify the number and upon pressing       │
  32. \ │  return the changed value would be automatically stored back       │
  33. \ │  in the VARIABLE A                                                 │
  34. \ │                                                                    │
  35. \ │  2VARIABLE B  123.45 B 2!   followed by:                           │
  36. \ │  B D#ED                     would do the same for doubles in       │
  37. \ │                             a default field 12 wide.               │
  38. \ │                                                                    │
  39. \ │  FVARIABLE C  1.56E-4 C F!  followed by:                           │
  40. \ │  C F#ED                     would do the same for floating         │
  41. \ │                             point with 12 the default field.       │
  42. \ │                                                                    │
  43. \ │  A similar family of words,  WS#ED , WD#ED , and WF#ED             │
  44. \ │  allowed the user to specify his own field width, and yet          │
  45. \ │  another family of words,  XYWS#ED , XYWD#ED , and XYWF#ED         │
  46. \ │  allow users to specify the column X , row Y , and the width W.    │
  47. \ │                                                                    │
  48. \ │  Here is the whole family: adr = variable address, x is cursor     │
  49. \ │  column, y is cursor row, and w is input field width.              │
  50. \ │                                                                    │
  51. \ │  S#ED ( adr -- )   WS#ED ( adr w -- )   XYWS#ED ( adr x y w -- )   │
  52. \ │  D#ED ( adr -- )   WD#ED ( adr w -- )   XYWD#ED ( adr x y w -- )   │
  53. \ │  F#ED ( adr -- )   WF#ED ( adr w -- )   XYWF#ED ( adr x y w -- )   │
  54. \ │                                                                    │
  55. \ │  Using the above operators it is a simple mater to implement       │
  56. \ │  a more traditional set of operators that leave their input on     │
  57. \ │  on the parameter or floating point stack.                         │
  58. \ │                                                                    │
  59. \ │     S#IN ( -- n )        WS#IN ( w -- n )                          │
  60. \ │  XYWS#IN ( x y w -- n )                                            │
  61. \ │     D#IN ( -- dn)        WD#IN ( w -- dn)                          │
  62. \ │  XYWD#IN ( x y w -- dn)                                            │
  63. \ │                                                                    │
  64. \ │  Floating point input operators left values on the floatinng       │
  65. \ │  point stack.                                                      │
  66. \ │             parameter stack  floating point stack                  │
  67. \ │        F#IN ( P: -- )         ( F: -- r )                          │
  68. \ │       WF#IN ( P: w -- )       ( F: -- r )                          │
  69. \ │     XYWF#IN ( P: x y w -- )   ( F: -- r )                          │
  70. \ └────────────────────────────────────────────────────────────────────┘
  71.  
  72. ONLY  FORTH ALSO DEFINITIONS
  73.  
  74. CREATE TPAD 34 ALLOT  TPAD 34 BLANK
  75.  
  76. CREATE SNUM 10 ALLOT   \ Scratch variable of ????IN operators.
  77.  
  78. \ Leave a true flag if string begins with a -ve sign.
  79. \ Note we assume a counted string!!  adr is 1 less than the
  80. \ the first string character.
  81. : ANY-SIGN? ( adr -- adr' flag )
  82.         DUP 1+ C@ DUP ASCII - =     \ Increment adr , check for -
  83.         IF    DROP 1+ TRUE          \ Leave true flag if found.
  84.         ELSE  ASCII + =             \ Allow a +sign if desired.
  85.               IF    1+  THEN        \ Increment past + sign
  86.               FALSE                 \ and leave false flag.
  87.         THEN ;
  88.  
  89. \ Move up to first non blank of string.  Actually adr' points
  90. \ to position before first non blank!!
  91. : SKIP-BLANKS ( adr -- adr' )
  92.         BEGIN 1+ DUP C@ BL <> UNTIL  1-  ;
  93.  
  94. \ Set cursor from 16 bit hi-x lo-y format.
  95. : CUR!  ( xy -- )  SPLIT AT ;
  96.  
  97. \ Fetch cursor to 16 bit form.
  98. : CUR@  ( -- xy )  IBM-AT? FLIP + ;
  99.  
  100.