Compucolor.org – Virtual Media

Listing of file='STOCKM.BAS;01' on disk='vmedia/ncc_8_real-sector.ccvf'

1 REM    STOCK MARKET SIMULATION               JUNE 1980
2 REM
3 REM    PLAY THE STOCK MARKET WITH TRUE-TO-LIFE RULES
4 REM
5 REM    16K COMPUCOLOR II
6 REM
10 REM     ORIGINAL PROGRAM DEVELOPED FOR THE
11 REM     HUNTINGTON SIMULATION PROJECT, SUNY
12 REM     STONEYBROOK, NEW YORK
13 REM     CREATED BY B.PESSEL, L.BRAUN, C. LOSIK
14 REM      THIS ADAPTATION BY M.FITTING
15 REM     VARIATIONS HAVE BEEN PRINTED IN
16 REM     BASIC COMPUTER GAMES, MICROCOMPUTER EDITION
17 REM      BY DAVID H. AHL
18 REM     STEVE NORMS CONVERTED THE PROGRAM FOR CREATIVE
19 REM     COMPUTING PRESS,  MORRISTOWN, NEW JERSEY  AND
20 REM     OCCURRED ON PP154-156, CREATIVE COMPUTING, 1978

21 REM "______________________________"
22 REM "!       SAN MATEO COUNTY      !"
23 REM "!     OFFICE OF EDUCATION     !"
24 REM "!             &               !"
25 REM "!  COMPUTER-USING EDUCATORS   !"
26 REM "!                             !"
27 REM "!          SOFTSWAP           !"
28 REM "!                             !"
29 REM "!333 MAIN STREET, REDWOOD CITY!"
30 REM "!CA 94063 (415)364-5600 EX4401!"
31 REM "_______________________________"
40 REM "_______________________________"
41 REM "! PROGRAMS MAY BE COPIED FOR  !"
42 REM "! EDUCATIONAL USE ONLY AND    !"
43 REM "! ARE NOT TO BE SOLD.         !"
44 REM "!!"
50 REM
51 REM   SINGLE USER BUYS AND SELLS STOCK IN A RANDOM MARKET
52 REM   MARKET TRENDS ARE BUILT IN AS ARE RANDOM DEVIATIONS
53 REM   FROM THE TREND AND RARE UNUSUAL OCCURRENCES
54 REM   DIVIDENDS ARE PAID QUARTERLY, BROKERS FEES ARE CHARGED
55 REM
57 REM    SUMMARY PROVIDES TOTAL PROFIT(LOSS), STATE OF CA TAX,
58 REM    FEDERAL TAXES, AND  RETURN ON  INVESTMENT.
60 REM
100 PRINT CHR$ (12)
110 PRINT TAB( 25);"STOCK MARKET"
120 IF P8* P9= 12THEN 3370
130 PRINT :PRINT :PRINT
140 PRINT "HI. I'M YOUR LOCAL STOCK BROKER.  I'LL BE HAPPY TO "
150 PRINT "OPEN AN ACCOUNT FOR YOU.  "
160 PRINT :INPUT "WHAT IS YOUR NAME? ";N$
170 X= LEN (N$)
180 PRINT :PRINT "DO YOU HAVE A FAVORITE NUMBER THAT I CAN USE FOR YOUR ACCOUNT?"
190 PRINT :PRINT "PLEASE TYPE ONLY NUMERICAL CHARACTERS, NO , OR - OR OTHER."
200 PRINT "          ";:INPUT Y
210 Y1= INT (Y/ 10):Y2= Y- 10* Y1
220 FOR F= 1TO Y2:Y1= RND (X):NEXT F
230 DIM S(5),P(5),Z(5),C(5)
240 T5= 0:X9= 0:N1= 0:N2= 0:E1= 0:E2= 0
250 D6= 0:K3= 1:X9= 0
260 FOR F= 1TO 5:P(F)= 0:Z(F)= 0:NEXT F
270 C= 10000
280 PRINT "DO YOU WANT THE INSTRUCTIONS? (YES OR NO) "
290 INPUT Y$
300 PRINT CHR$ (12)
310 IF Y$< "Y"THEN 480
320 REM  ***************INSTRUCTIONS******************
330 PRINT "       THIS PROGRAM PLAYS THE STOCK MARKET."
340 PRINT "YOU WILL BE GIVEN $10,000 AND MAY BUY OR SELL STOCKS."
350 PRINT "THE STOCK PRICES WILL GO UP AND DOWN RANDOMLY AND"
360 PRINT "THEREFORE, THIS MODEL DOES NOT REPRESENT EXACTLY WHAT"
370 PRINT "HAPPENS ON THE EXCHANGES."
380 PRINT :PRINT "A TABLE OF AVAILABLE STOCKS, THEIR PRICES, AND THE NUMBER OF"
390 PRINT "SHARES IN YOUR PORTFOLIO WILL BE PRESENTED."
400 PRINT "FOLLOWING THIS, INITIALS OF EACH STOCK WILL BE PRESENTED "
410 PRINT "WITH A QUESTION MARK.":PRINT
420 PRINT :PRINT "TO BUY A STOCK, TYPE +NNN,     WHERE NNN IS THE NUMBER"
430 PRINT "                               OF SHARES YOU WISH TO BUY."
440 PRINT "TO SELL A STOCK, TYPE -NNN."
450 PRINT
460 PRINT :PRINT "A BROKERAGE FEE OF 2% WILL BE CHARGED ON ALL TRANSACTIONS."
470 PRINT :PRINT :PRINT :PRINT :INPUT "PRESS <RETURN> WHEN READY TO CONTINUE.";Y$
480 PRINT CHR$ (12)
490 PRINT "TO GET A FEEL FOR THE MARKET,"
500 PRINT "RUN THE PROGRAM FOR AT LEAST FIFTEEN WEEKS.":PRINT :PRINT
510 REM  ********  INITIAL STOCK VALUES  ****************
520 FOR I= 1TO 5
530 B= INT (RND (Y)* 100+ 10)
540 S(I)= B
550 NEXT I
560 REM  ********  A  IS SLOPE OF MARKETTREND
570 REM            SAME FOR ALL STOCKS ***************
580 A= INT (10* RND (X)+ .5)/ 100
590 REM  ********  T8 IS INITIAL NUMBER OF DAYS FOR
600 REM            FIRST TREND************************
610 T8= INT (4.99* RND (X)+ 1)
620 IF A< .06THEN 660
630 A= A- .11
640 PRINT "THE GENERAL MARKET TREND HAS BEEN DOWN THE LAST FEW DAYS."
650 GOTO 680
660 PRINT "THE GENERAL MARKET TREND HAS BEEN UP FOR THE LAST"
670 PRINT "FEW DAYS.":PRINT
680 PRINT "YOU HAVE $10,000 TO INVEST.  USE INTEGERS FOR ALL YOUR"
690 PRINT "TRANSACTIONS.  DO NOT USE $ OR , WHEN YOU TYPE THE NUMBERS.":PRINT
700 FOR F= 1TO 2000:NEXT F
710 GOSUB 1370
720 GOSUB 1470
730 GOSUB 2160
740 GOTO 2490
750 GOSUB 2030
760 D= T+ C
770 IF X9> 0THEN 810
780 PRINT "COMPUTER STOCK EXCHANGE AVERAGE: ";Z5
790 X9= 1
800 GOTO 820
810 PRINT "COMPUTER STOCK EXCHANGE AVERAGE: ";Z5;"; NET CHANGE: ";Z6
820 PRINT
830 T= INT (100* T+ .5)/ 100
840 PRINT "TOTAL STOCK ASSETS ARE $";T
850 C= INT (100* C+ .5)/ 100
860 PRINT "TOTAL CASH ASSETS ARE $";C
870 D= INT (100* D+ .5)/ 100
880 PRINT "TOTAL ASSETS ARE $";D
890 PRINT
900 GOTO 3300
910 IF D6< 12THEN 980
920 IF D6< 15THEN 970
930 PRINT "DO YOU WISH TO CONTINUE? (YES OR NO)"
940 INPUT Y$
950 IF Y$= "NO"OR Y$= "N"THEN 1050
960 GOTO 980
970 PRINT :PRINT :INPUT "PRESS <RETURN> TO CONTINUE.";Y$
980 K1= INT (D6/ 12):K2= D6- K1* 12
990 IF D6< 12THEN GOTO 730
1000 IF K2> 4THEN GOTO 730
1010 IF K3= 1THEN GOTO 1030
1020 K3= 1:GOTO 730
1030 ON K2+ 1GOTO 2690,2800,2910,730,3040
1040 GOTO 730
1050 PRINT CHR$ (12)
1060 PRINT "YOU HAVE EARNED A TOTAL OF ";Q;" IN DIVIDENDS"
1070 PRINT "OVER A PERIOD OF ";D6;" WEEKS WHICH IS A "
1080 PRINT "RATE OF RETURN OF ";INT (Q* 5.2/ D6+ .5)/ 10;"%."
1090 PRINT :PRINT "IF YOU ARE A SINGLE WAGE EARNER MAKING AN ANNUAL WAGE OF $15000"
1100 PRINT "AFTER EXEMPTIONS AND DEDUCTIONS, THEN THE TAXES DUE ON THESE"
1110 PRINT "DIVIDENDS ARE APPROXIMATELY "
1120 PRINT :PRINT "     STATE OF CALIFORNIA   $  ";
1130 T1= INT (9* Q+ .5)/ 100:PRINT T1
1140 PRINT "     U.S.INTERNAL REVENUE     ";
1150 T2= INT (30* (Q- T1)+ .5)/ 100:PRINT T2
1160 PRINT :PRINT
1170 C1= INT (100* (D- Q- 10000)+ .5)/ 100
1180 PRINT :PRINT :PRINT :PRINT "PRESS <RETURN> WHEN READY."
1190 INPUT Y$
1200 PRINT "YOU HAVE USED 10000 FOR ";D6;" WEEKS."
1210 PRINT "YOUR EARNINGS ON THIS MONEY ARE ";C1;"."
1220 PRINT "THIS IS A RATE OF RETURN OF ";INT (C1* 5.2/ D6+ .5)/ 10;"%."
1230 PRINT :PRINT "THE TAXES ON THIS AMOUNT OF CAPITAL GAINS ARE APPROXIMATELY"
1240 PRINT :PRINT "     STATE OF CALIFORNIA    $  ";
1250 T3= INT (9* C1+ .5)/ 100:PRINT T3
1260 PRINT "     U.S.INTERNAL REVENUE      ";
1270 T4= INT (30* (C1- T3)+ .5)/ 100:PRINT T4
1280 PRINT :PRINT "THIS ASSUMES THAT NO STOCKS WERE HELD OVER SIX MONTHS."
1290 PRINT
1300 PRINT "YOUR TOTAL EARNINGS WERE $ ";D- 10000
1310 PRINT :PRINT "YOUR TOTAL EARNINGS AFTER TAXES WERE $ ";
1320 C2= D- 10000- T1- T2- T3- T4
1330 PRINT INT (C2* 100+ .5)/ 100
1340 PRINT :PRINT "THIS IS A RATE OF RETURN OF ";INT (C2* 5.2/ D6+ .5)/ 10;"%."
1350 PRINT "HOPE YOU HAD FUN!"
1355 PRINT :PRINT :PRINT :PRINT
1360 INPUT "PRESS <RETURN> TO SEE ORIGINAL DIRECTORY ";Y$
1365 LOAD "MENU":RUN
1368 END
1370 REM  SUBROUTINE TO PRINT STOCK NAMES
1380 PRINT ,"STOCK",,,"INITIALS"
1390 PRINT
1400 PRINT "INT. BALLISTIC MISSILES ","IBM"
1410 PRINT "GENEROUS MINICOMPUTERS",,"GM"
1420 PRINT "RECTANGULAR COMPONENTS ASSN.","RCA"
1430 PRINT "CORN BALL SOUNDS",,"CBS"
1440 PRINT "EVERLASTING POLITICAL ASSN.","EPA"
1450 PRINT :PRINT
1460 RETURN
1470 PRINT ,"STOCK",,"PRICE/SHARE":PRINT
1480 PRINT ,"IBM",,S(1)
1490 PRINT ,"GM",,S(2)
1500 PRINT ,"RCA",,S(3)
1510 PRINT ,"CBS",,S(4)
1520 PRINT ,"EPA",,S(5)
1530 PRINT
1540 RETURN
1550 REM  *****SUBROUTINE TO COMPUTE STOCK VALUES :::::
1560 REM    N1 AND N2 ARE NUMBERS OF DAYS
1570 IF N1> 0THEN 1610
1580 I1= INT (4.99* RND (X)+ 1)
1590 N1= INT (4.99* RND (X)+ 1)
1600 E1= 1
1610 IF N2> 0THEN 1650
1620 I2= INT (4.99* RND (X)+ 1)
1630 N2= INT (4.99* RND (X)+ 1)
1640 E2= 1
1650 N1= N1- 1:N2= N2- 1
1660 REM  *****LOOP THROUGH ALL STOCKS ******
1670 FOR I= 1TO 5
1680 X1= RND (X)
1690 IF X1> .25THEN 1720
1700 X1= .25
1710 GOTO 1780
1720 IF X1> .50THEN 1750
1730 X1= .50
1740 GOTO 1780
1750 IF X1> .75THEN 1770
1760 GOTO 1780
1770 X1= 0.0
1780 W3= 0
1790 IF E1< 1THEN 1850
1800 IF INT (I1+ .5)< > INT (I+ .5)THEN 1850
1810 W3= 2:E1= 0
1820 IF E2< 1THEN 1850
1830 IF INT (I2+ .5)< > INT (I+ .5)THEN 1850
1840 W3= - 2:E2= 0
1850 REM  **** C(I) IS CHANGE IN STOCK VALUE ***********
1860 C(I)= X1* A* S(I)+ W3+ A* INT (3- 6* RND (X)+ .5)/ 8
1870 C(I)= INT (8* C(I)+ .5)/ 8
1880 S(I)= S(I)+ C(I)
1890 IF S(I)> 0THEN 1920
1900 S(I)= S(I)- C(I)
1910 LETC(I)= 0
1920 S(I)= INT (8* S(I)+ .5)/ 8
1930 NEXT I
1940 REM  ********AFTER T8 DAYS CHANGE THE TREND *****
1950 T8= T8- 1
1960 IF T8< 1THEN 1980
1970 RETURN
1980 T8= INT (4.99* RND (X)+ 1)
1990 A= INT (RND (X)* 10+ .5)/ 100
2000 IF A< .06THEN 2020
2010 A= A- .1
2020 RETURN
2030 REM  ***** SUBROUTINE TO COMPUTE AVERAGES *********
2040 REM   NYSE AVERAGE Z5;TEMP VALUE Z4;NET CHANGE Z6
2050 Z4= Z5
2060 Z5= 0
2070 T= 0
2080 FOR I= 1TO 5
2090 Z5= Z5+ S(I)
2100 T= T+ S(I)* P(I)
2110 NEXT I
2120 Z5= INT (100* (Z5/ 5)+ .5)/ 100
2130 Z6= INT ((Z5- Z4)* 100+ .5)/ 100
2140 RETURN
2150 PRINT "
2160 REM  SUBROUTINE TO INPUT TRANSACTIONS
2170 PRINT "WHAT IS YOUR TRANSACTION IN (TYPE NUMBER OF SHARES) "
2180 INPUT "        IBM   ";Z(1)
2190 INPUT "        GM    ";Z(2)
2200 INPUT "        RCA   ";Z(3)
2210 INPUT "        CBS   ";Z(4)
2220 INPUT "        EPA   ";Z(5)
2230 PRINT :PRINT
2240 REM  TOTAL DAY'S PURCHASES IN  $:P5
2250 P5= 0
2260 REM  TOTAL DAY'S SALES IN   $: S5
2270 S5= 0
2280 FOR I= 1TO 5
2290 LETZ(I)= INT (Z(I)+ .5)
2300 IF Z(I)< = 0THEN 2330
2310 P5= P5+ Z(I)* S(I)
2320 GOTO 2370
2330 S5= S5- Z(I)* S(I)
2340 IF - Z(I)< = P(I)THEN 2370
2350 PRINT "YOU HAVE OVERSOLD A STOCK; TRY AGAIN."
2360 GOTO 2160
2370 NEXT I
2380 REM  :::::TOTAL VALUE OF TRANSACTION :::::T5
2390 T5= P5+ S5
2400 REM  ******BROKERAGE FEE:**********
2410 B5= INT (2* T5+ .5)/ 100
2420 C5= C- P5- B5+ S5
2430 IF C5> = 0THEN 2470
2440 C6= INT (100* - C5+ .5)/ 100
2450 PRINT "YOU HAVE USED $ ";C6;" MORE THAN YOU HAVE."
2460 GOTO 2160
2470 C= INT (100* C5+ .5)/ 100
2480 RETURN
2490 REM  ***** SUBROUTINE TO CALCULATE NEW PORTFOLIO **
2500 FOR I= 1TO 5
2510 P(I)= P(I)+ Z(I)
2520 NEXT I
2530 GOSUB 1550
2540 PRINT CHR$ (12)
2550 D6= D6+ 1
2560 PRINT "    ******   END OF TRADING, WEEK ";D6;"   ******"
2570 FOR F= 1TO 200:NEXT F
2580 PRINT
2590 PRINT "STOCK","PRICE/SHARE","HOLDINGS","NET VALUE","CHANGE"
2600 PRINT :PRINT ""
2610 PRINT :PRINT "IBM",S(1);TAB( 24);P(1);TAB( 40);INT (S(1)* P(1)* 100+ .5)/ 100;TAB( 56);C(1)
2620 PRINT "GM",S(2);TAB( 24);P(2);TAB( 40);INT (S(2)* P(2)* 100+ .5)/ 100;TAB( 56);C(2)
2630 PRINT "RCA",S(3);TAB( 24);P(3);TAB( 40);INT (S(3)* P(3)* 100+ .5)/ 100;TAB( 56);C(3)
2640 PRINT "CBS",S(4);TAB( 24);P(4);TAB( 40);INT (S(4)* P(4)* 100+ .5)/ 100;TAB( 56);C(4)
2650 PRINT "EPA",S(5);TAB( 24);P(5);TAB( 40);INT (S(5)* P(5)* 100+ .5)/ 100;TAB( 56);C(5)
2660 PRINT ""
2670 PRINT
2680 GOTO 750
2690 REM  *********DIVIDEND TIME ************************
2700 Q(2)= INT (22* S(2)+ .5)/ 1000
2710 S(2)= S(2)- 1:C(2)= - 1
2720 FOR F= 1TO 5
2730 IF F< > 2THEN C(F)= 0
2740 NEXT F
2750 K3= 0
2760 PRINT "GM HAS JUST PAID A DIVIDEND OF ";Q(2);" PER SHARE."
2770 Q5= INT (100* Q(2)* P(2)+ .5)/ 100:C= C+ Q5:Q= Q+ Q5
2780 PRINT :PRINT
2790 GOTO 2590
2800 K4= INT (10* RND (X)+ .5)
2810 IF K4< 5THEN 2880
2820 PRINT "EPA HAS DECIDED TO ISSUE A DIVIDEND OF 12.5 CENTS PER SHARE."
2830 Q5= INT (12.5* P(2)+ .5)/ 100
2840 C= C+ Q5:Q= Q+ Q5
2850 FOR F= 1TO 5:C(F)= 0:NEXT F
2860 K3= 0
2870 GOTO 2590
2880 PRINT "EPA HAS DECIDED NOT TO ISSUE A DIVIDEND THIS QUARTER DUE TO     SAGGING PROFITS."
2890 PRINT :PRINT
2900 GOTO 730
2910 Q(4)= INT (9* S(2)+ .5)/ 1000
2920 S(4)= S(4)- .5:C(4)= - .5
2930 Q(3)= INT (7* S(2)+ .5)/ 1000
2940 S(3)= S(3)- .25:C(3)= - .25
2950 C(1)= 0:C(2)= 0:C(5)= 0
2960 K3= 0
2970 PRINT "RCA PAYS A DIVIDEND OF ";Q(3);" PER SHARE."
2980 PRINT "CBS PAYS A DIVIDEND OF ";Q(4);" PER SHARE."
2990 Q5= INT (100* Q(4)* P(4)+ .5)/ 100+ INT (100* Q(3)* P(3)+ .5)/ 100
3000 C= C+ Q5:Q= Q+ Q5
3010 PRINT :PRINT
3020 K3= 0
3030 GOTO 2590
3040 K2= RND (Y)
3050 IF K2< .2THEN GOTO 3150
3060 IF K2> .9THEN GOTO 3230
3070 Q(1)= INT (15* S(1)+ .5)/ 1000
3080 S(1)= S(1)- .625:C(1)= - .625
3090 FOR F= 2TO 5:C(F)= 0:NEXT F
3100 PRINT "IBM PAYS A QUARTERLY DIVIDEND OF ";Q(1);" PER SHARE."
3110 Q5= INT (100* Q(1)* P(1)+ .5)/ 100
3120 C= C+ Q5:Q= Q+ Q5
3130 K3= 0
3140 GOTO 2590
3150 PRINT "DUE TO A STRIKE AT IBM, THE QUARTERLY DIVIDEND IS REDUCED TO"
3160 PRINT ".10 PER SHARE."
3170 FOR F= 2TO 5:C(F)= 0:NEXT F
3180 Q5= INT (10* P(1)+ .5)/ 100
3190 C= C+ Q5:Q= Q+ Q5
3200 C(1)= - 3:S(1)= S(1)- 3
3210 K3= 0
3220 GOTO 2590
3230 PRINT "PROFITS AT IBM ARE UP THIS QUARTER AND SHAREHOLDERS ARE PAID"
3240 PRINT "A SPECIAL DIVIDEND THIS QUARTER OF .50 PER SHARE."
3250 S(1)= S(1)+ 2:C(1)= 2
3260 FOR F= 2TO 5:C(F)= 0:NEXT F
3270 Q5= INT (50* P(1)+ .5)/ 100:C= C+ Q5:Q= Q+ Q5
3280 K3= 0
3290 PRINT :PRINT :GOTO 2590
3300 P8= INT (RND (X)* 10+ .5)
3310 IF K5= 1THEN GOTO 3350
3320 IF P8* K2= 56THEN 3370
3330 IF PI* K2= 20THEN 3470
3340 IF P8* K2= 24THEN 3580
3350 K5= 0
3360 GOTO 910
3370 PRINT "THE COUNTRY OF DAI BAJAR ORDERED MISSILES WHICH UTILIZED"
3380 PRINT "THE ENTIRE PLANT #1 OF THE TWO PLANTS OWNED BY IBM."
3390 PRINT "HOWEVER, THAT COUNTRY HAS JUST DECLARED BANKRUPTCY AND WILL"
3400 PRINT "NOT PAY FOR ITS ORDER."
3410 PRINT "IBM STOCK IS REVALUED AT 1/2 ITS ORIGINAL VALUE."
3420 K5= 1:FOR F= 1TO 3000:NEXT F
3430 S(1)= INT (50* S(1)+ .5)/ 100
3440 C(1)= - S(1)
3450 FOR F= 2TO 5:C(F)= 0:NEXT F
3460 GOTO 2590
3470 PRINT "THE EVERLASTING POLITICAL ASSOCIATION SPONSORED A MEASURE TO "
3480 PRINT "PROHIBIT BUILDING WITHIN 5 MILES OF AN AIRPORT."
3490 PRINT "THIS BILL WAS SOUNDLY DEFEATED SINCE THE AREA AROUND THE "
3500 PRINT "AIRPORT WAS THE ONLY FLAT LAND WITHIN 50 MILES."
3510 PRINT "DONATIONS TO THE EPA SLOWED TO A TRICKLE AND THE"
3520 PRINT "VALUE OF EPA STOCK DROPPED 20%."
3530 C(5)= INT (20* S(5)+ .5)/ 100* - 1
3540 S(5)= S(5)+ C(5)
3550 K5= 1:FOR F= 1TO 3000:NEXT F
3560 FOR F= 1TO 4:C(F)= 0:NEXT F
3570 GOTO 2590
3580 PRINT "GM WAS MAKING SO MUCH PROFIT DURING THE LAST QUARTER THAT "
3590 PRINT "ANOTHER COMPANY BEGAN MAKING SIMILAR MINICOMPUTERS AT A "
3600 PRINT "LOWER COST AND SELLING PRICE.  GM SALES HAVE PLUMMETED."
3610 PRINT "GM STOCK VALUE DECLINED 30%."
3620 K5= 1:FOR F= 1TO 3000:NEXT F
3630 C(2)= - INT (30* S(2)+ .5)/ 100
3640 S(2)= S(2)+ C(2)
3650 FOR F= 1TO 5
3660 IF F< > 2THEN C(F)= 0
3670 NEXT F
3680 GOTO 2590