home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / l3p160.seq < prev    next >
Text File  |  1988-11-05  |  4KB  |  101 lines
  1. \ Here is another way to write SPEED_CHECK .  This time the messages
  2. \ are built into the speed interval words.
  3. \ ***** look here ***
  4. \ Also each interval checking word has the equivalent of a double
  5. \ EXIT.  You may recall that when we were talking about the return
  6. \ stack we said the system kept information on the return stack.
  7. \ This information consists of the segment and offset of the calling
  8. \ word that is the place we are to return when we reach the semi colon
  9. \ So...
  10. \ R> R> pulls this segment and offset to the parameter stack.
  11. \ 3DROP removes the segment, offset and the speed.
  12. \ EXIT  has the effect of removing another segment and offset
  13. \ so that if the interval tests true we skip out not to the calling
  14. \ word but another level higher!
  15.  
  16. \ All this may seem fairly complicated, but it has the advantage that
  17. \ that if an inteval tests true we don't come back to test the rest
  18. \ of the cases.
  19.  
  20. \            Message                              Speed range kmph
  21. \           -----------                          ------------------
  22. \ " issue ticket,    impeding traffic flow."            0   -  15
  23. \ " issue warning,   impeding traffic flow."           16   -  30
  24. \ " no action,       safe speed."                      31   -  55
  25. \ " issue warning,   exceeding speed limit."           56   -  65
  26. \ " issue ticket,    exceeding speed limit."           66   -  99
  27. \ " arrest motorist, dangerous driving."              100   -
  28.  
  29. \ Display ticket msg ifis speed is very slow  0 - 15 kmph
  30. : VERY_SLOW? \ ( speed -- speed) or ( speed --)
  31.         DUP 0 15 [IN]
  32.         IF   ." Issue ticket,    impeding traffic flow."
  33.              R> R>   \ pull segment and offset of calling word
  34.              3DROP   \ throw away speed and seg off of calling word
  35.              EXIT    \ Now we exit to the word that called the calling
  36.         THEN ;       \ word!!    ie... R> R> 2DROP EXIT  == DOUBLE_EXIT
  37.  
  38. \ Display warning msg if speed is slow  16 - 30 kmph
  39. : SLOW? \ ( speed -- speed) or ( speed --)
  40.         DUP 16 30 [IN]
  41.         IF   ." Issue warning,   impeding traffic flow."
  42.              R> R> 3DROP EXIT
  43.         THEN ;
  44.  
  45. \ Display no action msg if speed is normal  31 - 55 kmph
  46. : NORMAL? \ ( speed -- speed ) or ( speed --)
  47.        DUP 31 55 [IN]
  48.        IF   ." No action,       safe speed."
  49.             R> R> 3DROP EXIT
  50.        THEN ;
  51.  
  52.  
  53. \ Display warning msg if speed is fast    56 - 65 kmph
  54. : FAST? \ ( speed -- speed) or ( speed -- )
  55.        DUP 56 65 [IN]
  56.        IF   ." Issue warning,   exceeding speed limit."
  57.             R> R> 3DROP EXIT
  58.        THEN ;
  59.  
  60. \ Display ticket msg if spped is very fast  66- 99 kmph
  61. : VERY_FAST? \ ( speed -- speed) or ( speed -- )
  62.        DUP 66 99 [IN]
  63.        IF   ." Issue ticket,    exceeding speed limit."
  64.             R> R> 3DROP EXIT
  65.        THEN ;
  66.  
  67. \ Display arrest msg if speed is dangerous   100 kmph and over.
  68. : DANGEROUS? \ ( speed -- speed) or ( speed -- )
  69.        DUP 100 200 [IN]
  70.        IF   ." Arrest motorist, dangerous driving."
  71.             R> R> 3DROP EXIT
  72.        THEN ;
  73.  
  74. \ Display broken msg if speed is invalid, negative or > 200 kmph.
  75. : BROKEN? \ ( speed -- speed)  or ( speed -- )
  76.        DUP DUP 0< SWAP 200 > OR
  77.        IF  ." Super-F Radar Gun is broken"
  78.            R> R> 3DROP  EXIT
  79.        THEN ;
  80.  
  81. \ Check speed and print appropriate message.
  82. \ Note that the order of the checks has been adjusted so that
  83. \ the most likely cases are checked first.
  84. : SPEED_CHECK ( speed -- )
  85.     NORMAL?
  86.     SLOW?
  87.     FAST?
  88.     VERY_SLOW?
  89.     VERY_FAST?
  90.     DANGEROUS?
  91.     BROKEN? ;
  92.  
  93. : SPEED_TEST ( -- )
  94.      BEGIN
  95.         CR ." Enter speed "
  96.         #IN  DUP 0= IF DROP EXIT THEN
  97.         SPACE SPEED_CHECK
  98.      AGAIN ;
  99.  
  100.  
  101.