home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
forth
/
compiler
/
fpc
/
tutor
/
l5p110
< prev
next >
Wrap
Text File
|
1990-07-15
|
4KB
|
89 lines
\ ╔════════════════════════════════════════════════════╗
\ ║ Lesson 5 Part 110 F-PC 3.5 Tutorial by Jack Brown ║
\ ╚════════════════════════════════════════════════════╝
\ Part two of CHKBOOK.SEQ
/* ************************************************************ */
/* Function: CLR_HBAR Clear screan and draw horizontal bar */
/* */
/* Date: July 25, 1988 */
/* */
/* Interface: CLR_HBAR ( n -- ) */
/* */
/* ************************************************************ */
: CLR_HBAR ( n -- )
27 EMIT ." [2J" CR HBAR ;
/* ************************************************************ */
/* Function: GET_DOLLARS Fetch dollars with error checking. */
/* */
/* Date: July 22, 1988 */
/* */
/* Interface: GET_DOLLARS ( -- n ) */
/* */
/* ************************************************************ */
: GET_DOLLARS ( -- n )
BEGIN
27 EMIT ." [K Dollars: "
SCAN_FOR_INT CR DUP
9999 > OVER 0 < OR
WHILE
DROP 27 EMIT ." [1;A"
REPEAT ;
/* ************************************************************ */
/* Function: GET_CENTS Fetch cents with error checking. */
/* */
/* Date: July 22, 1988 */
/* */
/* Interface: GET_CENTS ( -- n ) */
/* */
/* ************************************************************ */
: GET_CENTS ( -- n )
BEGIN
27 EMIT ." [K Cents: "
SCAN_FOR_INT CR DUP
99 > OVER 0 < OR
WHILE
DROP
27 EMIT ." [1;A"
REPEAT ;
/* ************************************************************ */
/* */
/* Function: ROUND - Roll cents into dollars. */
/* */
/* Date: July 25, 1988 */
/* */
/* Interface: ROUND ( dollars cents -- dollars' cents' ) */
/* */
/* ************************************************************ */
: ROUND ( dollars cents -- dollars' cents')
DUP >R
100 / +
R> 100 MOD ;
/* ************************************************************ */
/* */
/* Function: ADD_TO_BAL - Add dollars, cents amount to balance */
/* */
/* Date: July 22, 1988 */
/* */
/* Interface: ADD_TO_BAL ( dollars cents -- ) */
/* dollars: dollar amount to be added */
/* cents : cents amount to be added */
/* */
/* ************************************************************ */
: ADD_TO_BAL ( dollars cents -- )
BAL_CENTS +!
BAL_DOLLARS +!
BAL_DOLLARS @ BAL_CENTS @ ROUND
BAL_CENTS ! BAL_DOLLARS ! ;