home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / tutor / l5p170 < prev    next >
Encoding:
Text File  |  1990-07-15  |  3.2 KB  |  88 lines
  1. \      ╔════════════════════════════════════════════════════╗
  2. \      ║ Lesson 5 Part 170  F-PC 3.5 Tutorial by Jack Brown ║
  3. \      ╚════════════════════════════════════════════════════╝
  4.  
  5. \ JB#EDIT.SEQ Part 2 of 4
  6.  
  7. \ This character will fill unused digit position
  8. 254 CONSTANT CHFL
  9.  
  10.  
  11. \ This routine edits a counted string and converts to double number.
  12. \ cur is cursor x y packed into one word.
  13. \ We are using F-PC's LINEEDITOR ( x y a n -- flag )
  14. : ED_CONVERT  ( adr n cur -- cur adr n dn )
  15.         BEGIN DUP >R                     \ a n c  Position cursor.
  16.           -ROT R> SPLIT 2OVER            \ c a n x y a n
  17.           LINEEDITOR DROP                \ c a n  Edit string.
  18.           OVER SKIP-BLANKS               \ c a n  Move up to non-blank
  19.           ANY-SIGN?                      \ c a n a' flg
  20.           >R 0 0 ROT -1                  \ c a n dn a' -1
  21.           BEGIN  DPL !  CONVERT          \ c a n dn a"
  22.             DUP C@  ASCII . =            \ c a n dn a" flg
  23.             WHILE 0 REPEAT               \ c a n dn a" 0
  24.             C@ DUP CHFL =
  25.             SWAP BL = OR  NOT            \ c a n dn flag
  26.         WHILE 2DROP R> DROP BEEP         \ c a n
  27.               ASCII ? 2 PICK 1+ C! ROT   \ a n c    marks error
  28.         REPEAT R> ?DNEGATE               \ c a n dn
  29.         DPL @ 0< IF DPL OFF THEN ;       \ DPL=0 if .pt not entered
  30.  
  31.  
  32. \ Fetch a double number using field with of n  using adr  for
  33. \ and input buffer.  Invalid input is marked by ?  and user is
  34. \ required to repeat until he makes a valid number.
  35. : (#ED)  ( adr n -- dn )
  36.         CUR@ ED_CONVERT               \ cur adr n dn
  37.         >R >R                         \ Save double number.
  38.         1+ ROT + CUR!                 \ Restore cursor.
  39.         DROP R> R> ;                  \ Recover our number.
  40.  
  41.  
  42. \  ┌───────────────────────────────────────────────────────┐
  43. \  │  32 bit Variable Editing and 32 bit numeric input.    │
  44. \  └───────────────────────────────────────────────────────┘
  45.  
  46.  
  47. \ As above but field width is specified on the stack.
  48. : WD#ED  ( adr w   -- )
  49.         >R
  50.         TPAD 1+ 32 CHFL FILL    \ blank input field.
  51.         R@ TPAD C!
  52.         DUP 2@ 2DUP D0=         \ Is number 0 ?
  53.         IF   2DROP              \ if so provide blank field
  54.         ELSE TUCK DABS          \ other wise
  55.              <# #S ROT SIGN #>  \ format number and move
  56.              TPAD 1+ SWAP R@    \ to the edit buffer.
  57.              MIN CMOVE
  58.         THEN
  59.         TPAD  R>  (#ED) ROT 2! ;
  60.  
  61. \ Edit double number at current cursor position using default
  62. \ field with of 12.   Input buffer is at TPAD
  63. : D#ED   ( adr -- )
  64.         12 WD#ED  ;
  65.  
  66. \ As above but cursor & field width are specified on the stack.
  67. : XYWD#ED  ( adr x y w   -- )
  68.         -ROT AT WD#ED ;
  69.  
  70.  
  71. \ Input double number with field width on stack
  72. \ and leave resulting double number on the parameter stack.
  73. : WD#IN  ( w -- dn )
  74.         0 0 SNUM 2!
  75.             SNUM SWAP WD#ED
  76.             SNUM 2@  ;
  77.  
  78. \ Input double number and leave on parameter stack.
  79. : D#IN  ( -- dn )
  80.         12 WD#IN ;
  81.  
  82.  
  83. \ Input double number at cursor postion x y using a field width w
  84. \ and leave the resulting double number on the parameter stack.
  85. : XYWD#IN  ( x y w -- dn )
  86.         -ROT AT WD#IN ;
  87.  
  88.