home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
forth
/
compiler
/
fpc
/
source
/
p4_5dc.seq
< prev
next >
Wrap
Text File
|
1990-04-11
|
3KB
|
93 lines
\ Problem 4.5 04/10/90 18:56:59.54
VARIABLE SEED 1234 SEED !
VARIABLE HEART
VARIABLE DIAMOND
VARIABLE CLUB
VARIABLE SPADE
VARIABLE ONE
VARIABLE TWO
VARIABLE THREE
VARIABLE FOUR
VARIABLE FIVE
VARIABLE SIX
VARIABLE SEVEN
VARIABLE EIGHT
VARIABLE NINE
VARIABLE TEN
VARIABLE ELEVEN
VARIABLE TWELVE
VARIABLE THIRTEEN
: (RND) ( -- r )
SEED @ 259 * 3 + 32767 AND DUP SEED ! ;
: RND ( n -- r )
(RND) 32767 */ ;
: DRAW ( -- suit value )
4 RND 1+ 13 RND 1+ ;
: INIT ( -- )
0 HEART ! 0 DIAMOND ! 0 CLUB ! 0 SPADE !
0 ONE ! 0 TWO ! 0 THREE ! 0 FOUR ! 0 FIVE !
0 SIX ! 0 SEVEN ! 0 EIGHT ! 0 NINE ! 0 TEN !
0 ELEVEN ! 0 TWELVE ! 0 THIRTEEN ! ;
: UPDATE_VALUE ( value -- )
DUP 1 = IF ONE @ 1+ ONE ! ELSE
DUP 2 = IF TWO @ 1+ TWO ! ELSE
DUP 3 = IF THREE @ 1+ THREE ! ELSE
DUP 4 = IF FOUR @ 1+ FOUR ! ELSE
DUP 5 = IF FIVE @ 1+ FIVE ! ELSE
DUP 6 = IF SIX @ 1+ SIX ! ELSE
DUP 7 = IF SEVEN @ 1+ SEVEN ! ELSE
DUP 8 = IF EIGHT @ 1+ EIGHT ! ELSE
DUP 9 = IF NINE @ 1+ NINE ! ELSE
DUP 10 = IF TEN @ 1+ TEN ! ELSE
DUP 11 = IF ELEVEN @ 1+ ELEVEN ! ELSE
DUP 12 = IF TWELVE @ 1+ TWELVE ! ELSE
THIRTEEN @ 1+ THIRTEEN !
THEN THEN THEN THEN THEN THEN THEN THEN THEN THEN THEN THEN DROP ;
: UPDATE_SUIT ( suit -- )
DUP 1 = IF HEART @ 1+ HEART ! ELSE
DUP 2 = IF DIAMOND @ 1+ DIAMOND ! ELSE
DUP 3 = IF CLUB @ 1+ CLUB ! ELSE
SPADE @ 1+ SPADE !
THEN THEN THEN DROP ;
: CARD ( n -- )
CLS INIT
ABS DUP 0 ?DO
DRAW UPDATE_VALUE UPDATE_SUIT
LOOP
CR ." Number of draw : " 3 .R
CR
CR ." Heart : " HEART @ 3 .R
CR ." Diamond : " DIAMOND @ 3 .R
CR ." Club : " CLUB @ 3 .R
CR ." Spade : " SPADE @ 3 .R
CR CR
CR ." One : " ONE @ 3 .R
CR ." Two : " TWO @ 3 .R
CR ." Three : " THREE @ 3 .R
CR ." Four : " FOUR @ 3 .R
CR ." Five : " FIVE @ 3 .R
CR ." Six : " SIX @ 3 .R
CR ." Seven : " SEVEN @ 3 .R
CR ." Eight : " EIGHT @ 3 .R
CR ." Nine : " NINE @ 3 .R
CR ." Ten : " TEN @ 3 .R
CR ." Eleven : " ELEVEN @ 3 .R
CR ." Twelve : " TWELVE @ 3 .R
CR ." Thirteen : " THIRTEEN @ 3 .R
CR ;