home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug003.ark / BLKFRI.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  10.5 KB  |  441 lines
  1.     REM-----------------------------------------------------
  2.     REM        B L A C K F R I D A Y
  3.     REM-----------------------------------------------------
  4.  
  5.     REM            JUNE 14, 1977
  6.  
  7.        DIM PLAYER.NAME$(4)
  8.     DIM STOCK.NAME$(16)
  9.     DIM ABBR$(16)
  10.     DIM FLUCT(16)
  11.     DIM DIV.FACTOR(16)
  12.     DIM CASH(4)
  13.     DIM DIVIDENDS(4)
  14.     DIM PORTFOLIOS(4,10)
  15.     DIM STOCK.PRICE(10)
  16.     DIM NET.CHANGE(10)
  17.     NEW.STOCK=10
  18.     DIM YEAR.DIV(10)
  19.  
  20.        LET ESC$ = CHR$(27)
  21.        LET LOCK.ON$ = ESC$ + CHR$(108)
  22.        LET LOCK.OFF$ = ESC$ + CHR$(109)
  23.        LET CURSOR.UP$ = ESC$ + "A"
  24.        LET CURSOR.DN$ = ESC$ + "B"
  25.        LET CURSOR.RT$ = ESC$ + "C"
  26.        LET CURSOR.LT$ = ESC$ + "D"
  27.        LET ROLL.UP$ = ESC$ + "S"
  28.        LET ROLL.DN$ = ESC$ + "T"
  29.        LET DOW.JONES = 987
  30.        LET ELAPSED.YEARS = 0
  31.        LET LENGTH.OF.TREND = 0
  32.        DEF FN.CHANGE = (1/(1-(RND^2)))
  33.  
  34.     STOCK.NAME$(01)="HIGHWAY IMPROVEMENT BONDS"
  35.     STOCK.NAME$(02)="OLD WEST LAND CO."
  36.     STOCK.NAME$(03)="FINE AND DANDY CANDY CO."
  37.     STOCK.NAME$(04)="GENTLE TOUCH MASSAGE PARLORS, INC"
  38.     STOCK.NAME$(05)="SQUARE WHEEL BICYCLE CO."
  39.     STOCK.NAME$(06)="BITE SHOPS, INC."
  40.     STOCK.NAME$(07)="GOOD KARMA SHOE CO."
  41.     STOCK.NAME$(08)="MAKE-A-BUCK HOLDING CORP."
  42.     STOCK.NAME$(09)="SLIPPERY OIL COMPANY"
  43.     STOCK.NAME$(10)="CONSOLIDATED INVESTMENT CO."
  44.     STOCK.NAME$(11)="GUARD-ALL BURGLAR ALARM SYSTEMS"
  45.     STOCK.NAME$(12)="STUDEBAKER MOTOR CAR CORP."
  46.     STOCK.NAME$(13)="TREE FROG BREWERY"
  47.     STOCK.NAME$(14)="WINNEMUCCA MUNI BONDS"
  48.     STOCK.NAME$(15)="U.S. ROBOTS AND MECHANICAL MEN, INC."
  49.     STOCK.NAME$(16)="BONDO CEMENT CONTRACTORS"
  50.  
  51.     ABBR$(01)="HIGH"
  52.     ABBR$(02)="LAND"
  53.     ABBR$(03)="CANDY"
  54.     ABBR$(04)="GENTLE"
  55.     ABBR$(05)="BIKE"
  56.     ABBR$(06)="BITE"
  57.     ABBR$(07)="SHOE"
  58.     ABBR$(08)="BUCK"
  59.     ABBR$(09)="OIL"
  60.     ABBR$(10)="INVEST"
  61.     ABBR$(11)="ALARM"
  62.     ABBR$(12)="STUDE"
  63.     ABBR$(13)="BREW"
  64.     ABBR$(14)="MUNI"
  65.     ABBR$(15)="ROBOTS"
  66.     ABBR$(16)="CEMENT"
  67.  
  68.     FLUCT(01)=0.25
  69.     FLUCT(02)=2.5
  70.     FLUCT(03)=1.75
  71.     FLUCT(04)=1.0
  72.     FLUCT(05)=1.25
  73.     FLUCT(06)=2.25
  74.     FLUCT(07)=2.5
  75.     FLUCT(08)=1.75
  76.     FLUCT(09)=0.75
  77.     FLUCT(10)=2.0
  78.     FLUCT(11)=1.0
  79.     FLUCT(12)=0.5
  80.     FLUCT(13)=2.25
  81.     FLUCT(14)=1.75
  82.     FLUCT(15)=1.25
  83.     FLUCT(16)=1.5
  84.  
  85.     DIV.FACTOR(01)=20
  86.     DIV.FACTOR(02)=60
  87.     DIV.FACTOR(03)=50
  88.     DIV.FACTOR(04)=35
  89.     DIV.FACTOR(05)=40
  90.     DIV.FACTOR(06)=55
  91.     DIV.FACTOR(07)=60
  92.     DIV.FACTOR(08)=50
  93.     DIV.FACTOR(09)=30
  94.     DIV.FACTOR(10)=53
  95.     DIV.FACTOR(11)=29
  96.     DIV.FACTOR(12)=45
  97.     DIV.FACTOR(13)=38
  98.     DIV.FACTOR(14)=50
  99.     DIV.FACTOR(15)=22
  100.     DIV.FACTOR(16)=30
  101.  
  102.        PRINT TAB(10);"B  L  A  C  K       F  R  I  D  A  Y"
  103.        PRINT TAB(10);"------------------------------------"
  104.        PRINT
  105.        PRINT
  106.  
  107. 10    PRINT "WANT INSTRUCTIONS (Y OR N)";
  108.     INPUT ANS$
  109.     IF LEFT$(ANS$,1)="Y" THEN \
  110.         GOSUB 9000 :\
  111.         GOTO 20
  112.     IF LEFT$(ANS$,1)<>"N" THEN \
  113.         PRINT "WHAT DID YOU SAY ?" :\
  114.         GOTO 10
  115.  
  116. 20    REM
  117.     PRINT "ENTER NUMBER OF PLAYERS (1 TO 4) ";
  118.     INPUT NO.OF.PLAYERS
  119.     IF NO.OF.PLAYERS<1 OR NO.OF.PLAYERS>4 THEN \
  120.         PRINT "ONLY 1, 2, 3 OR 4 CAN PLAY" :\
  121.         GOTO 20
  122.     FOR X=1 TO NO.OF.PLAYERS
  123.         PRINT
  124.         PRINT "PLAYER #";X;", ENTER YOUR NAME (8 CHARS) ";
  125.         INPUT PLAYER.NAME$(X)
  126.         PLAYER.NAME$(X)=LEFT$(PLAYER.NAME$(X),8)
  127.     NEXT X
  128.  
  129.     RANDOMIZE
  130.  
  131. 40    REM
  132.     PRINT "ENTER NUMBER OF YEARS (3 TO 50) ";
  133.     INPUT NO.OF.YEARS
  134.     IF NO.OF.YEARS<3 OR NO.OF.YEARS>50 THEN \
  135.         PRINT "ANYWHERE FROM THREE TO FIFTY ONLY" :\
  136.         GOTO 40
  137.     FOR X=1 TO 4
  138.         CASH(X)=5000        REM STARTING DOLLARS
  139.         DIVIDENDS(X)=0        REM ZERO DIVIDENDS
  140.         FOR Y=1 TO 10
  141.             PORTFOLIOS(X,Y)=0    REM NO STOCKS TO START
  142.         NEXT Y
  143.     NEXT X
  144.  
  145.     FOR X=1 TO 10
  146.         STOCK.PRICE(X)=INT((16*RND)+92)
  147.     NEXT X
  148.     PRINT TAB(10);"HERE ARE THE STOCKS CURRENTLY TRADED ON THE"
  149.     PRINT TAB(10);"          -----BIG BOARD-----"
  150.     PRINT
  151.     PRINT TAB(15);"STOCK NAME";TAB(40);"ABBR"
  152.     PRINT
  153.     GOSUB 7100
  154.  
  155.     REM-----------FOR / NEXT LOOP--------------------------------
  156.  
  157.     FOR YEAR=1 TO NO.OF.YEARS
  158.         GOSUB 2000            REM CALC NEW MARKET
  159.         IF YEAR<NO.OF.YEARS THEN \
  160.             GOSUB 1000        REM BUY AND SELL
  161.     NEXT YEAR
  162.     GOSUB 3000                REM   END OF GAME
  163.     STOP
  164.  
  165. 2000    REM-----NEW YEAR ON THE MARKET-----------------------
  166.     ELAPSED.YEARS=ELAPSED.YEARS+1
  167.     IF ELAPSED.YEARS>LENGTH.OF.TREND THEN \
  168.         GOSUB 100        REM CALC NEW TREND
  169.  
  170.     FOR X=1 TO 10
  171.         CHANGE=FN.CHANGE    REM CHANGE FUNCTION
  172.         IF CHANGE>15 THEN \
  173.             CHANGE=15
  174.         IF RND>.5 THEN \
  175.             CHANGE=0-CHANGE    REM 50/50 IT'S MINUS
  176.         NET.CHANGE(X)=INT((CHANGE*FLUCT(X))+BIAS)
  177.         STOCK.PRICE(X)=STOCK.PRICE(X)+NET.CHANGE(X)
  178.     NEXT X
  179.  
  180.     GOSUB 600            REM CALC DOW JONES
  181.  
  182.     FOR X=1 TO 10
  183.         IF STOCK.PRICE(X)>=150 THEN \
  184.             GOSUB 200    REM STOCK SPLITS
  185.         IF STOCK.PRICE(X)<=0 THEN \
  186.             GOSUB 300    REM STOCK BANKRUPTS
  187.     NEXT X
  188.  
  189.     FOR X=1 TO 10
  190.         YEAR.DIV(X)=INT(STOCK.PRICE(X)/DIV.FACTOR(X))
  191.         FOR Y=1 TO NO.OF.PLAYERS
  192.             DIVIDENDS(Y)=DIVIDENDS(Y)+YEAR.DIV(X)*PORTFOLIOS(Y,X)
  193.         NEXT Y
  194.     NEXT X
  195.  
  196.     PRINT
  197.     PRINT
  198.     PRINT TAB(20);"--------- YEAR ";YEAR;"---------"
  199.     PRINT TAB(20);"DOW JONES INDUSTRIAL AVERAGE ";Q$;" ";DIFF;
  200.     PRINT "TO ";DOW.JONES
  201.     PRINT "STOCK     NET     CURRENT   DIV-              P O R T F O L I O S"
  202.     PRINT "ABBR.    CHANGE    PRICE   IDEND" 
  203.     FOR X=1 TO NO.OF.PLAYERS
  204.         PRINT TAB((X-1)*9+37);PLAYER.NAME$(X);
  205.     NEXT X
  206.     PRINT " "
  207.     FOR X=1 TO 10
  208.         PRINT ABBR$(X);TAB(12);NET.CHANGE(X);TAB(20);
  209.         PRINT STOCK.PRICE(X);
  210.         PRINT TAB(30);YEAR.DIV(X);
  211.         FOR Y=1 TO NO.OF.PLAYERS
  212.             PRINT TAB((Y-1)*9+42);PORTFOLIOS(Y,X);
  213.         NEXT Y
  214.         PRINT " "
  215.     NEXT X
  216.  
  217.     PRINT "DIVIDENDS FOR THE YEAR:";
  218.     FOR X=1 TO NO.OF.PLAYERS
  219.         PRINT TAB((X-1)*9+42);DIVIDENDS(X);
  220.     NEXT X
  221.     PRINT " "
  222.     FOR X=1 TO NO.OF.PLAYERS
  223.         PRINT TAB((X-1)*9+42);"______";
  224.     NEXT X
  225.     PRINT " "
  226.  
  227.     PRINT "PLAYERS NEW CASH TOTAL:";
  228.     FOR X=1 TO NO.OF.PLAYERS
  229.         CASH(X)=CASH(X)+DIVIDENDS(X)
  230.         PRINT TAB((X-1)*9+42);CASH(X);
  231.     NEXT X
  232.     PRINT " "
  233.  
  234.     FOR X=1 TO NO.OF.PLAYERS
  235.         DIVIDENDS(X)=0
  236.     NEXT X
  237.     RETURN
  238.  
  239.  
  240. 1000    REM--------B U Y      A N D      S E L L---------------
  241.  
  242.     FOR X=1 TO NO.OF.PLAYERS
  243.         PRINT
  244.         PRINT TAB(10);"-----> PLAYER ";PLAYER.NAME$(X);
  245.         PRINT " YOU NOW HAVE $";CASH(X)
  246.         PRINT
  247.         OWNER.FLAG=0
  248.         FOR Y=1 TO 10
  249.             IF PORTFOLIOS(X,Y)>0 THEN \
  250.                 OWNER.FLAG=1
  251.         NEXT Y
  252.         IF OWNER.FLAG=1 THEN \
  253.             GOSUB 5000    REM SELL RTN
  254.         OWNER.FLAG=0
  255.         FOR Y=1 TO 10
  256.             IF CASH(X)>=STOCK.PRICE(Y) THEN \
  257.                 OWNER.FLAG=1
  258.         NEXT Y
  259.         IF OWNER.FLAG=1 THEN \
  260.             GOSUB 6000    REM BUY RTN
  261.     NEXT X
  262.     RETURN
  263.  
  264.  
  265.  
  266. 3000    REM-------E N D      O F      G A M E-------------------
  267.     FOR X=1 TO NO.OF.PLAYERS
  268.         GOSUB 700        REM LIQUIDATE
  269.     NEXT X
  270.     GOSUB 750            REM GET WINNER
  271.     PRINT
  272.     PRINT
  273.     PRINT TAB(10);"HERE IS THE FINAL ACCOUNTING AFTER ";YEAR-1;"YEARS"
  274.     PRINT
  275.     PRINT
  276.     FOR X=1 TO NO.OF.PLAYERS
  277.         IF X=WINNER THEN \
  278.             WINNER$=CHR$(7)+"WINNER!" :\
  279.         ELSE \
  280.             WINNER$=""
  281.         PRINT TAB(14);PLAYER.NAME$(X);TAB(30);"$";CASH(X);TAB(45);
  282.         PRINT WINNER$
  283.     NEXT X
  284.     PRINT
  285.     PRINT TAB(10);"-----------------------------------------"
  286.     PRINT
  287.     RETURN
  288. 700    REM-----LIQUIDATE---------------------------------------
  289.     FOR Y=1 TO 10
  290.         CASH(X)=CASH(X)+STOCK.PRICE(Y)*PORTFOLIOS(X,Y)
  291.     NEXT Y
  292.     RETURN
  293.  
  294. 750    REM-----FIND THE WINNER----------------------------------
  295.     HIGHEST=0
  296.     FOR X=1 TO NO.OF.PLAYERS
  297.         IF CASH(X)>HIGHEST THEN \
  298.             WINNER=X :\
  299.             HIGHEST=CASH(X)
  300.     NEXT X
  301.     RETURN
  302.  
  303.     REM-------------SUBROUTINES-----------------------------
  304.  
  305. 100    REM-----CALCULATE NEW TREND-----------------------------
  306.     LENGTH.OF.TREND=INT(FN.CHANGE)
  307.     IF LENGTH.OF.TREND>7 THEN \
  308.         LENGTH.OF.TREND=7
  309.     ELAPSED.YEARS=0
  310.     BIAS=INT(FN.CHANGE)
  311.     IF BIAS>7 THEN \
  312.         BIAS=7
  313.     IF RND>.5 THEN \
  314.         BIAS=0-BIAS
  315. PRINT "LENGTH=";LENGTH.OF.TREND;"   BIAS=";BIAS
  316.     RETURN
  317.  
  318. 200    REM-----STOCK SPLIT-------------------------------------
  319.     PRINT
  320.     PRINT STOCK.NAME$(X);" STOCK SPLIT"
  321.     STOCK.PRICE(X)=75
  322.     NET.CHANGE(X)=0
  323.     FOR Q=1 TO NO.OF.PLAYERS
  324.         PORTFOLIOS(Q,X)=PORTFOLIOS(Q,X)*2
  325.     NEXT Q
  326.     RETURN
  327.  
  328. 300    REM-----BANKRUPT----------------------------------------
  329.     PRINT
  330.     PRINT STOCK.NAME$(X);" WENT BANKRUPT"
  331.     PRINT "ALL HOLDINGS ARE LIQUIDATED AT $1 PER SHARE"
  332.     PRINT "A NEW STOCK WILL TAKE ITS PLACE ON THE 'BIG BOARD'"
  333.     PRINT
  334.     NEW.STOCK=NEW.STOCK+1
  335.     IF NEW.STOCK>=17 THEN \
  336.         PRINT "CROAK - GAME OVER" :\
  337.         YEAR=10000 :\        REM FORCE END OF GAME
  338.         RETURN
  339.     STOCK.NAME$(X)=STOCK.NAME$(NEW.STOCK)
  340. 340    ABBR$(X)=ABBR$(NEW.STOCK)
  341.     PRINT "THE NEW STOCK IS: ";STOCK.NAME$(X)
  342.     PRINT "ITS ABBREVIATION IS: ";ABBR$(X)
  343.     STOCK.PRICE(X)=INT((16*RND)+92)
  344.     PRINT "ITS STARTING PRICE IS: $";STOCK.PRICE(X)
  345.     NET.CHANGE(X)=0
  346.     FOR Q=1 TO NO.OF.PLAYERS
  347.         CASH(Q)=CASH(Q)+PORTFOLIOS(Q,X)
  348.         PORTFOLIOS(Q,X)=0
  349.     NEXT Q
  350.     RETURN
  351.  
  352.  
  353. 5000    REM-----S  E  L  L---------------------------------------
  354.     PRINT TAB(10);"DO YOU WISH TO SELL ANY STOCKS ";
  355.     INPUT ANS$
  356.     IF LEFT$(ANS$,1)="N" THEN \
  357.         RETURN
  358.     IF LEFT$(ANS$,1)<>"Y" THEN \
  359.         GOTO 5000
  360.     PRINT TAB(10);"STOCK ";
  361.     INPUT STOCK$
  362.     GOSUB 7000            REM RECOGNIZE STOCK NAME
  363. 5100    REM
  364.     PRINT TAB(10);"HOW MANY SELLING ";
  365.     INPUT SELL
  366.     IF SELL<=0 THEN \
  367.         GOTO 5000
  368.     IF SELL>PORTFOLIOS(X,N) THEN \
  369.         PRINT TAB(10);"YOU ONLY HAVE ";PORTFOLIOS(X,N);"SHARES" :\
  370.         GOTO 5100
  371.     PORTFOLIOS(X,N)=PORTFOLIOS(X,N)-SELL
  372.     RESALE=SELL*STOCK.PRICE(N)
  373.     PRINT TAB(10);"RESALE VALUE OF $";RESALE
  374.     CASH(X)=CASH(X)+RESALE
  375.     GOTO 5000
  376.  
  377. 6000    REM-----B  U  Y----------------------------------------------
  378.     PRINT TAB(10);"DO YOU WISH TO BUY ANY STOCKS ";
  379.     INPUT ANS$
  380.     IF LEFT$(ANS$,1)="N" THEN \
  381.         RETURN
  382.     IF LEFT$(ANS$,1)<>"Y" THEN \
  383.         GOTO 6000
  384.     PRINT TAB(10);"STOCK ";
  385.     INPUT STOCK$
  386.     GOSUB 7000            REM RECOGINIZE STOCK NAME
  387. 6100    REM
  388.     PRINT TAB(10);"HOW MANY BUYING ";
  389.     INPUT BUY
  390.     IF BUY<=0 THEN \
  391.         GOTO 6000
  392.     IF BUY*STOCK.PRICE(N)>CASH(X) THEN \
  393.         PRINT TAB(10);"YOU ONLY HAVE $";CASH(X) :\
  394.         PRINT TAB(10);"THAT'S ENOUGH FOR "; :\
  395.         PRINT INT(CASH(X)/STOCK.PRICE(N));"SHARES" :\
  396.         GOTO 6100
  397.     COST=BUY*STOCK.PRICE(N)
  398.     PRINT TAB(10);"THAT COST $";COST
  399.     CASH(X)=CASH(X)-COST
  400.     PORTFOLIOS(X,N)=PORTFOLIOS(X,N)+BUY
  401.     GOTO 6000
  402.  
  403. 7000    REM-----FIND STOCK NAME--------------------------------
  404.     FOR N=1 TO 10
  405.         IF STOCK$=ABBR$(N) THEN \
  406.             RETURN
  407.     NEXT N
  408.     PRINT TAB(10);"THAT STOCK IS NOT TRADED ON THE 'BIG BOARD'"
  409.     PRINT TAB(10);"THESE ARE THE CURRENT STOCKS:"
  410.     PRINT
  411.     GOSUB 7100        REM PRINT STOCK NAMES AND ABBR
  412.     PRINT
  413.     PRINT TAB(10);"STOCK ";
  414.     INPUT STOCK$
  415.     GOTO 7000
  416.  
  417. 7100    REM-----PRINT THE STOCK NAMES AND ABBR------------
  418.     PRINT
  419.     FOR M=1 TO 10
  420.         PRINT STOCK.NAME$(M);TAB(40);ABBR$(M)
  421.     NEXT M
  422.     RETURN
  423.  
  424. 600    REM-----CALCULATE DOW JONES AVERAGE--------------
  425.     TOTAL.PRICE=0
  426.     FOR X=1 TO 10
  427.         TOTAL.PRICE=TOTAL.PRICE+STOCK.PRICE(X)
  428.     NEXT X
  429.     OLD.DOW.JONES=DOW.JONES
  430.     DOW.JONES=TOTAL.PRICE
  431.     DIFF=OLD.DOW.JONES-DOW.JONES
  432.     IF DIFF>=0 THEN \
  433.         Q$="DOWN" :\
  434.     ELSE \
  435.         Q$="UP"
  436.     DIFF=ABS(DIFF)
  437.     RETURN
  438.  
  439. 9000    REM-----I N S T R U C T I O N S-------------------
  440.     RETURN
  441.