home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
SIMTEL
/
CPMUG
/
CPMUG003.ARK
/
BLKFRI.BAS
< prev
next >
Wrap
BASIC Source File
|
1984-04-29
|
11KB
|
441 lines
REM-----------------------------------------------------
REM B L A C K F R I D A Y
REM-----------------------------------------------------
REM JUNE 14, 1977
DIM PLAYER.NAME$(4)
DIM STOCK.NAME$(16)
DIM ABBR$(16)
DIM FLUCT(16)
DIM DIV.FACTOR(16)
DIM CASH(4)
DIM DIVIDENDS(4)
DIM PORTFOLIOS(4,10)
DIM STOCK.PRICE(10)
DIM NET.CHANGE(10)
NEW.STOCK=10
DIM YEAR.DIV(10)
LET ESC$ = CHR$(27)
LET LOCK.ON$ = ESC$ + CHR$(108)
LET LOCK.OFF$ = ESC$ + CHR$(109)
LET CURSOR.UP$ = ESC$ + "A"
LET CURSOR.DN$ = ESC$ + "B"
LET CURSOR.RT$ = ESC$ + "C"
LET CURSOR.LT$ = ESC$ + "D"
LET ROLL.UP$ = ESC$ + "S"
LET ROLL.DN$ = ESC$ + "T"
LET DOW.JONES = 987
LET ELAPSED.YEARS = 0
LET LENGTH.OF.TREND = 0
DEF FN.CHANGE = (1/(1-(RND^2)))
STOCK.NAME$(01)="HIGHWAY IMPROVEMENT BONDS"
STOCK.NAME$(02)="OLD WEST LAND CO."
STOCK.NAME$(03)="FINE AND DANDY CANDY CO."
STOCK.NAME$(04)="GENTLE TOUCH MASSAGE PARLORS, INC"
STOCK.NAME$(05)="SQUARE WHEEL BICYCLE CO."
STOCK.NAME$(06)="BITE SHOPS, INC."
STOCK.NAME$(07)="GOOD KARMA SHOE CO."
STOCK.NAME$(08)="MAKE-A-BUCK HOLDING CORP."
STOCK.NAME$(09)="SLIPPERY OIL COMPANY"
STOCK.NAME$(10)="CONSOLIDATED INVESTMENT CO."
STOCK.NAME$(11)="GUARD-ALL BURGLAR ALARM SYSTEMS"
STOCK.NAME$(12)="STUDEBAKER MOTOR CAR CORP."
STOCK.NAME$(13)="TREE FROG BREWERY"
STOCK.NAME$(14)="WINNEMUCCA MUNI BONDS"
STOCK.NAME$(15)="U.S. ROBOTS AND MECHANICAL MEN, INC."
STOCK.NAME$(16)="BONDO CEMENT CONTRACTORS"
ABBR$(01)="HIGH"
ABBR$(02)="LAND"
ABBR$(03)="CANDY"
ABBR$(04)="GENTLE"
ABBR$(05)="BIKE"
ABBR$(06)="BITE"
ABBR$(07)="SHOE"
ABBR$(08)="BUCK"
ABBR$(09)="OIL"
ABBR$(10)="INVEST"
ABBR$(11)="ALARM"
ABBR$(12)="STUDE"
ABBR$(13)="BREW"
ABBR$(14)="MUNI"
ABBR$(15)="ROBOTS"
ABBR$(16)="CEMENT"
FLUCT(01)=0.25
FLUCT(02)=2.5
FLUCT(03)=1.75
FLUCT(04)=1.0
FLUCT(05)=1.25
FLUCT(06)=2.25
FLUCT(07)=2.5
FLUCT(08)=1.75
FLUCT(09)=0.75
FLUCT(10)=2.0
FLUCT(11)=1.0
FLUCT(12)=0.5
FLUCT(13)=2.25
FLUCT(14)=1.75
FLUCT(15)=1.25
FLUCT(16)=1.5
DIV.FACTOR(01)=20
DIV.FACTOR(02)=60
DIV.FACTOR(03)=50
DIV.FACTOR(04)=35
DIV.FACTOR(05)=40
DIV.FACTOR(06)=55
DIV.FACTOR(07)=60
DIV.FACTOR(08)=50
DIV.FACTOR(09)=30
DIV.FACTOR(10)=53
DIV.FACTOR(11)=29
DIV.FACTOR(12)=45
DIV.FACTOR(13)=38
DIV.FACTOR(14)=50
DIV.FACTOR(15)=22
DIV.FACTOR(16)=30
PRINT TAB(10);"B L A C K F R I D A Y"
PRINT TAB(10);"------------------------------------"
PRINT
PRINT
10 PRINT "WANT INSTRUCTIONS (Y OR N)";
INPUT ANS$
IF LEFT$(ANS$,1)="Y" THEN \
GOSUB 9000 :\
GOTO 20
IF LEFT$(ANS$,1)<>"N" THEN \
PRINT "WHAT DID YOU SAY ?" :\
GOTO 10
20 REM
PRINT "ENTER NUMBER OF PLAYERS (1 TO 4) ";
INPUT NO.OF.PLAYERS
IF NO.OF.PLAYERS<1 OR NO.OF.PLAYERS>4 THEN \
PRINT "ONLY 1, 2, 3 OR 4 CAN PLAY" :\
GOTO 20
FOR X=1 TO NO.OF.PLAYERS
PRINT
PRINT "PLAYER #";X;", ENTER YOUR NAME (8 CHARS) ";
INPUT PLAYER.NAME$(X)
PLAYER.NAME$(X)=LEFT$(PLAYER.NAME$(X),8)
NEXT X
RANDOMIZE
40 REM
PRINT "ENTER NUMBER OF YEARS (3 TO 50) ";
INPUT NO.OF.YEARS
IF NO.OF.YEARS<3 OR NO.OF.YEARS>50 THEN \
PRINT "ANYWHERE FROM THREE TO FIFTY ONLY" :\
GOTO 40
FOR X=1 TO 4
CASH(X)=5000 REM STARTING DOLLARS
DIVIDENDS(X)=0 REM ZERO DIVIDENDS
FOR Y=1 TO 10
PORTFOLIOS(X,Y)=0 REM NO STOCKS TO START
NEXT Y
NEXT X
FOR X=1 TO 10
STOCK.PRICE(X)=INT((16*RND)+92)
NEXT X
PRINT TAB(10);"HERE ARE THE STOCKS CURRENTLY TRADED ON THE"
PRINT TAB(10);" -----BIG BOARD-----"
PRINT
PRINT TAB(15);"STOCK NAME";TAB(40);"ABBR"
PRINT
GOSUB 7100
REM-----------FOR / NEXT LOOP--------------------------------
FOR YEAR=1 TO NO.OF.YEARS
GOSUB 2000 REM CALC NEW MARKET
IF YEAR<NO.OF.YEARS THEN \
GOSUB 1000 REM BUY AND SELL
NEXT YEAR
GOSUB 3000 REM END OF GAME
STOP
2000 REM-----NEW YEAR ON THE MARKET-----------------------
ELAPSED.YEARS=ELAPSED.YEARS+1
IF ELAPSED.YEARS>LENGTH.OF.TREND THEN \
GOSUB 100 REM CALC NEW TREND
FOR X=1 TO 10
CHANGE=FN.CHANGE REM CHANGE FUNCTION
IF CHANGE>15 THEN \
CHANGE=15
IF RND>.5 THEN \
CHANGE=0-CHANGE REM 50/50 IT'S MINUS
NET.CHANGE(X)=INT((CHANGE*FLUCT(X))+BIAS)
STOCK.PRICE(X)=STOCK.PRICE(X)+NET.CHANGE(X)
NEXT X
GOSUB 600 REM CALC DOW JONES
FOR X=1 TO 10
IF STOCK.PRICE(X)>=150 THEN \
GOSUB 200 REM STOCK SPLITS
IF STOCK.PRICE(X)<=0 THEN \
GOSUB 300 REM STOCK BANKRUPTS
NEXT X
FOR X=1 TO 10
YEAR.DIV(X)=INT(STOCK.PRICE(X)/DIV.FACTOR(X))
FOR Y=1 TO NO.OF.PLAYERS
DIVIDENDS(Y)=DIVIDENDS(Y)+YEAR.DIV(X)*PORTFOLIOS(Y,X)
NEXT Y
NEXT X
PRINT
PRINT
PRINT TAB(20);"--------- YEAR ";YEAR;"---------"
PRINT TAB(20);"DOW JONES INDUSTRIAL AVERAGE ";Q$;" ";DIFF;
PRINT "TO ";DOW.JONES
PRINT "STOCK NET CURRENT DIV- P O R T F O L I O S"
PRINT "ABBR. CHANGE PRICE IDEND"
FOR X=1 TO NO.OF.PLAYERS
PRINT TAB((X-1)*9+37);PLAYER.NAME$(X);
NEXT X
PRINT " "
FOR X=1 TO 10
PRINT ABBR$(X);TAB(12);NET.CHANGE(X);TAB(20);
PRINT STOCK.PRICE(X);
PRINT TAB(30);YEAR.DIV(X);
FOR Y=1 TO NO.OF.PLAYERS
PRINT TAB((Y-1)*9+42);PORTFOLIOS(Y,X);
NEXT Y
PRINT " "
NEXT X
PRINT "DIVIDENDS FOR THE YEAR:";
FOR X=1 TO NO.OF.PLAYERS
PRINT TAB((X-1)*9+42);DIVIDENDS(X);
NEXT X
PRINT " "
FOR X=1 TO NO.OF.PLAYERS
PRINT TAB((X-1)*9+42);"______";
NEXT X
PRINT " "
PRINT "PLAYERS NEW CASH TOTAL:";
FOR X=1 TO NO.OF.PLAYERS
CASH(X)=CASH(X)+DIVIDENDS(X)
PRINT TAB((X-1)*9+42);CASH(X);
NEXT X
PRINT " "
FOR X=1 TO NO.OF.PLAYERS
DIVIDENDS(X)=0
NEXT X
RETURN
1000 REM--------B U Y A N D S E L L---------------
FOR X=1 TO NO.OF.PLAYERS
PRINT
PRINT TAB(10);"-----> PLAYER ";PLAYER.NAME$(X);
PRINT " YOU NOW HAVE $";CASH(X)
PRINT
OWNER.FLAG=0
FOR Y=1 TO 10
IF PORTFOLIOS(X,Y)>0 THEN \
OWNER.FLAG=1
NEXT Y
IF OWNER.FLAG=1 THEN \
GOSUB 5000 REM SELL RTN
OWNER.FLAG=0
FOR Y=1 TO 10
IF CASH(X)>=STOCK.PRICE(Y) THEN \
OWNER.FLAG=1
NEXT Y
IF OWNER.FLAG=1 THEN \
GOSUB 6000 REM BUY RTN
NEXT X
RETURN
3000 REM-------E N D O F G A M E-------------------
FOR X=1 TO NO.OF.PLAYERS
GOSUB 700 REM LIQUIDATE
NEXT X
GOSUB 750 REM GET WINNER
PRINT
PRINT
PRINT TAB(10);"HERE IS THE FINAL ACCOUNTING AFTER ";YEAR-1;"YEARS"
PRINT
PRINT
FOR X=1 TO NO.OF.PLAYERS
IF X=WINNER THEN \
WINNER$=CHR$(7)+"WINNER!" :\
ELSE \
WINNER$=""
PRINT TAB(14);PLAYER.NAME$(X);TAB(30);"$";CASH(X);TAB(45);
PRINT WINNER$
NEXT X
PRINT
PRINT TAB(10);"-----------------------------------------"
PRINT
RETURN
700 REM-----LIQUIDATE---------------------------------------
FOR Y=1 TO 10
CASH(X)=CASH(X)+STOCK.PRICE(Y)*PORTFOLIOS(X,Y)
NEXT Y
RETURN
750 REM-----FIND THE WINNER----------------------------------
HIGHEST=0
FOR X=1 TO NO.OF.PLAYERS
IF CASH(X)>HIGHEST THEN \
WINNER=X :\
HIGHEST=CASH(X)
NEXT X
RETURN
REM-------------SUBROUTINES-----------------------------
100 REM-----CALCULATE NEW TREND-----------------------------
LENGTH.OF.TREND=INT(FN.CHANGE)
IF LENGTH.OF.TREND>7 THEN \
LENGTH.OF.TREND=7
ELAPSED.YEARS=0
BIAS=INT(FN.CHANGE)
IF BIAS>7 THEN \
BIAS=7
IF RND>.5 THEN \
BIAS=0-BIAS
PRINT "LENGTH=";LENGTH.OF.TREND;" BIAS=";BIAS
RETURN
200 REM-----STOCK SPLIT-------------------------------------
PRINT
PRINT STOCK.NAME$(X);" STOCK SPLIT"
STOCK.PRICE(X)=75
NET.CHANGE(X)=0
FOR Q=1 TO NO.OF.PLAYERS
PORTFOLIOS(Q,X)=PORTFOLIOS(Q,X)*2
NEXT Q
RETURN
300 REM-----BANKRUPT----------------------------------------
PRINT
PRINT STOCK.NAME$(X);" WENT BANKRUPT"
PRINT "ALL HOLDINGS ARE LIQUIDATED AT $1 PER SHARE"
PRINT "A NEW STOCK WILL TAKE ITS PLACE ON THE 'BIG BOARD'"
PRINT
NEW.STOCK=NEW.STOCK+1
IF NEW.STOCK>=17 THEN \
PRINT "CROAK - GAME OVER" :\
YEAR=10000 :\ REM FORCE END OF GAME
RETURN
STOCK.NAME$(X)=STOCK.NAME$(NEW.STOCK)
340 ABBR$(X)=ABBR$(NEW.STOCK)
PRINT "THE NEW STOCK IS: ";STOCK.NAME$(X)
PRINT "ITS ABBREVIATION IS: ";ABBR$(X)
STOCK.PRICE(X)=INT((16*RND)+92)
PRINT "ITS STARTING PRICE IS: $";STOCK.PRICE(X)
NET.CHANGE(X)=0
FOR Q=1 TO NO.OF.PLAYERS
CASH(Q)=CASH(Q)+PORTFOLIOS(Q,X)
PORTFOLIOS(Q,X)=0
NEXT Q
RETURN
5000 REM-----S E L L---------------------------------------
PRINT TAB(10);"DO YOU WISH TO SELL ANY STOCKS ";
INPUT ANS$
IF LEFT$(ANS$,1)="N" THEN \
RETURN
IF LEFT$(ANS$,1)<>"Y" THEN \
GOTO 5000
PRINT TAB(10);"STOCK ";
INPUT STOCK$
GOSUB 7000 REM RECOGNIZE STOCK NAME
5100 REM
PRINT TAB(10);"HOW MANY SELLING ";
INPUT SELL
IF SELL<=0 THEN \
GOTO 5000
IF SELL>PORTFOLIOS(X,N) THEN \
PRINT TAB(10);"YOU ONLY HAVE ";PORTFOLIOS(X,N);"SHARES" :\
GOTO 5100
PORTFOLIOS(X,N)=PORTFOLIOS(X,N)-SELL
RESALE=SELL*STOCK.PRICE(N)
PRINT TAB(10);"RESALE VALUE OF $";RESALE
CASH(X)=CASH(X)+RESALE
GOTO 5000
6000 REM-----B U Y----------------------------------------------
PRINT TAB(10);"DO YOU WISH TO BUY ANY STOCKS ";
INPUT ANS$
IF LEFT$(ANS$,1)="N" THEN \
RETURN
IF LEFT$(ANS$,1)<>"Y" THEN \
GOTO 6000
PRINT TAB(10);"STOCK ";
INPUT STOCK$
GOSUB 7000 REM RECOGINIZE STOCK NAME
6100 REM
PRINT TAB(10);"HOW MANY BUYING ";
INPUT BUY
IF BUY<=0 THEN \
GOTO 6000
IF BUY*STOCK.PRICE(N)>CASH(X) THEN \
PRINT TAB(10);"YOU ONLY HAVE $";CASH(X) :\
PRINT TAB(10);"THAT'S ENOUGH FOR "; :\
PRINT INT(CASH(X)/STOCK.PRICE(N));"SHARES" :\
GOTO 6100
COST=BUY*STOCK.PRICE(N)
PRINT TAB(10);"THAT COST $";COST
CASH(X)=CASH(X)-COST
PORTFOLIOS(X,N)=PORTFOLIOS(X,N)+BUY
GOTO 6000
7000 REM-----FIND STOCK NAME--------------------------------
FOR N=1 TO 10
IF STOCK$=ABBR$(N) THEN \
RETURN
NEXT N
PRINT TAB(10);"THAT STOCK IS NOT TRADED ON THE 'BIG BOARD'"
PRINT TAB(10);"THESE ARE THE CURRENT STOCKS:"
PRINT
GOSUB 7100 REM PRINT STOCK NAMES AND ABBR
PRINT
PRINT TAB(10);"STOCK ";
INPUT STOCK$
GOTO 7000
7100 REM-----PRINT THE STOCK NAMES AND ABBR------------
PRINT
FOR M=1 TO 10
PRINT STOCK.NAME$(M);TAB(40);ABBR$(M)
NEXT M
RETURN
600 REM-----CALCULATE DOW JONES AVERAGE--------------
TOTAL.PRICE=0
FOR X=1 TO 10
TOTAL.PRICE=TOTAL.PRICE+STOCK.PRICE(X)
NEXT X
OLD.DOW.JONES=DOW.JONES
DOW.JONES=TOTAL.PRICE
DIFF=OLD.DOW.JONES-DOW.JONES
IF DIFF>=0 THEN \
Q$="DOWN" :\
ELSE \
Q$="UP"
DIFF=ABS(DIFF)
RETURN
9000 REM-----I N S T R U C T I O N S-------------------
RETURN