1
0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-01 17:26:38 +00:00
Files
Lars Brinkhoff 6e18f5ebef Extract files from tape images.
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

295 lines
7.4 KiB
QBasic

100 REM MARKET - SIMULATION OF MARKET COMPETITION BETWEEN 2 COMPANIES
105 REM DEVELOPED BY S. FINKELSTEIN, J. MCGRATH, I. STAW, D. SOBIN
110 REM ALSO DEVELOPED BY D. KLASSEN - PROGRAMMED BY D. SOBIN
115 REM LATEST REVISION 8-29-72
120 REM COPYRIGHT 1972 - STATE UNIVERSITY OF NEW YORK
125 DEFFNR(X)=.01*INT(100*X+.5)
130 DIMC(2),I(2),T(2),A(2),L(2),D(2),P(2),V(2),W(2),B(2),E(5),F(2)
135 PRINT"DO YOU WANT INSTRUCTIONS(TYPE 1 FOR YES, 0 FOR NO)";
140 INPUTH
145 READ K2,N,K,K3,C(1),C(2),I(1),I(2),F,U,R,G1,G2,G3,M1,K4,W2,W3,W4
150 LETQ=0
155 PRINT
160 IFH=0THEN200
165 PRINT"MARKET SIMULATES THE COMPETITION BETWEEN TWO COMPANIES"
170 PRINT"SELLING A PRODUCT DIFFERENTIATED BY BRAND ADVERTISING."
175 PRINT"THE QUANTITY EACH COMPANY SELLS IS DEPENDENT UPON PRICE"
180 PRINT"AND ADVERTISING BUDGET. THE GAME ENDS WHEN ONE "
185 PRINT"COMPANY GOES BANKRUPT OR REACHES ";.001*M1;" MILLION IN"
190 PRINT"TOTAL ASSETS."
195 PRINT
200 PRINT"ARE YOU BEGINNING THE GAME OR CONTINUING"
205 PRINT"(TYPE 1 FOR BEGINNING, 2 FOR CONTINUING)";
210 INPUTA
215 PRINT
220 IFA=1THEN270
225 FORJ=1TO2
230 PRINT"COMPANY ";J;"ENTER PREVIOUS CASH ON HAND,PREVIOUS INVENTORY"
235 INPUTC(J),I(J)
240 PRINT
245 NEXTJ
250 PRINT"ENTER VARIABLE PRODUCTION COST";
255 INPUTU
260 PRINT"ENTER QUARTER NUMBER";
265 INPUTQ
270 PRINT
275 PRINT"FIXED PRODUCTION COST=";F*1E3;" DOLLARS/QUARTER"
280 PRINT"VARIABLE PRODUCTION COST=";U;" DOLLARS/UNIT"
285 PRINT"WITH NO ADVERTISING AND A SELLING PRICE OF 50 DOLLARS/UNIT"
290 PRINT"A COMPANY WILL SELL ";K2*500;" UNITS (PRINTED AS ";K2/2;")"
295 PRINT"WAREHOUSE CHARGE FOR INVENTORY=";R*100;" PER CENT"
300 PRINT"INTEREST CHARGE ON BORROWED MONEY=";K3*100;" PER CENT"
305 PRINT
310 PRINT
315 RANDOMIZE
320 PRINT
325 PRINT
330 PRINT"UNITS AND DOLLARS BELOW ARE IN THOUSANDS "
335 PRINT
340 PRINT
345 FORJ=1TO5
350 LETE(J)=0
355 NEXTJ
360 LETP4=0
365 GOSUB875
370 FORJ=1TO2
375 LETW(J)=0
380 LETD(J)=0
385 LETT(J)=0
390 LETB(J)=U*I(J)+C(J)
395 GOSUB900
400 NEXTJ
405 PRINT
410 LETQ=Q+1
415 GOSUB1060
420 GOSUB675
425 GOSUB865
430 REM COMPUTE DEMAND
435 FORJ=1TO2
440 LETD(J)=(1-E(5))*.5*(K2+2*V(J)*D1)/(P(J)/50)^N
445 NEXTJ
450 GOSUB1000
455 FORJ=1TO2
460 IFD(J)>I(J)THEN475
465 LETT(J)=D(J)
470 GOTO480
475 LETT(J)=I(J)
480 LETT(J)=INT(T(J))
485 LETC(J)=C(J)+T(J)*P(J)
490 LETI(J)=I(J)-T(J)
495 NEXTJ
500 FORJ=1TO2
505 LETC(J)=C(J)-R*I(J)*U-K3*C(J)*(SGN(C(J))-SGN(C(J))^2)/2
510 LETC(J)=INT(C(J))
515 IFE(5)=0THEN530
520 LETW(J)=0
525 GOTO540
530 IFT(1)+T(2)=0THEN520
535 LETW(J)=INT(10000*T(J)/(T(1)+T(2)))/100
540 NEXTJ
545 FORJ=1TO2
550 GOSUB900
555 LETB(J)=C(J)+U*I(J)
560 IFB(J)>0THEN580
565 PRINT
570 GOSUB975
575 PRINT
580 IFB(J)<M1THEN620
585 IFB(J)<=C(3-J)+U*I(3-J)THEN620
590 LETP4=17
595 PRINT
600 PRINTTAB(14);"********************"
605 PRINT"COMPANY ";J;" YOU HAVE REACHED ";M1/1E3;" MILLION AND WON"
610 PRINTTAB(14);"********************"
615 PRINT
620 NEXTJ
625 PRINT
630 IFP4<>17THEN410
635 PRINT
640 PRINT"DO YOU WANT TO PLAY AGAIN(TYPE 1 FOR YES, 0 FOR NO)";
645 INPUTH
650 IFH=0THEN670
655 RESTORE
660 PRINT
665 GOTO135
670 STOP
675 PRINT
680 FORJ=1TO2
685 PRINT
690 PRINT
695 PRINT"COMPANY ";J
700 IFE(2)<>1THEN715
705 PRINT"NO PRODUCTION POSSIBLE DUE TO STRIKE"
707 LETL(J)=0
710 GOTO730
715 PRINT"PRODUCTION LEVEL";
720 INPUTL(J)
725 IFL(J)<0THEN715
730 PRINT"ADVERTISING BUDGET";
735 INPUTA(J)
740 IFA(J)<0THEN730
745 LETC(J)=C(J)-F-L(J)*U-A(J)
750 IFE(2)=1THEN760
755 LETI(J)=I(J)+L(J)
760 PRINT"UNIT PRICE";
765 INPUTP(J)
770 IFABS(P(J)-100)>=100THEN760
775 IFE(1)<>1THEN815
776 IFP(J)<=F(J)THEN815
780 PRINT
785 PRINT"YOU MAY NOT RAISE PRICES DURING THE WAGE-PRICE FREEZE"
790 PRINT
795 GOTO760
815 NEXTJ
820 LETA2=A(1)+A(2)
825 IFA2>0THEN845
830 LETV(1)=0
835 LETV(2)=0
840 GOTO855
845 LETV(1)=A(1)/A2
850 LETV(2)=A(2)/A2
855 LETD1=(K2-K2*EXP(-K*A2))*K4
860 RETURN
865 PRINT
870 PRINT
875 PRINT"QUARTER ";Q
880 PRINT
885 PRINT"PROFIT MARKET SHARE CASH ON HAND NUMBER SOLD ";
890 PRINT"INVENT. ASSETS"
895 RETURN
900 PRINTU*I(J)+C(J)-B(J);TAB(9);W(J);TAB(23);C(J);TAB(37);
905 PRINTT(J);TAB(50);I(J);TAB(58);U*I(J)+C(J)
910 RETURN
915 DATA50
920 DATA2
925 DATA.001
930 DATA.05
935 DATA5000,5000
940 DATA100,100
945 DATA250
950 DATA20
955 DATA.05
960 DATA.2,.4,.4
965 DATA12000
970 DATA1.5
972 DATA0,0,0
975 PRINTTAB(7);"********************"
980 PRINT"COMPANY ";J;" YOU HAVE GONE BANKRUPT"
985 PRINTTAB(7);"********************"
990 LETP4=17
995 RETURN
1000 IFP(1)<P(2)THEN1015
1005 LETM=2
1010 GOTO1020
1015 LETM=1
1020 LETG4=(P(3-M)-P(M))/P(3-M)
1025 IFG4<=G1THEN1055
1030 IFG4<G2THEN1040
1035 LETG4=G2
1040 LETG5=D(3-M)*((G4-G1)/(G2-G1))*G3
1045 LETD(3-M)=D(3-M)-G5
1050 LETD(M)=D(M)+G5
1055 RETURN
1060 IFQ<6THEN1230
1065 IFRND(1)<.1THEN1090
1070 IFRND(1)<.1THEN1115
1075 IFRND(1)<.1THEN1165
1080 IFRND(1)<.1THEN1200
1085 GOTO1230
1090 IFE(1)>0THEN1070
1091 LETF(1)=P(1)
1092 LETF(2)=P(2)
1095 GOSUB1300
1100 LETE(1)=1
1105 LETQ1=Q
1110 GOTO1070
1115 LETI=INT(RND(1)+1.5)
1120 IFQ-W2<=2THEN1075
1125 IFC(I)<0THEN1075
1130 IFC(I)>200THEN1145
1135 LETC(I)=.75*C(I)
1140 GOTO1150
1145 LETC(I)=C(I)-200
1150 GOSUB1325
1155 LETW2=Q
1160 GOTO1075
1165 LETJ=INT(RND(1)+1.5)
1170 IFQ-W3<=2THEN1080
1175 GOSUB1350
1180 LETC(J)=C(J)+U*I(J)*.75
1185 LETI(J)=0
1190 LETW3=Q
1195 GOTO1080
1200 IFE(1)=1THEN1230
1201 IFE(2)=1THEN1230
1205 IFQ-W4<=2THEN1230
1210 LETW4=Q
1215 GOSUB1375
1220 LETE(5)=1
1225 LETQ2=Q
1230 IFINT((Q-1)/4)*4<>Q-1THEN1425
1235 IFQ=1THEN1425
1240 IFE(1)=1THEN1425
1241 IFE(2)=1THEN1425
1242 IFE(5)=1THEN1425
1245 IFRND(1)>.25THEN1280
1250 IFQ<6THEN1280
1255 GOSUB1400
1260 LETE(2)=1
1265 LETU=INT(U*(1.1+.1*RND(1)))
1270 LETQ3=Q
1275 GOTO1425
1280 LETU=INT(U*(1.05+.1*RND(1)))
1285 PRINT"NEW LABOR CONTRACT - VARIABLE PRODUCTION COST NOW=";
1290 PRINTU;" DOLLARS/UNIT"
1295 GOTO1425
1300 PRINT"THE PRESIDENT HAS JUST IMPOSED A WAGE-PRICE FREEZE ON THE"
1305 PRINT"ECONOMY, AND YOU MAY NOT RAISE THE PRICE OF YOUR PRODUCT"
1310 PRINT"OVER THE NEXT 2 QUARTERS."
1315 PRINT
1320 RETURN
1325 PRINT"COMPANY ";I;"HAS BEEN THE VICTIM OF EMBEZZLEMENT BY THE"
1330 PRINT"VICE PRESIDENT OF THE COMPANY. YOUR CASH ON HAND IS NOW ";
1335 PRINTC(I);" DOLLARS"
1340 PRINT
1345 RETURN
1350 PRINT"COMPANY";J;" HAS SUFFERED FIRE DAMAGE IN ITS WAREHOUSE"
1355 PRINT"ALL UNITS WERE DESTROYED. YOUR INSURANCE WILL REIMBURSE YOU"
1360 PRINT"IN THE AMOUNT OF";INT(U*I(J)*.75);" DOLLARS FOR THESE UNITS"
1365 PRINT
1370 RETURN
1375 PRINT"A TRANSPORTATION STRIKE HAS OCCURED, AND YOU ARE UNABLE TO"
1380 PRINT"MOVE YOUR GOODS TO THE DISTRIBUTORS. NEGOTIATIONS HAVE"
1385 PRINT"BEGUN, BUT HOPE OF A SETTLEMENT LOOKS DIM."
1390 PRINT
1395 RETURN
1400 PRINT"THERE HAS BEEN A STRIKE AND YOUR PRODUCTION HAS BEEN"
1405 PRINT"HALTED. NEGOTIATIONS HAVE BEEN STARTED, BUT HOPE OF"
1410 PRINT"A SETTLEMENT LOOKS DIM."
1415 PRINT
1420 RETURN
1425 IFE(1)<>1THEN1450
1430 IFQ<Q1+2THEN1450
1435 LETE(1)=2
1440 PRINT"THE WAGE-PRICE FREEZE HAS ENDED"
1445 PRINT
1450 IFE(5)<>1THEN1475
1455 IFQ2=QTHEN1475
1460 LETE(5)=0
1465 PRINT"TRANSPORTATION STRIKE SETTLED. NORMAL DELIVERIES RESUMED"
1470 PRINT
1475 IFE(2)<>1THEN1505
1480 IFQ3=QTHEN1505
1485 PRINT"STRIKE SETTLED. NORMAL PRODUCTION RESUMED"
1490 PRINT"NEW VARIABLE COST=";U;" DOLLARS/UNIT DUE TO INCREASED WAGES"
1495 PRINT
1500 LETE(2)=0
1505 RETURN
1510 END
*U*0*53