home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / l3p050.seq < prev    next >
Text File  |  1990-04-01  |  2KB  |  47 lines
  1. \ Lesson 3 Part 5 ( F-PC 3.5 Tutorial by Jack Brown )
  2.  
  3. COMMENT:
  4. We continue our discussion of flags and conditionals with some of my
  5. favorite words. Interval testing words. Naming convention motivated by
  6. the mathematical intervals (a,b)  a < x < b , [a,b]  a <= x <= b (a,b]
  7. a < x <= b and [a,b)  a <= x < b.
  8. COMMENT;
  9.  
  10. \ (IN)  leaves a true flag if   a < x < b
  11. : (IN)  ( x a b --  flag )  ( JWB 28 09 88 )
  12.          2DUP < NOT ABORT" Invalid interval."
  13.          -ROT OVER < -ROT > AND ;
  14.  
  15. \ [IN]  leaves a true flag if a <= x <= b  , otherwise false.
  16. : [IN]  ( x a b --  flag ) 1+ SWAP 1- SWAP (IN) ;
  17.  
  18. \ (IN]  leaves a true flag if a <  x <= b  , otherwise false.
  19. : (IN]  ( x a b --  flag ) 1+ (IN) ;
  20.  
  21. \ [IN)  leaves a true flag if a <= x <  b  , otherwise false.
  22. : [IN)  ( x a b --  flag ) SWAP 1- SWAP (IN) ;
  23.  
  24.  
  25. : TEST  ( n -- )   \ Determine if number is even or odd.
  26.         CR DUP ." THE NUMBER " .  ." IS AN "
  27.         DUP 2/  2* =         \ Test if number is even.
  28.         IF      ." EVEN "
  29.         ELSE    ."  ODD "
  30.         THEN    ." NUMBER"  ;
  31.  
  32. COMMENT:
  33. Two new words:  KEY  and EXIT
  34.  
  35.  KEY  ( -- n )  Wait for user to press key on keyboard and
  36.                 return the key code n.
  37.  EXIT ( -- )    When compiled in a word, EXIT , will cause
  38.                 termination of word execution when encountered.
  39. COMMENT;
  40.  
  41. : KEY_TEST ( -- )  \ Using Exit to exit an infinite loop.
  42.         BEGIN  CR  KEY
  43.         DUP  CONTROL M  =    \  Control M is return key.
  44.         IF DROP EXIT THEN    \  Exit infinite loop if pressed.
  45.         DUP .  EMIT  AGAIN ; \  Otherwise show key pressed.
  46.  
  47.