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