home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / tutor / l5p180 < prev    next >
Text File  |  1990-07-15  |  4KB  |  92 lines
  1. \      ╔════════════════════════════════════════════════════╗
  2. \      ║ Lesson 5 Part 180  F-PC 3.5 Tutorial by Jack Brown ║
  3. \      ╚════════════════════════════════════════════════════╝
  4.  
  5. \ JB#EDIT.SEQ Part 3 of 4
  6.  
  7. \  ┌───────────────────────────────────────────────────────┐
  8. \  │  16 bit Variable Editing and 16 bit Numeric Input.    │
  9. \  └───────────────────────────────────────────────────────┘
  10.  
  11. \ As above but field width is specified on the stack.
  12. : WS#ED  ( adr w   -- )
  13.         >R
  14.         TPAD 1+ 32 CHFL FILL       \ blank input field.
  15.         R@ TPAD C!
  16.         DUP @ DUP 0=               \ Is number 0 ?
  17.         IF    DROP                 \ if so provide blank field
  18.         ELSE  S>D TUCK DABS        \ other wise
  19.               <# #S ROT SIGN #>    \ format number and move
  20.               TPAD 1+ SWAP R@      \ to the edit buffer.
  21.               MIN CMOVE
  22.         THEN
  23.         TPAD   R> (#ED) DROP SWAP ! ;
  24.  
  25. \ Edit single number a current cursor position using default
  26. \ field with of 6.   Edit buffer is at TPAD
  27. : S#ED ( adr   -- )
  28.         6 WS#ED ;
  29.  
  30. \ As above but cursor & field width are specified on the stack.
  31. : XYWS#ED  ( adr x y n   -- )
  32.         -ROT AT WS#ED ;
  33.  
  34. \ Input single number with field width on stack
  35. \ and leave resulting single number on the parameter stack.
  36. : WS#IN  ( w --  n )
  37.       0 SNUM !   SNUM SWAP WS#ED   SNUM @  ;
  38.  
  39. \ Input single number in a default field 6 wide
  40. \ and leave on parameter stack.
  41. : S#IN  ( -- n )
  42.           6 WS#IN ;
  43.  
  44. \ Input single number at cursor postion x y using a field width w
  45. \ and leave the resulting single number on the parameter stack.
  46. : XYWS#IN  ( x y w --  n )
  47.       0 SNUM !  ROT SNUM SWAP 2SWAP XYWS#ED   SNUM @  ;
  48.  
  49. \  ┌────────────────────────────────────────────────────────────────────┐
  50. \  │ Floating point varialbe editing and floating point numeric input.  │
  51. \  └────────────────────────────────────────────────────────────────────┘
  52.  
  53. HEX
  54.  
  55. \ This routine edits a counted string and converts it to a double number.
  56. \ cur is cursor x y packed into one word.
  57. : ED_FCONVERT  ( adr n cur -- cur adr n dn )
  58.         BEGIN DUP >R                \ a n c  Position cursor.
  59.           -ROT R> SPLIT 2OVER       \ c a n x y a n
  60.           LINEEDITOR DROP           \ c a n  Edit string.
  61.           OVER COUNT + BL SWAP C!   \ FIX
  62.           OVER SKIP-BLANKS          \ c a n  Move up to non-blank
  63.           ANY-SIGN?                 \ c a n a' flg      / sgn[dn]
  64.           >R 0 0 ROT 8000           \ c a n |dn| a' -1
  65.           BEGIN  DPL !  FCONVERT    \ c a n |dn| a"
  66.             DUP C@  ASCII . =       \ c a n |dn| a" flg
  67.             WHILE 0 REPEAT          \ c a n |dn| a" 0
  68.             DUP C@ 0DF AND          \ Allow lower case e for exponent.
  69.             ASCII E =               \ c a n |d| a3 f2   / sgn[dn]
  70.             IF DPL @ 0 MAX >R       \ c a n |d| a3 f2   / DPL sgn[dn]
  71.                ANY-SIGN? >R         \ c a n |d| a3 f2   / sgn[exp] DPL sgn[dn]
  72.                DUP C@               \ c a n |dn| a5 c   / sgn[exp] DPL sgn[dn]
  73.                DUP CHFL =
  74.                SWAP BL = OR
  75.                IF   R> R> 2DROP     \ c a n |dn| a5     / sgn[D]
  76.                ELSE DBL0 ROT
  77.                     FCONVERT        \ c a n |dn| de a6  / sgn[de] DPL sgn[dn]
  78.                     NIP SWAP
  79.                     R> NOT
  80.                     ?NEGATE
  81.                     R> + DPL !      \ c a n |dn| a6     / sgn[dn]
  82.                THEN
  83.              THEN                   \ c a n |dn| a7     / sgn[dn]
  84.             C@ DUP CHFL =
  85.             SWAP BL = OR  NOT             \ c a n |dn| flag / sgn[dn]
  86.         WHILE 2DROP R> DROP BEEP          \ c a n
  87.               ASCII ? 2 PICK 1+ C! ROT    \ a n c    Mark error
  88.         REPEAT R> ?DNEGATE                \ c a n dn
  89.         DPL @ 8000 = IF DPL OFF THEN ;    \ DPL=0 if .pt not entered
  90. DECIMAL
  91.  
  92.