home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / programming / a293_1 / !AForth_Examples_Misc < prev    next >
Encoding:
Text File  |  1993-04-13  |  2.2 KB  |  77 lines
  1. \ Forth source file
  2. \ Copyright Mads Meisner-Jensen, 6 Apr 1993
  3. \ Examples of basic principles, syntax etc.
  4.  
  5. \ The backslash character at the start of this line is one of the
  6. \ comment characters. It causes Forth to ignore the rest of the current line.
  7.  
  8. ( This is another comment. It is terminated by a right parenthesis: )
  9.  
  10. \ Observe the trailing space after the left paranthesis and the backslash
  11. \ The space has to be there because the comment characters are actually just
  12. \ Forth words.
  13.  
  14.  
  15.  
  16. \ Count from zero to 999 displaying the numbers.
  17. : THOUSAND  ( -- )  \ The stack diagram shows no input nor output
  18.   1000 0 DO  \ loop limit and start value
  19.     I .     \ get loop index and print it in free field format
  20.   LOOP       \ loop back
  21. ;             \ terminate the definition
  22.  
  23. \ Input a string from the keyboard and display it afterwards
  24. : INPUT  ( -- )
  25.   HERE                     \ used as temporary buffer
  26.   80                       \ maximum number of characters to accept
  27.   CR ." Input string:"     \ type a prompt
  28.   ACCEPT  ( +n )           \ recieve input from the keyboard
  29.   HERE SWAP  ( c-addr u )
  30.   CR TYPE                  \ new-line and display the string
  31. ;
  32.  
  33. \ Count to 99 using a WHILE construct
  34. : HUNDRED  ( -- )
  35.   0        \ initialise counter
  36.   BEGIN        \ mark beginning of loop
  37.     DUP 100 <
  38.   WHILE        \ while less than hundred do...
  39.     1+ DUP .    \ increment and print the counter
  40.   REPEAT    \ end of loop
  41. ;
  42.  
  43. \ Test if char is a digit
  44. : DIGIT?  ( char -- flag )
  45.   [CHAR] 0  [ CHAR 9 1+ ] LITERAL  ( char "0" "9"+1 )
  46.   WITHIN  ( flag )
  47. ;
  48.  
  49. \ Input a positive number, allowing only digits to be typed.
  50. : N-INPUT  ( -- ud )
  51.   0            \ length of string input so far
  52.   BEGIN
  53.     KEY DUP 13 = INVERT
  54.   WHILE            \ while not <RET>
  55.     DUP DIGIT? IF    \ was it a digit?
  56.       2DUP  ( char u char u )
  57.       HERE + C!        \ store ascii digit
  58.       1+ SWAP  ( u+1 char )
  59.       EMIT        \ emit char
  60.     ELSE
  61.       DROP  ( char -- )
  62.     THEN
  63.   REPEAT        \ loop back for more digits
  64.   DROP  ( u char -- u )
  65.   >R  0 S>D  HERE  R>  ( ud c-addr u )
  66.   >NUMBER  2DROP  ( ud )
  67. ;
  68.  
  69. \ Return value of RISC-OS centisecond counter
  70. : MONOTIME  ( -- u )
  71.   [ 0 1 ]  \ specify no input registers and one (R0) output register
  72.   SYS OS_ReadMonotonicTime
  73. ;
  74.  
  75.  
  76. \ Alas, no more examples...
  77.