home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / tutor / l5p130 < prev    next >
Encoding:
Text File  |  1990-07-15  |  4.1 KB  |  99 lines
  1. \      ╔════════════════════════════════════════════════════╗
  2. \      ║ Lesson 5 Part 130  F-PC 3.5 Tutorial by Jack Brown ║
  3. \      ╚════════════════════════════════════════════════════╝
  4.  
  5. \ Part four of CHKBOOK.SEQ
  6. /* ************************************************************ */
  7. /*                                                              */
  8. /* Function:    MAKE_A_DEPOSIT - calculates new balance after   */
  9. /*                               a deposit is made.             */
  10. /*                                                              */
  11. /* Date: July 25, 1988                                          */
  12. /*                                                              */
  13. /* Interface:   MAKE_A_DEPOSIT ( --)                            */
  14. /*                                                              */
  15. /* Notes: Calls add_to_bal to perform fixed point calculations. */
  16. /*                                                              */
  17. /* ************************************************************ */
  18.  
  19. : MAKE_A_DEPOSIT ( -- )
  20.         40 CLR_HBAR
  21.         ." Enter the amount of the deposit: " CR
  22.         40 HBAR
  23.         GET_DOLLARS  TR_DOLLARS !
  24.         GET_CENTS    TR_CENTS !
  25.         1 DEP_COUNT +!
  26.         TR_DOLLARS @ DEP_DOLLARS @ + 
  27.         TR_CENTS   @ DEP_CENTS   @ +
  28.         ROUND  DEP_CENTS ! DEP_DOLLARS !
  29.         40 HBAR
  30.         TR_DOLLARS @ TR_CENTS @ ADD_TO_BAL
  31.        ." After a deposit of "
  32.        TR_DOLLARS  @ TR_CENTS  @ $XX.XX CR
  33.        ." your new balance comes to: "
  34.        BAL_DOLLARS @ BAL_CENTS @ $XX.XX CR
  35.        40 HBAR ;
  36.  
  37. /* ************************************************************ */
  38. /*                                                              */
  39. /* Function: NET_CHANGE       Displays net change from session  */
  40. /*                            start.                            */
  41. /*                                                              */
  42. /* Date: July 25, 1988                                          */
  43. /*                                                              */
  44. /* Interface:   NET_CHANGE ( -- )                               */
  45. /*                                                              */
  46. /* ************************************************************ */
  47.  
  48. VARIABLE DIF_DOLLARS
  49. VARIABLE DIF_CENTS
  50.  
  51. : NET_CHANGE ( -- )
  52.         BAL_DOLLARS @ DIF_DOLLARS !
  53.         BAL_CENTS   @ DIF_CENTS   !
  54.         OLD_CENTS @ BAL_CENTS @ >
  55.         IF  -1 DIF_DOLLARS +!
  56.             100 DIF_CENTS +!
  57.         THEN
  58.         OLD_DOLLARS @ NEGATE DIF_DOLLARS +!
  59.         OLD_CENTS   @ NEGATE DIF_CENTS   +!
  60.         40 CLR_HBAR
  61.         ." Net change this session: "
  62.         DIF_DOLLARS @ 0 <
  63.         IF   100 DIF_CENTS @ - DIF_CENTS !
  64.              1 DIF_DOLLARS @ + NEGATE DIF_DOLLARS !
  65.              ASCII - EMIT 
  66.         THEN
  67.         DIF_DOLLARS @ DIF_CENTS @ $XX.XX CR
  68.         40 HBAR ;
  69.  
  70. /* ************************************************************ */
  71. /*                                                              */
  72. /* Function:    TOT_CHECKS     Displays total checks written    */
  73. /*                             this session.                    */
  74. /*                                                              */
  75. /* Date: July 25, 1988                                          */
  76. /*                                                              */
  77. /* Interface:   TOT_CHECKS ( --  )                              */
  78. /*                                                              */
  79. /* ************************************************************ */
  80.  
  81. : TOT_CHECKS ( -- )
  82.         70 CLR_HBAR
  83.         CHK_COUNT @ 0=
  84.         IF
  85.         ." There have been no checks written so far this session "
  86.         ." so the total is: "
  87.         ELSE CHK_COUNT @ 1 =
  88.              IF
  89.              ." Only one check has been written so far this session "
  90.              ." for a total of: "
  91.              ELSE
  92.             ." There were " CHK_COUNT @ .
  93.             ." checks written so far this session "
  94.             ." that total: "
  95.             THEN
  96.        THEN
  97.        CHK_DOLLARS @ CHK_CENTS @ $XX.XX CR
  98.        70 HBAR ;
  99.