home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / tutor / l6p120 < prev    next >
Text File  |  1990-07-15  |  3KB  |  100 lines
  1.        ╔════════════════════════════════════════════════════╗
  2.        ║ Lesson 6 Part 120  F-PC 3.5 Tutorial by Jack Brown ║
  3.        ╚════════════════════════════════════════════════════╝
  4.  
  5.             ┌─────────────────────────────────────┐
  6.             │  A Simple Sting Package Case Study. │
  7.             └─────────────────────────────────────┘
  8.  
  9. \  This string package originally appeared in
  10. \  Dr. Dobbs Number 50 and was written by
  11. \  Mr. Ralph Dean
  12.  
  13. \ Search for end of string addr and leave  string length on top.
  14. : SEARCH ( addr -- len )
  15.     DUP BEGIN                   \ addr addr
  16.         DUP C@                  \ addr addr char
  17.         SWAP 1+ SWAP            \ addr addr+1 char
  18.         0= UNTIL                \ addr addr+1+len
  19.         SWAP -  1- ;            \ len
  20.  
  21. \ Defining word to create new strings.
  22. : STRING ( len -- )      \ when compiling
  23.          ( -- addr len ) \ when executing
  24.      CREATE ABS 255 MIN 1 MAX   \ len  has been range checked.
  25.      DUP C,
  26.      0 DO 0 C, LOOP 0 C,        \ --   initialize as nulls.
  27.      DOES> 1+ DUP SEARCH ;
  28.  
  29. \ Store string. Usage:  string1  string2  S!
  30. \ Target string is replaced by new string.
  31. : S!   ( addr1 len1 addr2 len2  -- )
  32.     DROP DUP 1- C@     \ addr1 len1 addr2 mlen
  33.     ROT MIN 1 MAX      \ addr1 addr2 len  <- length to store
  34.     2DUP + 0 SWAP C!   \ addr1 addr2 len  mark end with a null
  35.     MOVE ;
  36.  
  37. \ Store sub string. Usage: string1 string2  SUB!
  38. \ Only sub string of target is replaced.
  39. : SUB! ( addr1 len1 addr2 len2  -- )
  40.         ROT MIN 1 MAX      \ addr1 addr2 len <- sub string length.
  41.         MOVE ;
  42.  
  43. \ Temporary storage for string operations.
  44. CREATE TEMP 256 ALLOT
  45.  
  46. \ Usage:  5 10 string MID$
  47. : MID$ ( posn len1 addr2 len2 -- addr len )
  48.      SWAP >R ROT MIN 1 MAX     \ len1 len2 posn
  49.      SWAP OVER MAX OVER - 1+
  50.      SWAP R> + 1- SWAP
  51.      OVER SEARCH MIN ;
  52.  
  53. \ Usage: 6 string LEFT$
  54. : LEFT$ ( posn addr1 len1 -- addr len )
  55.     >R >R 1 SWAP R> R> MID$ ;
  56.  
  57. \ Usage: 6 string RIGHT$
  58. : RIGHT$ ( posn addr1 len1 -- addr len )
  59.     256 -ROT MID$ ;
  60.  
  61. \ Concatenate two strings.
  62. \ Usage:  string1 string2 S+ string3 S!
  63. : S+ ( addr1 len1 addr2 len2 -- addr len )
  64.      ROT >R ROT R> TUCK
  65.      TEMP SWAP MOVE
  66.      TUCK + 255 MIN DUP >R
  67.      OVER - SWAP TEMP + SWAP MOVE
  68.      R> 0 OVER TEMP + C!
  69.      TEMP SWAP ;
  70.  
  71. \ Return current string length. Usage: string LEN
  72. : LEN  ( addr len -- len )
  73.      NIP ;
  74.  
  75. \ Return max string length.  Usage:  string MLEN
  76. : MLEN ( addr len -- mlen )
  77.     DROP 1- C@ ;
  78.  
  79. \ Convert single number to a string.
  80. : STR$ ( n -- addr len )
  81.      S>D TUCK DABS
  82.      <# 0 HOLD #S ROT SIGN #> 1- ;
  83.  
  84. \ Convert string to a number.
  85. : VAL ( addr len -- dn )
  86.          PAD 2DUP  C!  1+  SWAP  CMOVE  \ Move string to PAD
  87.          BL PAD COUNT + C!              \ Add a blank at the end
  88.          PAD NUMBER DROP ;
  89.  
  90. : "   \  " {text}"  ( -- addr len )
  91.     STATE @ IF [COMPILE] "
  92.             ELSE ASCII " WORD
  93.                  PAD 257 ERASE DUP COUNT
  94.                  PAD SWAP MOVE PAD SWAP C@
  95.             THEN ;  IMMEDIATE
  96.  
  97. ┌─────────────────────────────────────┐
  98. │   Please Move to Lesson 6 Part 130  │
  99. └─────────────────────────────────────┘
  100.