home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
forth
/
compiler
/
fpc
/
source
/
p3_24dc.seq
< prev
next >
Wrap
Text File
|
1990-04-05
|
2KB
|
60 lines
\ Problem 3.24 by Dickson Cheng 04/05/90 20:15:10.57
\ 1. RUBOUT doesn't work, therefore users could not recognize the digit is
\ being delete.
\ 2. Input data and the final values can not exist the singed integer limit
\ otherwise will cause error.
\ (IN) leaves a true flag if a < x < b , otherwise false.
: (IN) ( x a b -- flag )
OVER 1 PICK > IF SWAP THEN
-ROT OVER < -ROT > AND ;
\ [IN] leaves a true flag if a <= x <= b
: [IN] ( x a b -- flag )
1+ SWAP 1- SWAP (IN) ;
: DIGIT? ( n -- flag )
48 ( ASCII 0 ) 57 ( ASCII 9 ) [IN] ;
: RUBOUT ( -- )
8 EMIT SPACE 8 EMIT ;
: -DIGIT ( n -- n/10 )
10 / ;
: +DIGIT ( n c -- 10n+c-48 )
48 - SWAP 10 * + ;
: #IN ( -- n )
0 BEGIN KEY
DUP 13 ( enter ) =
IF DROP EXIT THEN
DUP 8 ( backspace ) =
IF DROP RUBOUT -DIGIT
ELSE DUP DIGIT?
IF DUP EMIT
+DIGIT
ELSE DROP
7 ( bell ) EMIT
THEN
THEN
AGAIN ;
: GETL ( -- l ) CR ." Enter tank length " #IN ;
: GETW ( -- w ) CR ." Enter tank width " #IN ;
: GETH ( -- h ) CR ." Enter tank height " #IN ;
: .VOLUME ( l w h -- ) * * CR ." Volume " . ." cubic feet." ;
: .AREA ( l w h -- )
3DUP 5 ROLL * 2* -ROT * 2* + -ROT * 2* +
CR ." Surface area " . ." square feet." ;
: TANK ( -- )
GETL GETW GETH
3DUP .VOLUME .AREA ;