diff --git a/presets/basic/startrader.bas b/presets/basic/startrader.bas new file mode 100644 index 00000000..98ddf0c3 --- /dev/null +++ b/presets/basic/startrader.bas @@ -0,0 +1,867 @@ +5 OPTION DIALECT HP +6 OPTION BASE 0:REM I GUESS HP HAS ZERO BASE??? +10010 DIM S[12,15],T[12,12],T$[72],B[3,12] +10020 REM COM W,D9,K9,X9,D1,X1,P9,T9,S9,Y9,H +10030 DIM M[6,3],C[6,3]:REM COM Y1,R9,G9,Q +10035 REM COM S1,T1,R +10040 REM *** STAR TRADERS *** +10050 REM <<>> +10060 REM S IS THE STAR SYSTEM INFO ARRAY +10070 REM T IS THE TRADING SHIP INFO ARRAY +10080 REM T$ IS THE TRADING SHIP NAME STRING +10090 REM M AND C DETERMINE A STAR'S PRODUCTIVITY/MONTH +10092 REM PROD/MO. = S(7,J) * M(I,R1) + C(I,R1) +10094 REM WHERE J IS THE STAR ID #,I THE MERCHANDISE #, +10096 REM AND R1 IS THE DEVELOPMENT CLASS OF THE STAR +10100 REM B CONTAINS THE BANK ACCOUNTS +10110 REM A$ IS THE STANDARD INPUT BUFFER +10120 DIM A$[6] +10130 REM R9 IS THE SPEED OF A SHIP IN LIGHT-YEARS PER DAY +10140 REM D9 IS THE MINIMUM DISTANCE ALLOWED BETWEEN STARS +10150 REM Q IS THE PROBABILITY OF A DELAY +10160 REM K9 IS THE MAX NUMBER OF BIDDING ROUNDS +10170 REM W IS THE MAX WEIGHT OF A TRADING SHIP +10180 REM X9 CONTROLS THE PROFIT MARGIN; HIGH X9 LIMITS THE % +10190 REM G9 IS THE STELLAR DEVELOPMENT INCREMENT 1<=G9<=5 +10195 REM R=1 IF THIS IS A RESTART +10200 LET R9=2/7 +10210 LET D9=15 +10220 LET Q=.1 +10230 LET K9=3 +10240 LET W=30 +10250 LET X9=36 +10260 LET G9=1.25 +10265 LET R=0 +10270 REM D1 IS THE DAY OF THIS YEAR (1<=D1<=360) +10280 REM Y1 IS THIS YEAR +10290 LET D1=1 +10300 LET Y1=2070 +10302 REM SET UP ECONOMETRICS MODEL +10304 RESTORE 12410 +10306 REM MAT READ M,C +10307 FOR I=1 TO 6:FOR J=1 TO 3:READ M[I,J]:NEXT J:NEXT I +10308 FOR I=1 TO 6:FOR J=1 TO 3:READ C[I,J]:NEXT J:NEXT I +10310 REM *** BLOCK #1 +10320 PRINT "INSTRUCTIONS (TYPE 'Y' OR 'N' PLEASE)"; +10330 INPUT A$ +10340 IF A$[1,1]="N" THEN 10590 +10350 PRINT +10360 PRINT " THE DATE IS JAN 1, 2070 AND INTERSTELLAR FLIGHT" +10370 PRINT "HAS EXISTED FOR 70 YEARS. THERE ARE SEVERAL STAR" +10380 PRINT "SYSTEMS THAT HAVE BEEN COLONIZED. SOME ARE ONLY" +10390 PRINT "FRONTIER SYSTEMS, OTHERS ARE OLDER AND MORE DEVELOPED." +10400 PRINT +10410 PRINT " EACH OF YOU IS THE CAPTAIN OF TWO INTERSTELLAR" +10420 PRINT "TRADING SHIPS. YOU WILL TRAVEL FROM STAR SYSTEM TO" +10430 PRINT "STAR SYSTEM, BUYING AND SELLING MERCHANDISE. IF YOU" +10440 PRINT "DRIVE A GOOD BARGAIN YOU CAN MAKE LARGE PROFITS." +10450 PRINT +10460 PRINT " AS TIME GOES ON, EACH STAR SYSTEM WILL SLOWLY" +10470 PRINT "GROW, AND ITS NEEDS WILL CHANGE. A STAR SYSTEM THAT" +10480 PRINT "HOW IS SELLING MUCH URANIUM AND RAW METALS CHEAPLY" +10490 PRINT "MAY NOT HAVE ENOUGH FOR EXPORT IN A FEW YEARS." +10500 PRINT +10510 PRINT " YOUR SHIPS CAN TRAVEL ABOUT TWO LIGHTYEARS IN A" +10520 PRINT "WEEK AND CAN CARRY UP TO";W;" TONS OF CARGO. ONLY" +10530 PRINT "CLASS I AND CLASS II STAR SYSTEMS HAVE BANKS ON THEM." +10540 PRINT "THEY PAY 5% INTEREST AND ANY MONEY YOU DEPOSIT ON ONE" +10550 PRINT "PLANET IS AVAILABLE ON ANOTHER - PROVIDED THERE'S A LOCAL" +10560 PRINT "BANK." +10570 PRINT +10580 REM *** BLOCK #2 +10590 PRINT "HAVE ALL PLAYERS PLAYED BEFORE"; +10600 INPUT A$ +10605 PRINT +10610 IF A$[1,1]="Y" THEN 10630 +10620 GOTO 10660 +10630 PRINT "DO YOU WANT TO SET UP YOUR OWN GAME"; +10640 INPUT A$ +10645 PRINT +10650 IF A$[1,1]="Y" THEN 10760 +10660 PRINT "HOW MANY PLAYERS"; +10670 INPUT P9 +10675 PRINT +10680 GOTO P9-1 OF 10710,10710,10710 +10690 PRINT "2,3, OR 4 CAN PLAY" +10700 GOTO 10660 +10710 T9=2*P9 +10720 S9=3*P9+1 +10730 Y9=Y1+5 +10740 GOTO 11350 +10750 REM *** BLOCK #3 +10760 PRINT "IS THIS A RESTART"; +10770 INPUT A$ +10775 PRINT +10780 IF A$[1,1]="N" THEN 10940 +10790 PRINT "LOAD THE TAPE INTO THE TAPE READER. WHEN I TYPE A '?'" +10800 PRINT "YOU CAN FLIP THE SWITCH TO 'START' WHENEVER YOU'RE READY" +10810 PRINT +10820 INPUT T$ +10830 INPUT W,D9,K9,X9,D1,Y1 +10835 INPUT P9,T9,S9,Y9,T1,S1 +10840 FOR J=1 TO S9 +10845 FOR I=1 TO 9 STEP 4 +10850 INPUT S[I,J],S[I+1,J],S[I+2,J],S[I+3,J] +10855 NEXT I +10860 NEXT J +10870 FOR J=1 TO T9 +10875 FOR I=1 TO 9 STEP 4 +10880 INPUT T[I,J],T[I+1,J],T[I+2,J],T[I+3,J] +10885 NEXT I +10890 NEXT J +10900 FOR I=1 TO P9 +10910 INPUT B[1,I],B[2,I],B[3,I] +10920 NEXT I +10925 R=1 +10930 GOSUB 20000:REM CALL TRADES ROUTINE +10940 PRINT "HOW MANY PLAYERS"; +10950 INPUT P9 +10955 PRINT +10960 IF P9 >= 2 AND P9 <= 12 THEN 10990 +10970 PRINT "2,3,4, ... ,12 CAN PLAY" +10980 GOTO 10940 +10990 PRINT "HOW MANY SHIPS PER PLAYER"; +11000 INPUT X +11005 PRINT +11010 IF X<1 THEN 10990 +11020 T9=P9*X +11030 IF T9 <= 12 THEN 11070 +11040 PRINT "I CAN'T KEEP TRACK OF MORE THAN 12 SHIPS;" +11050 PRINT P9;" PLAYERS TIMES";X;" SHIPS MAKES";T9 +11060 GOTO 10990 +11070 PRINT "HOW MANY STAR SYSTEMS"; +11080 INPUT S9 +11085 PRINT +11090 IF S9 >= 4 AND S9 <= 13 THEN 11120 +11100 PRINT "FROM 4 TO 13 STARS" +11110 GOTO 11070 +11120 PRINT "ENTER THE LENGTH OF GAME IN YEARS"; +11130 INPUT X +11135 PRINT +11140 IF X >= 1 AND INT(X)=X THEN 11170 +11150 PRINT "CHOOSE A POSITIVE INTEGER" +11160 GOTO 11130 +11170 Y9=Y1+X +11180 PRINT "WHAT'S THE MAX CARGOE TONNAGE(USUALLY 30)"; +11190 INPUT W +11195 PRINT +11200 IF W<25 THEN 11180 +11210 PRINT "WHAT'S THE MINIMUM DISTANCE BETWEEN STARS(USUALLY 15)"; +11220 INPUT D9 +11225 PRINT +11230 IF D9 <= 25 AND D9 >= 10 THEN 11260 +11240 PRINT "MIN SPACING 10, MAX 25" +11250 GOTO 11210 +11260 PRINT "HOW MANY BIDS OR OFFERS(USUALLY 3)"; +11270 INPUT K9 +11275 PRINT +11280 IF K9<1 THEN 11260 +11290 PRINT "SET THE PROFIT MARGIN(1,2,3,4 OR 5)...THE HIGHER" +11300 PRINT "THE NUMBER, THE LOWER THE PROFIT % ... USUALLY SET TO 2" +11310 PRINT "...YOUR NUMBER"; +11320 INPUT X9 +11330 X9=18*(ABS(X9) MIN 5) +11340 REM *** BLOCK #4.1 +11350 S[11,1]=S[12,1]=0 +11360 S[7,1]=15 +11370 REM *** BLOCK #4.2 +11380 H=1 +11390 S1=2 +11400 GOSUB 11920 +11410 S1=3 +11420 GOSUB 11920 +11430 S1=4 +11440 GOSUB 12010 +11450 FOR S1=5 TO S9 +11460 GOSUB S1-3*INT((S1-1)/3) OF 11920,12010,12060 +11470 NEXT S1 +11480 REM *** BLOCK #4.3 +11490 FOR S1=1 TO S9 +11500 FOR J=1 TO 6 +11510 S[J,S1]=0 +11520 NEXT J +11530 IF S1>1 THEN 11560 +11540 I=1 +11550 GOTO 11600 +11560 I=4*INT(14*RND(0))+5 +11570 FOR J=2 TO S1-1 +11580 IF I=S[8,J] THEN 11560 +11590 NEXT J +11600 S[8,S1]=I +11610 S[9,S1]=270 +11620 S[10,S1]=Y1-1 +11630 NEXT S1 +11640 REM *** BLOCK #4.4 +11650 T1=1:L=1 +11655 PRINT +11657 PRINT +11660 PRINT "CAPTAINS, NAME YOUR SHIPS (UP TO 6 LETTERS/BLANKS/NUMBERS)" +11670 FOR I=1 TO T9/P9 +11680 PRINT +11690 FOR P1=1 TO P9 +11700 T[1,T1]=T[2,T1]=T[6,T1]=0 +11710 T[3,T1]=15 +11720 T[4,T1]=T[5,T1]=10 +11730 T[7,T1]=25 +11740 T[9,T1]=D1 +11750 T[10,T1]=Y1 +11760 T[11,T1]=5000 +11770 PRINT " CAPTAIN";P1;"WHAT DO YOU CHRISTEN YOUR SHIP #";I; +11780 INPUT T2$:T$[L,L+5]=T2$ +11790 T1=T1+1 +11800 L=L+6 +11810 NEXT P1 +11820 NEXT I +11830 REM *** BLOCK #4.5 +11840 FOR B1=1 TO P9 +11850 B[1,B1]=0 +11860 B[2,B1]=D1 +11870 B[3,B1]=Y1 +11880 NEXT B1 +11890 GOSUB 20000:REM CALL TRADES ROUTINE +11900 REM *** GOSUBS FOLLOW *** +11910 REM GOSUB +11920 X=(RND(0)-.5)*100 +11930 Y=50*RND(0) +11940 IF (ABS(X)<25) AND (Y<25) THEN 11920 +11950 F=1 +11960 GOSUB 12190 +11970 IF F=0 THEN 11920 +11980 S[7,S1]=0 +11990 RETURN +12000 REM *** GOSUB +12010 E=100 +12020 GOSUB 12110 +12030 S[7,S1]=5 +12040 RETURN +12050 REM *** GOSUB +12060 E=50 +12070 GOSUB 12110 +12080 S[7,S1]=10 +12090 RETURN +12100 REM *** GOSUB +12110 X=(RND(0)-.5)*E +12120 Y=RND(0)*E/2 +12130 F=1 +12140 GOSUB 12190 +12150 IF F=0 THEN 12110 +12160 RETURN +12170 REM *** GOSUB +12180 REM FIRST CONVERT CO-ORDS TO NEXT HALF-BOARD +12190 GOTO H OF 12300,12260,12240,12200 +12200 Z=X +12210 X=-Y +12220 Y=Z +12230 GOTO 12300 +12240 Y=-Y +12250 GOTO 12300 +12260 Z=X +12270 X=Y +12280 Y=Z +12290 REM SECOND, TEST PROXIMITY +12300 FOR J=1 TO S1-1 +12310 IF SQR((X-S[11,J])^2+(Y-S[12,J])^2) >= D9 THEN 12340 +12320 F=0 +12330 RETURN +12340 NEXT J +12350 REM FINALLY, ENTER CO-ORDS AND INCREMENT HALF-BOARD CTR +12360 S[11,S1]=INT(X) +12370 S[12,S1]=INT(Y) +12380 H=1+(H <= 3)*H +12390 RETURN +12400 REM *** DATA FOR ECONOMETRIC MODEL FOLLOWS *** +12410 REM MODEL #1 +12420 DATA -0.025,-0.05,-0.025,0,-0.025,-0.025,0,.1,.1,-0.025,.1,0,.1,.2,.1,.1,-0.025,0 +12430 DATA 1,1.5,.5,.75,.75,.75,-0.25,-0.25,-0.25,0,-0.5,.5,0,-0.5 +12440 DATA 0,.5,1.5,0 +12450 END + +20000 REM *** TRADES SUBROUTINE (NO CHAIN) +20040 REM *** STAR TRADERS *** +20050 REM MAIN MODULE +20120 REM SET UP CALENDAR AND STAR SYSTEM NAMES +20130 DIM C$[36],S$[60] +20140 LET C$="JANFEBMARAPRMIYJUNJULAUGSEPOCTNOVDEC" +20150 LET S$="SOL YORKBOYDIVANREEFHOOKSTANTASKSINKSANDQUINGAOLKIRK" +20160 LET S$[53]="KRISFATE" +20170 REM S IS THE STAR SYSTEM INFO ARRAY +20180 REM T IS THE TRADING SHIP INFO ARRAY +20190 REM T$ IS THE TRADING SHIP NAME STRING (6 CHARS PER SHIP) +20200 REM P CONTAINS THE FAIR PRICES ON THE LOCAL PLANET +20210 REM Q HAS THE FIXED PRICES +20220 REM B CONTAINS THE BANK ACCOUNTS +20230 DIM P[6],Q[6] +20240 DIM A$[6],D$[5],N$[36],G[6] +20250 RESTORE 20270 +20260 REM MAT READ Q +20265 FOR I=1 TO 6:READ Q(I):NEXT I +20270 DATA 5000,3500,4000,4500,3000,3000 +20280 LET N$=" UR MET HE MED SOFT GEMS" +20290 REM FNZ COMPUTES THE PRICE WINDOW THROUGH WHICH A BID IS +20300 REM ACCEPTABLE FOR FURTHER HAGGLING +20310 DEF FNZ(X)=(FNY(X)*.5+( NOT FNY(X))*X/(2*ABS(S[I1,S1])))/K1 +20320 DEF FNY(X)=X >= ABS(S[I1,S1]) +20330 REM R9 IS THE SPEED OF A SHIP IN LIGHTYEARS PER DAY +20340 REM D9 IS THE MINIMUM DISTANCE ALLOWED BETWEEN STARS +20350 REM Q IS THE PROBABILITY OF A DELAY +20360 REM K9 IS THE MAX NUMBER OF BIDDING ROUNDS +20370 REM W IS THE MAX WEIGHT OF A TRADING SHIP'S CARGO +20380 REM X9 CONTROLS THE PROFIT MARGIN; HIGH X9 LIMITS THE % +20390 REM G9 IS THE STELLAR DEVELOPEMENT # INCREMENT 1<=G9<=5 +20400 REM *** BLOCK #5 +20402 IF R=0 THEN 20430 +20404 GOSUB 23860 +20406 GOSUB 25190 +20408 FOR T2=1 TO T9 +20410 IF T2=T1 THEN 20420 +20412 L=(T2-1)*6+1 +20414 PRINT T$[L,L+5];" IS ENROUTE TO ";S$[T[8,T2],T[8,T2]+3] +20420 NEXT T2 +20424 L=(T1-1)*6+1 +20426 PRINT " AND ";T$[L,L+5];" IS ABOUT TO LEAVE ";S$[T[8,T1],T[8,T1]+3] +20428 GOTO 22040 +20430 GOSUB 25190 +20432 GOSUB 23190 +20434 S1=T1=L1=1 +20440 PRINT +20450 PRINT "ALL SHIPS START AT SOL" +20460 PRINT "ADVICE; VISIT THE CLASS III AND IV SYSTEMS -" +20470 PRINT "SOL AND THE CLASS II STARS PRODUCE ALOT OF HE,MED AND" +20480 PRINT "SOFT, WHICH THE POORER STAR SYSTEMS (CLASS III AND" +20490 PRINT "IV) NEED. ALSO, THE POOR STARS PRODUCE THE RAW GOODS -" +20500 PRINT "UR,MET,GEMS THAT YOU CAN BRING BACK TO SOL AND" +20510 PRINT "THE CLASS II SYSTEMS IN TRADE" +20520 PRINT +20530 PRINT "STUDY THE MAP AND CURRENT PRICE CHARTS CAREFULLY -" +20540 PRINT "CLASS I AND II STARS MAKE EXCELLENT TRADING PARTNERS" +20550 PRINT "WITH CLASS III OR IV STARS." +20560 FOR I1=1 TO T9/P9 +20570 FOR P1=1 TO P9 +20580 PRINT +20590 PRINT "PLAYER";P1;", WHICH STAR WILL ";T$[L1,L1+5];" TRAVEL TO"; +20600 GOSUB 22770 +20610 L1=L1+6 +20620 T1=T1+1 +20630 NEXT P1 +20640 NEXT I1 +20650 REM *** BLOCK #6 +20660 D=T[9,1] +20670 Y=T[10,1] +20680 T1=1 +20690 FOR I=2 TO T9 +20700 IF T[10,I]Y THEN 20770 +20720 IF T[9,I]>D THEN 20770 +20730 IF T[9,I]=D AND RND(0)>.5 THEN 20770 +20740 D=T[9,I] +20750 Y=T[10,I] +20760 T1=I +20770 NEXT I +20780 IF Y1=Y THEN 20900 +20790 D1=1 +20800 Y1=Y +20810 T2=T1 +20820 GOSUB 23190 +20822 IF Y1 <> 2071 THEN 20830 +20824 GOSUB 24500 +20826 PRINT "THE LAST YEAR OF THIS GAME IS ";Y9;" BUT IF YOU" +20828 PRINT "WANT TO QUIT BEFORE THEN, YOU CAN TYPE 'SAVE' AS" +20829 PRINT "YOUR NEXT PORT OF CALL - THIS WILL PUNCH A TAPE" +20830 PRINT "SO YOU CAN CONTINUE THE GAME LATER" +20831 T1=T2 +20840 IF Y1= 0 OR T[I1,T1]<.5 THEN 21480 +21190 PRINT TAB(5);N$[J1,J1+5];" WE NEED ";-INT(S[I1,S1]);" UNITS."; +21200 PRINT "HOW MANY ARE YOU SELLING"; +21210 GOSUB 24430 +21220 IF X=0 THEN 21480 +21230 IF X <= T[I1,T1] THEN 21270 +21240 PRINT TAB(5);"YOU ONLY HAVE ";T[I1,T1];" UNITS IN YOUR HOLD" +21250 PRINT TAB(5); +21260 GOTO 21200 +21270 IF X <= 2*-INT(S[I1,S1]) THEN 21300 +21280 X=2*-INT(S[I1,S1]) +21290 PRINT TAB(5);"WE'LL BID ON ";X;" UNITS." +21300 FOR K1=1 TO K9 +21310 IF K1#K9 MAX 2 THEN 21340 +21320 PRINT TAB(5);"OUR FINAL OFFER:"; +21330 GOTO 21350 +21340 PRINT TAB(5);"WE OFFER "; +21342 Y2=(L1+1)*10/3 +21350 PRINT 100*INT(.009*P[I1]*X+.5);" WHAT DO YOU BID"; +21360 INPUT Y +21362 IF Y>P[I1]*X/10 AND Y(1+FNZ(X))*P[I1]*X THEN 21410 +21390 P[I1]=.8*P[I1]+.2*Y/X +21400 NEXT K1 +21410 PRINT TAB(5);"WE'LL PASS THIS ONE" +21420 GOTO 21480 +21430 PRINT TAB(5);"WE'LL BUY!" +21440 T[I1,T1]=T[I1,T1]-X +21450 T[7,T1]=T[7,T1]-X*(I1<5) +21460 T[11,T1]=T[11,T1]+Y +21470 S[I1,S1]=S[I1,S1]+X +21480 J1=J1+6 +21490 NEXT I1 +21500 PRINT +21510 REM *** BLOCK #8 +21520 PRINT "WE ARE SELLING:" +21530 J1=1 +21540 FOR I1=1 TO 6 +21550 IF G[I1] <= 0 OR S[I1,S1]<1 THEN 21960 +21555 IF I1 <= 4 AND T[7,T1] >= W THEN 21960 +21560 PRINT TAB(5);N$[J1,J1+5];" UP TO ";INT(S[I1,S1]);" UNITS."; +21570 PRINT "HOW MANY ARE YOU BUYING"; +21580 GOSUB 24430 +21590 IF X=0 THEN 21960 +21600 IF I1>4 OR X+T[7,T1] <= W THEN 21660 +21610 PRINT TAB(5);"YOU HAVE ";T[7,T1];" TONS ABOARD, SO ";X; +21620 PRINT " TONS PUTS YOU OVER" +21630 PRINT TAB(5);"THE ";W;" TON LIMIT." +21640 PRINT TAB(5); +21650 GOTO 21570 +21660 IF X <= S[I1,S1] THEN 21700 +21670 PRINT TAB(5);"WE ONLY HAVE ";INT(S[I1,S1]);" UNITS" +21680 PRINT TAB(5); +21690 GOTO 21570 +21700 FOR K1=1 TO K9 +21710 IF K1#K9 MAX 2 THEN 21740 +21720 PRINT TAB(5);"OUR FINAL OFFER:"; +21730 GOTO 21750 +21740 PRINT TAB(5);"WE WANT ABOUT "; +21750 PRINT 100*INT(.011*P[I1]*X+.5); +21760 PRINT "YOUR OFFER"; +21770 INPUT Y +21772 IF Y>P[I1]*X/10 AND Y= P[I1]*X THEN 21840 +21790 IF Y<(1-FNZ(X))*P[I1]*X THEN 21820 +21800 P[I1]=.8*P[I1]+.2*Y/X +21810 NEXT K1 +21820 PRINT TAB(5);"THAT'S TOO LOW" +21830 GOTO 21960 +21840 IF Y <= T[11,T1] THEN 21910 +21850 PRINT TAB(5);"YOU BID $";Y;" BUT YOU HAVE ONLY $";T[11,T1] +21860 GOSUB 24310 +21870 IF S[7,S1]<10 OR T[11,T1]+B[1,B1]T[11,T1] THEN 21820 +21910 PRINT TAB(5);"SOLD!" +21920 T[I1,T1]=T[I1,T1]+X +21930 T[7,T1]=T[7,T1]+X*(I1<5) +21940 S[I1,S1]=S[I1,S1]-X +21950 T[11,T1]=T[11,T1]-Y +21960 J1=J1+6 +21970 NEXT I1 +21980 REM *** BLOCK #9 +21990 GOSUB 24310 +22000 IF S[7,S1]<10 OR T[11,T1]+B[1,B1]=0 THEN 22040 +22010 PRINT +22020 GOSUB 24020 +22030 PRINT +22040 PRINT "WHAT IS YOUR NEXT PORT OF CALL"; +22050 GOSUB 22770 +22060 REM *** BLOCK #10.1 +22070 J=0 +22080 FOR I=1 TO 6 +22090 IF S[I,S1] >= 0 THEN 22120 +22100 IF S[I,S1]1 THEN 20660 +22140 REM *** BLOCK #10.2 +22150 S[7,S1]=S[7,S1]+G9 +22160 G0=S[7,S1] +22162 IF G0#5 AND G0#10 AND G0#15 THEN 22220 +22170 GOSUB 24580 +22180 GOSUB 24500 +22190 PRINT "STAR SYSTEM ";S$[S[8,S1],S[8,S1]+3];" IS NOW A CLASS"; +22200 PRINT D$;" SYSTEM" +22210 REM *** BLOCK #10.3 +22220 IF S9=15 THEN 20660 +22230 J=0 +22240 FOR I=1 TO S9 +22250 J=J+S[7,I] +22260 NEXT I +22270 IF J/S9<10 THEN 20660 +22280 REM A NEW STAR IS BORN! +22290 S1=S9=S9+1 +22300 GOSUB 24680 +22310 GOSUB 22450 +22320 S[9,S1]=D1 +22330 S[10,S1]=Y1 +22340 FOR J=1 TO 6 +22350 S[J,S1]=0 +22360 NEXT J +22370 GOSUB 24500 +22380 PRINT "A NEW STAR SYSTEM HAS BEEN DISCOVERED! IT IS A CLASS IV" +22390 PRINT "AND ITS NAME IS";S$[S[8,S1],S[8,S1]+3] +22400 GOSUB 25190 +22410 GOTO 20660 +22420 STOP +22430 REM *** GOSUBS FOLLOW *** +22440 REM GOSUB +22450 X=(RND(0)-.5)*100 +22460 Y=50*RND(0) +22470 IF (ABS(X)<25) AND (Y<25) THEN 22450 +22480 F=1 +22490 GOSUB 22550 +22500 IF F=0 THEN 22450 +22510 S[7,S1]=0 +22520 RETURN +22530 REM *** GOSUB +22540 REM FIRST CONVERT CO-ORDS TO NEXT HALF-BOARD +22550 GOTO H OF 22660,22620,22600,22560 +22560 Z=X +22570 X=-Y +22580 Y=Z +22590 GOTO 22660 +22600 Y=-Y +22610 GOTO 22660 +22620 Z=X +22630 X=Y +22640 Y=Z +22650 REM SECOND TEST PROXIMITY +22660 FOR J=1 TO S1-1 +22670 IF SQR((X-S[11,J])^2+(Y-S[12,J])^2) >= D9 THEN 22700 +22680 F=0 +22690 RETURN +22700 NEXT J +22710 REM FINALLY ENTER CO-ORDS AND INCREMENT HALF-BOARD COUNTER +22720 S[11,S1]=INT(X) +22730 S[12,S1]=INT(Y) +22740 H=1+(H <= 3)*H +22750 RETURN +22760 REM *** GOSUB +22770 INPUT A$ +22780 FOR I=1 TO S9 +22790 J=S[8,I] +22800 IF A$[1,4]=S$[J,J+3] THEN 22870 +22810 NEXT I +22820 IF A$[1,4] <> "SAVE" THEN 22832 +22830 GOSUB 24770 +22832 IF A$[1,3] <> "MAP" THEN 22840 +22833 S2=S1 +22834 GOSUB 25190 +22835 S1=S2 +22836 GOTO 22850 +22840 IF A$[1,6] <> "REPORT" THEN 22848 +22842 GOSUB 23180 +22846 GOTO 22850 +22848 PRINT A$[1,4];" IS NOT A STAR NAME IN THIS GAME" +22850 PRINT "NEXT STAR"; +22860 GOTO 22770 +22870 T[8,T1]=I +22880 IF I#S1 THEN 22910 +22890 PRINT "CHOOSE A DIFFERENT STAR SYSTEM TO VISIT" +22900 GOTO 22850 +22910 D2=SQR((S[11,S1]-S[11,I])^2+(S[12,S1]-S[12,I])^2)/R9 +22920 D2=INT(D2) +22930 IF RND(0)>(Q/2) THEN 23030 +22940 I=1+INT(RND(0)*3) +22950 GOTO I OF 23000,22980,22960 +22960 PRINT "SHIP DOES NOT PASS INSPECTION"; +22970 GOTO 23010 +22980 PRINT "CREWMEN DEMAND A VACATION"; +22990 GOTO 23010 +23000 PRINT "LOCAL HOLIDAY SOON"; +23010 PRINT " - ";I;" WEEK DELAY." +23020 D2=D2+7*I +23030 T[9,T1]=T[9,T1]+D2 +23040 IF T[9,T1] <= 360 THEN 23070 +23050 T[9,T1]=T[9,T1]-360 +23060 T[10,T1]=T[10,T1]+1 +23070 M=INT((T[9,T1]-1)/30) +23080 L=3*M+1 +23090 PRINT "THE ETA AT ";S$[J,J+3];" IS ";C$[L,L+2];" ";T[9,T1]-30*M;","T[10,T1] +23100 REM UPDATE ETA PLUS RANOM DELAY FACTOR (0,1,2 OR 3 WEEKS) +23110 I=(INT(RND(0)*3)+1)*(RND(0)>(Q/2)) +23120 T[9,T1]=T[9,T1]+7*I +23130 IF T[9,T1] <= 360 THEN 23160 +23140 T[9,T1]=T[9,T1]-360 +23150 T[10,T1]=T[10,T1]+1 +23160 T[12,T1]=I +23170 RETURN +23180 REM *** GOSUB +23190 GOSUB 24500 +23200 PRINT TAB(10);"JAN 1, ";Y1;TAB(35);"YEARLY REPORT #";Y1-2069 +23210 PRINT +23220 PRINT +23230 IF Y1>22070 THEN 23450 +23240 PRINT "STAR SYSTEM CLASSES:" +23250 PRINT " I COSMOPOLITAN" +23260 PRINT " II DEVELOPED" +23270 PRINT " III UNDERDEVELOPED" +23280 PRINT " IV FRONTIER" +23290 PRINT +23300 PRINT +23310 PRINT "MERCHANDISE:" +23320 PRINT " UR URANIUM" +23330 PRINT " MET METALS" +23340 PRINT " HE HEAVY EQUIPMENT" +23350 PRINT " MED MEDICINE" +23360 PRINT " SOFT COMPUTER SOFTWARE" +23370 PRINT " GEMS STAR GEMS" +23380 PRINT +23390 PRINT +23400 PRINT TAB(5);"EACH TRADING SHIP CAN CARRY MAX ";W;" TONS CARGO." +23410 PRINT "STAR GEMS AND COMPUTER SOFTWARE, WHICH AREN'T SOLD BY THE" +23420 PRINT "TON, DON'T COUNT." +23430 PRINT +23440 PRINT +23450 PRINT TAB(20);"CURRENT PRICES" +23460 PRINT +23470 PRINT +23480 PRINT "NAME","CLASS";N$ +23490 PRINT +23500 FOR S1=1 TO S9 +23510 GOSUB 23870 +23520 FOR I=1 TO 6 +23530 P[I]=SGN(S[I,S1])*P[I] +23540 NEXT I +23550 GOSUB 24580 +23560 REM PRINT USING "#,4A,2X";S$[S[8,S1],S[8,S1]+3] +23561 PRINT S$[S[8,S1],S[8,S1]+3] +23570 REM PRINT USING "5A,6(S5D)";D$,P[1],P[2],P[3],P[4],P[5],P[6] +23571 PRINT D$, +23572 PRINT NFORMAT$(P[1],6); +23573 PRINT NFORMAT$(P[2],6); +23574 PRINT NFORMAT$(P[3],6); +23575 PRINT NFORMAT$(P[4],6); +23576 PRINT NFORMAT$(P[5],6); +23577 PRINT NFORMAT$(P[6],6); +23580 IF S1/2 <> INT(S1/2) THEN 23600 +23590 PRINT +23600 NEXT S1 +23610 PRINT +23620 PRINT "('+' MEANS SELLING AND '-' MEANS BUYING)" +23630 PRINT +23640 PRINT +23650 PRINT TAB(22);"CAPTAINS" +23660 PRINT +23670 PRINT +23680 PRINT "NUMBER $ ON SHIPS $ IN BANK CARGOES TOTALS" +23690 FOR B1=1 TO P9 +23700 GOSUB 24380 +23710 NEXT B1 +23720 FOR P1=1 TO P9 +23730 PRINT +23740 M1=0:M2=0 +23750 FOR I1=0 TO T9/P9-1 +23760 M1=M1+T[11,P9*I1+P1] +23770 FOR K=1 TO 6 +23780 M2=M2+T[K,P9*I1+P1]*Q[K] +23790 NEXT K +23800 NEXT I1 +23810 M3=M2+M1+B[1,P1] +23820 REM PRINT USING "2X,2D,2X,4(2X,DDXDDDXDDD)";P1,M1,B[1,P1],M2,M3 +23821 PRINT P1,M1,B[1,P1],M2,M3 +23830 REM IMAGE +23840 NEXT P1 +23850 RETURN +23860 REM *** GOSUB +23870 R1=1+(S[7,S1] >= 5)+(S[7,S1] >= 10) +23880 D2=12*(Y1-S[10,S1])+(D1-S[9,S1])/30 +23890 FOR I=1 TO 6 +23900 G[I]=(1+S[7,S1]/15)*(M[I,R1]*S[7,S1]+C[I,R1]) +23910 IF ABS(G[I])>.01 THEN 23940 +23920 P[I]=0 +23930 GOTO 23970 +23940 S[I,S1]=SGN(G[I])*(ABS(G[I]*12) MIN ABS(S[I,S1]+D2*G[I])) +23950 P[I]=Q[I]*(1-SGN(S[I,S1])*ABS(S[I,S1]/(G[I]*X9))) +23960 P[I]=100*INT(P[I]/100+.5) +23970 NEXT I +23980 S[9,S1]=D1 +23990 S[10,S1]=Y1 +24000 RETURN +24010 REM *** GOSUB +24020 PRINT "DO YOU WISH TO VISIT THE LOCAL BANK"; +24030 INPUT A$ +24040 IF A$[1,1]="Y" THEN 24060 +24050 RETURN +24060 GOSUB 24310 +24070 GOSUB 24380 +24080 PRINT TAB(5);"YOU HAVE $";B[1,B1];" IN THE BANK" +24082 PRINT TAB(5);"AND $";T[11,T1];" ON YOUR SHIP" +24090 IF B[1,B1]=0 THEN 24190 +24100 PRINT TAB(5);"HOW MUCH DO YOU WISH TO WITHDRAW"; +24110 INPUT Z +24120 IF Z <= B[1,B1] THEN 24150 +24130 PRINT TAB(5);"TOO MUCH; "; +24140 GOTO 24100 +24150 IF Z <= 0 THEN 24190 +24160 B[1,B1]=B[1,B1]-Z +24170 T[11,T1]=T[11,T1]+Z +24180 RETURN +24190 PRINT TAB(5);"HOW MUCH DO YOU WISH TO DEPOSIT"; +24200 INPUT Z +24210 IF Z >= 0 THEN 24240 +24220 PRINT TAB(5);"YOU CAN'T DEPOSIT A NEGATIVE NUMBER" +24230 GOTO 24190 +24240 IF Z <= T[11,T1] THEN 24270 +24250 PRINT TAB(5);"YOU HAVE $";T[11,T1];" ON YOUR SHIP" +24260 GOTO 24190 +24270 T[11,T1]=T[11,T1]-Z +24280 B[1,B1]=B[1,B1]+Z +24290 RETURN +24300 REM *** GOSUB +24310 B1=T1 +24320 FOR I=1 TO S9/P9 +24330 IF B1 <= P9 THEN 24360 +24340 B1=B1-P9 +24350 NEXT I +24360 RETURN +24370 REM *** GOSUB +24380 B[1,B1]=B[1,B1]*(1+.05*(Y1-B[3,B1]+(D1-B[2,B1])/360)) +24390 B[2,B1]=D1 +24400 B[3,B1]=Y1 +24410 RETURN +24420 REM *** GOSUB +24430 INPUT X +24440 IF INT(X)=X AND X >= 0 THEN 24480 +24450 PRINT TAB(5);"TYPE A ZERO IF YOU WANT TO PASS THIS ONE," +24460 PRINT TAB(5);"BUT NO NEGATIVES OR DECIMALS" +24470 GOTO 24430 +24480 RETURN +24490 REM *** GOSUB +24500 PRINT +24520 PRINT +24530 PRINT TAB(20),"*** GENERAL ANNOUNCEMENT ***" +24540 PRINT +24550 PRINT +24560 RETURN +24570 REM *** GOSUB +24580 GOTO S[7,S1]/5+1 OF 24650,24630,24610,24590 +24590 D$=" I" +24600 RETURN +24610 D$=" II" +24620 RETURN +24630 D$=" III" +24640 RETURN +24650 D$=" IV" +24660 RETURN +24670 REM *** GOSUB +24680 IF S1>1 THEN 24710 +24690 I=1 +24700 GOTO 24750 +24710 I=4*INT(14*RND(0))+5 +24720 FOR J=2 TO S1-1 +24730 IF I=S[8,J] THEN 24710 +24740 NEXT J +24750 S[8,S1]=I +24760 RETURN +24770 REM *** GOSUB +24780 PRINT "WHEN I TYPE '?' THIS IS WHAT YOU SHOULD DO:" +24790 PRINT +24800 PRINT " 1. PUSH THE 'ON' BUTTON ON THE TAPE PUNCHER" +24810 PRINT " 2. PRESS THE 'HERE IS' KEY (UPPER RIGHT) 3 TIMES" +24820 PRINT " 3. PUSH THE 'OFF' BUTTON ON THE TAPE PUNCHER" +24830 PRINT " 4. TYPE ANY NUMBER" +24840 PRINT " 5. PRESS THE 'RETURN' KEY" +24850 PRINT +24860 PRINT "WHEN I TYPE '!!!' THAT MEANS I'LL START PUNCHING" +24870 PRINT "THE TAPE IN ABOUT 10 SECONDS, SO:" +24880 PRINT +24890 PRINT " *** DON'T FORGET TO TURN THE PUNCHER BACK ON ***" +24900 PRINT LIN(3) +24910 INPUT X +24920 PRINT "!!!" +24930 FOR I=1 TO 10000 +24940 X=X+1 +24950 NEXT I +24960 PRINT T$;"" +24970 PRINT W;",";D9;",";K9;",";X9;",";D1;",";Y1;"" +24980 PRINT P9;",";T9;",";S9;",";Y9;",";T1;",";S1;"" +24990 FOR J=1 TO S9 +25000 FOR I=1 TO 9 STEP 4 +25010 PRINT S[I,J];",";S[I+1,J];",";S[I+2,J];",";S[I+3,J];"" +25040 NEXT I +25060 NEXT J +25070 FOR J=1 TO T9 +25080 FOR I=1 TO 9 STEP 4 +25090 PRINT T[I,J];",";T[I+1,J];",";T[I+2,J];",";T[I+3,J];"" +25120 NEXT I +25140 NEXT J +25150 FOR I=1 TO P9 +25160 PRINT B[1,I];",";B[2,I];",";B[3,I];"" +25170 NEXT I +25172 FOR I=1 TO 50 +25174 PRINT " "; +25176 NEXT I +25180 STOP +25190 REM *** GOSUB +25200 PRINT LIN(3) +25210 PRINT TAB(22);"STAR MAP" +25220 PRINT TAB(20);"************" +25230 PRINT +25240 DIM L$[55] +25250 FOR L1=15 TO -15 STEP -1 +25260 IF L1 <> 0 THEN 25290 +25270 L$="1----1----1----1----1----*SOL-1----1----1----1----1 " +25280 GOTO 25340 +25290 L$=" " +25300 IF ABS(L1)/3=INT(ABS(L1)/3) THEN 25330 +25310 L$[26,26]="1" +25320 GOTO 25340 +25330 L$[26,26]="-" +25340 Y=L1*10/3 +25342 Y0=(L1+1)*10/3 +25350 FOR S1=2 TO S9 +25360 IF S[12,S1] >= Y0 OR S[12,S1] " " THEN 25440 +25430 NEXT I +25440 PRINT L$[1,I] +25450 NEXT L1 +25460 PRINT +25470 PRINT "THE MAP IS 100 LIGHT-YEARS BY 100 LIGHT-YEARS," +25480 PRINT "SO THE CROSS-LINES MARK 10 LIGHT-YEAR DISTANCES" +25490 RETURN +25500 END diff --git a/presets/basic/wumpus.bas b/presets/basic/wumpus.bas index 650312f0..73b0012c 100644 --- a/presets/basic/wumpus.bas +++ b/presets/basic/wumpus.bas @@ -1,221 +1,214 @@ -5 REM *** HUNT THE WUMPUS *** -10 DIM P(5) -15 PRINT "INSTRUCTIONS (Y-N)"; -20 INPUT I$ -25 IF (I$ = "N") OR (I$ = "N") THEN 35 -30 GOSUB 375 -35 GOTO 80 -80 REM *** SET UP CAVE (DODECAHEDRAL NODE LIST) *** -85 DIM S(20,3) -90 FOR J = 1 TO 20 -95 FOR K = 1 TO 3 -100 READ S(J,K) -105 NEXT K -110 NEXT J -115 DATA 2,5,8,1,3,10,2,4,12,3,5,14,1,4,6 -120 DATA 5,7,15,6,8,17,1,7,9,8,10,18,2,9,11 -125 DATA 10,12,19,3,11,13,12,14,20,4,13,15,6,14,16 -130 DATA 15,17,20,7,16,18,9,17,19,11,18,20,13,16,19 -135 DEF FNA(X)=INT(20*RND(1))+1 -140 DEF FNB(X)=INT(3*RND(1))+1 -145 DEF FNC(X)=INT(4*RND(1))+1 -150 REM *** LOCATE L ARRAY ITEMS *** -155 REM *** 1-YOU, 2-WUMPUS, 3&4-PITS, 5&6-BATS *** -160 DIM L(6) -165 DIM M(6) -170 FOR J = 1 TO 6 -175 L(J) = FNA(0) -180 M(J) = L(J) -185 NEXT J -190 REM *** CHECK FOR CROSSOVERS (IE L(1)=L(2), ETC) *** -195 FOR J = 1 TO 6 -200 FOR K = 1 TO 6 -205 IF J = K THEN 215 -210 IF L(J) = L(K) THEN 170 -215 NEXT K -220 NEXT J -225 REM *** SET NO. OF ARROWS *** -230 A = 5 -235 L = L(1) -240 REM *** RUN THE GAME *** -245 PRINT "HUNT THE WUMPUS" -250 REM *** HAZARD WARNING AND LOCATION *** -255 GOSUB 585 -260 REM *** MOVE OR SHOOT *** -265 GOSUB 670 -270 ON O GOTO 280,300 -275 REM *** SHOOT *** -280 GOSUB 715 -285 IF F = 0 THEN 255 -290 GOTO 310 -295 REM *** MOVE *** -300 GOSUB 975 -305 IF F = 0 THEN 255 -310 IF F > 0 THEN 335 -315 REM *** LOSE *** -320 PRINT "HA HA HA - YOU LOSE!" -325 GOTO 340 -330 REM *** WIN *** -335 PRINT "HEE HEE HEE - THE WUMPUS'LL GET YOU NEXT TIME!!" -340 FOR J = 1 TO 6 -345 L(J) = M(J) -350 NEXT J -355 PRINT "SAME SETUP (Y-N)"; -360 INPUT I$ -365 IF (I$ <> "Y") AND (I$ <> "Y") THEN 170 -370 GOTO 230 -375 REM *** INSTRUCTIONS *** -380 PRINT "WELCOME TO 'HUNT THE WUMPUS'" -385 PRINT " THE WUMPUS LIVES IN A CAVE OF 20 ROOMS. EACH ROOM" -390 PRINT "HAS 3 TUNNELS LEADING TO OTHER ROOMS. (LOOK AT A" -395 PRINT "DODECAHEDRON TO SEE HOW THIS WORKS-IF YOU DON'T KNOW" -400 PRINT "WHAT A DODECAHEDRON IS, ASK SOMEONE)" -405 PRINT -410 PRINT " HAZARDS:" -415 PRINT " BOTTOMLESS PITS - TWO ROOMS HAVE BOTTOMLESS PITS IN THEM" -420 PRINT " IF YOU GO THERE, YOU FALL INTO THE PIT (& LOSE!)" -425 PRINT " SUPER BATS - TWO OTHER ROOMS HAVE SUPER BATS. IF YOU" -430 PRINT " GO THERE, A BAT GRABS YOU AND TAKES YOU TO SOME OTHER" -435 PRINT " ROOM AT RANDOM. (WHICH MAY BE TROUBLESOME)" -440 INPUT "HIT RETURN TO CONTINUE";A$ -445 PRINT " WUMPUS:" -450 PRINT " THE WUMPUS IS NOT BOTHERED BY HAZARDS (HE HAS SUCKER" -455 PRINT " FEET AND IS TOO BIG FOR A BAT TO LIFT). USUALLY" -460 PRINT " HE IS ASLEEP. TWO THINGS WAKE HIM UP: YOU SHOOTING AN" -465 PRINT "ARROW OR YOU ENTERING HIS ROOM." -470 PRINT " IF THE WUMPUS WAKES HE MOVES (P=.75) ONE ROOM" -475 PRINT " OR STAYS STILL (P=.25). AFTER THAT, IF HE IS WHERE YOU" -480 PRINT " ARE, HE EATS YOU UP AND YOU LOSE!" -485 PRINT -490 PRINT " YOU:" -495 PRINT " EACH TURN YOU MAY MOVE OR SHOOT A CROOKED ARROW" -500 PRINT " MOVING: YOU CAN MOVE ONE ROOM (THRU ONE TUNNEL)" -505 PRINT " ARROWS: YOU HAVE 5 ARROWS. YOU LOSE WHEN YOU RUN OUT" -510 PRINT " EACH ARROW CAN GO FROM 1 TO 5 ROOMS. YOU AIM BY TELLING" -515 PRINT " THE COMPUTER THE ROOM#S YOU WANT THE ARROW TO GO TO." -520 PRINT " IF THE ARROW CAN'T GO THAT WAY (IF NO TUNNEL) IT MOVES" -525 PRINT " AT RANDOM TO THE NEXT ROOM." -530 PRINT " IF THE ARROW HITS THE WUMPUS, YOU WIN." -535 PRINT " IF THE ARROW HITS YOU, YOU LOSE." -540 INPUT "HIT RETURN TO CONTINUE";A$ -545 PRINT " WARNINGS:" -550 PRINT " WHEN YOU ARE ONE ROOM AWAY FROM A WUMPUS OR HAZARD," -555 PRINT " THE COMPUTER SAYS:" -560 PRINT " WUMPUS: 'I SMELL A WUMPUS'" -565 PRINT " BAT : 'BATS NEARBY'" -570 PRINT " PIT : 'I FEEL A DRAFT'" -575 PRINT -580 RETURN -585 REM *** PRINT LOCATION & HAZARD WARNINGS *** -590 PRINT -595 FOR J = 2 TO 6 -600 FOR K = 1 TO 3 -605 IF S(L(1),K) <> L(J) THEN 640 -610 ON J-1 GOTO 615,625,625,635,635 -615 PRINT "I SMELL A WUMPUS!" -620 GOTO 640 -625 PRINT "I FEEL A DRAFT" -630 GOTO 640 -635 PRINT "BATS NEARBY!" -640 NEXT K -645 NEXT J -650 PRINT "YOU ARE IN ROOM ";L(1) -655 PRINT "TUNNELS LEAD TO ";S(L,1);" ";S(L,2);" ";S(L,3) -660 PRINT -665 RETURN -670 REM *** CHOOSE OPTION *** -675 PRINT "SHOOT OR MOVE (S-M)"; -680 INPUT I$ -685 IF (I$ <> "S") AND (I$ <> "S") THEN 700 -690 O = 1 -695 RETURN -700 IF (I$ <> "M") AND (I$ <> "M") THEN 675 -705 O = 2 -710 RETURN -715 REM *** ARROW ROUTINE *** -720 F = 0 -725 REM *** PATH OF ARROW *** -735 PRINT "NO. OF ROOMS (1-5)"; -740 INPUT J9 -745 IF J9 < 1 THEN 735 -750 IF J9 > 5 THEN 735 -755 FOR K = 1 TO J9 -760 PRINT "ROOM #"; -765 INPUT P(K) -770 IF K <= 2 THEN 790 -775 IF P(K) <> P(K-2) THEN 790 -780 PRINT "ARROWS AREN'T THAT CROOKED - TRY ANOTHER ROOM" -785 GOTO 760 -790 NEXT K -795 REM *** SHOOT ARROW *** -800 L = L(1) -805 FOR K = 1 TO J9 -810 FOR K1 = 1 TO 3 -815 IF S(L,K1) = P(K) THEN 895 -820 NEXT K1 -825 REM *** NO TUNNEL FOR ARROW *** -830 L = S(L,FNB(1)) -835 GOTO 900 -840 NEXT K -845 PRINT "MISSED" -850 L = L(1) -855 REM *** MOVE WUMPUS *** -860 GOSUB 935 -865 REM *** AMMO CHECK *** -870 A = A-1 -875 IF A > 0 THEN 885 -880 F = -1 -885 RETURN -890 REM *** SEE IF ARROW IS AT L(1) OR AT L(2) -895 L = P(K) -900 IF L <> L(2) THEN 920 -905 PRINT "AHA! YOU GOT THE WUMPUS!" -910 F = 1 -915 RETURN -920 IF L <> L(1) THEN 840 -925 PRINT "OUCH! ARROW GOT YOU!" -930 GOTO 880 -935 REM *** MOVE WUMPUS ROUTINE *** -940 K = FNC(0) -945 IF K = 4 THEN 955 -950 L(2) = S(L(2),K) -955 IF L(2) <> L THEN 970 -960 PRINT "TSK TSK TSK - WUMPUS GOT YOU!" -965 F = -1 -970 RETURN -975 REM *** MOVE ROUTINE *** -980 F = 0 -985 PRINT "WHERE TO"; -990 INPUT L -995 IF L < 1 THEN 985 -1000 IF L > 20 THEN 985 -1005 FOR K = 1 TO 3 -1010 REM *** CHECK IF LEGAL MOVE *** -1015 IF S(L(1),K) = L THEN 1045 -1020 NEXT K -1025 IF L = L(1) THEN 1045 -1030 PRINT "NOT POSSIBLE -"; -1035 GOTO 985 -1040 REM *** CHECK FOR HAZARDS *** -1045 L(1) = L -1050 REM *** WUMPUS *** -1055 IF L <> L(2) THEN 1090 -1060 PRINT "... OOPS! BUMPED A WUMPUS!" -1065 REM *** MOVE WUMPUS *** -1070 GOSUB 940 -1075 IF F = 0 THEN 1090 -1080 RETURN -1085 REM *** PIT *** -1090 IF L = L(3) THEN 1100 -1095 IF L <> L(4) THEN 1120 -1100 PRINT "YYYYIIIIEEEE . . . FELL IN PIT" -1105 F = -1 -1110 RETURN -1115 REM *** BATS *** -1120 IF L = L(5) THEN 1130 -1125 IF L <> L(6) THEN 1145 -1130 PRINT "ZAP--SUPER BAT SNATCH! ELSEWHEREVILLE FOR YOU!" -1135 L = FNA(1) -1140 GOTO 1045 -1145 RETURN -1150 END +1 REM from: http://www.dunnington.info/public/basicgames/WUMPUS.hp +2 REM extracted from HP library tape +5 OPTION DIALECT HP +10 REM- HUNT THE WUMPUS +20 PRINT "INSTRUCTIONS (Y-N)"; +30 INPUT I$ +40 IF I$="N" THEN 70 +50 GOSUB 1000 +60 REM- SET UP CAVE (DODECAHEDRAL NODE LIST) +70 DIM S[20,3] +80 FOR J=1 TO 20 +90 FOR K=1 TO 3 +100 READ S[J,K] +110 NEXT K +120 NEXT J +130 DATA 2,5,8,1,3,10,2,4,12,3,5,14,1,4,6 +140 DATA 5,7,15,6,8,17,1,7,9,8,10,18,2,9,11 +150 DATA 10,12,19,3,11,13,12,14,20,4,13,15,6,14,16 +160 DATA 15,17,20,7,16,18,9,17,19,11,18,20,13,16,19 +170 DEF FNA(X)=INT(20*RND(0))+1 +180 DEF FNB(X)=INT(3*RND(0))+1 +190 DEF FNC(X)=INT(4*RND(0))+1 +200 REM-LOCATE L ARRAY ITEMS +210 REM-1-YOU,2-WUMPUS,3&4-PITS,5&6-BATS +220 DIM L[6] +230 DIM M[6] +240 FOR J=1 TO 6 +250 L[J]=FNA(0) +260 M[J]=L[J] +270 NEXT J +280 REM-CHECK FOR CROSSOVERS (IE L(1)=L(2),ETC) +290 FOR J=1 TO 6 +300 FOR K=J TO 6 +310 IF J=K THEN 330 +320 IF L[J]=L[K] THEN 240 +330 NEXT K +340 NEXT J +350 REM-SET# ARROWS +360 A=5 +365 L=L[1] +370 REM-RUN THE GAME +375 PRINT "HUNT THE WUMPUS" +380 REM-HAZARD WARNINGS & LOCATION +390 GOSUB 2000 +400 REM-MOVE OR SHOOT +410 GOSUB 2500 +420 GOTO O OF 440,480 +430 REM-SHOOT +440 GOSUB 3000 +450 IF F=0 THEN 410 +460 GOTO 500 +470 REM-MOVE +480 GOSUB 4000 +490 IF F=0 THEN 390 +500 IF F>0 THEN 550 +510 REM-LOSE +520 PRINT "HA HA HA - YOU LOSE!" +530 GOTO 560 +540 REM-WIN +550 PRINT "HEE HEE HEE - THE WUMPUS'LL GETCHA NEXT TIME!!" +560 FOR J=1 TO 6 +570 L[J]=M[J] +580 NEXT J +590 PRINT "SAME SET-UP (Y-N)"; +600 INPUT I$ +610 IF I$#"Y" THEN 240 +620 GOTO 360 +1000 REM-INSTRUCTIONS +1010 PRINT "WELCOME TO 'HUNT THE WUMPUS'" +1020 PRINT " THE WUMPUS LIVES IN A CAVE OF 20 ROOMS. EACH ROOM" +1030 PRINT "HAS 3 TUNNELS LEADING TO OTHER ROOMS. (LOOK AT A" +1040 PRINT "DODECAHEDRON TO SEE HOW THIS WORKS-IF YOU DON'T KNOW" +1050 PRINT "WHAT A DODECAHEDRON IS, ASK SOMEONE)" +1060 PRINT +1070 PRINT " HAZARDS:" +1080 PRINT " BOTTOMLESS PITS - TWO ROOMS HAVE BOTTOMLESS PITS IN THEM" +1090 PRINT " IF YOU GO THERE, YOU FALL INTO THE PIT (& LOSE!)" +1100 PRINT " SUPER BATS - TWO OTHER ROOMS HAVE SUPER BATS. IF YOU" +1110 PRINT " GO THERE, A BAT GRABS YOU AND TAKES YOU TO SOME OTHER" +1120 PRINT " ROOM AT RANDOM. (WHICH MIGHT BE TROUBLESOME)" +1130 PRINT +1140 PRINT " WUMPUS:" +1150 PRINT " THE WUMPUS IS NOT BOTHERED BY THE HAZARDS (HE HAS SUCKER" +1160 PRINT " FEET AND IS TOO BIG FOR A BAT TO LIFT). USUALLY" +1170 PRINT " HE IS ASLEEP. TWO THINGS WAKE HIM UP: YOUR ENTERING" +1180 PRINT " HIS ROOM OR YOUR SHOOTING AN ARROW." +1190 PRINT " IF THE WUMPUS WAKES, HE MOVES (P=.75) ONE ROOM" +1200 PRINT " OR STAYS STILL (P=.25). AFTER THAT, IF HE IS WHERE YOU" +1210 PRINT " ARE, HE EATS YOU UP (& YOU LOSE!)" +1220 PRINT +1230 PRINT " YOU:" +1240 PRINT " EACH TURN YOU MAY MOVE OR SHOOT A CROOKED ARROW" +1250 PRINT " MOVING: YOU CAN GO ONE ROOM (THRU ONE TUNNEL)" +1260 PRINT " ARROWS: YOU HAVE 5 ARROWS. YOU LOSE WHEN YOU RUN OUT." +1270 PRINT " EACH ARROW CAN GO FROM 1 TO 5 ROOMS. YOU AIM BY TELLING" +1280 PRINT " THE COMPUTER THE ROOM#S YOU WANT THE ARROW TO GO TO." +1290 PRINT " IF THE ARROW CAN'T GO THAT WAY(IE NO TUNNEL) IT MOVES" +1300 PRINT " AT RANDOM TO THE NEXT ROOM." +1310 PRINT " IF THE ARROW HITS THE WUMPUS, YOU WIN." +1320 PRINT " IF THE ARROW HITS YOU, YOU LOSE." +1330 PRINT +1340 PRINT " WARNINGS:" +1350 PRINT " WHEN YOU ARE ONE ROOM AWAY FROM WUMPUS OR HAZARD," +1360 PRINT " THE COMPUTER SAYS:" +1370 PRINT " WUMPUS- 'I SMELL A WUMPUS'" +1380 PRINT " BAT - 'BATS NEARBY'" +1390 PRINT " PIT - 'I FEEL A DRAFT'" +1400 PRINT +1410 RETURN +2000 REM-PRINT LOCATION & HAZARD WARNINGS +2010 PRINT +2020 FOR J=2 TO 6 +2030 FOR K=1 TO 3 +2040 IF S[L[1],K]#L[J] THEN 2110 +2050 GOTO J-1 OF 2060,2080,2080,2100,2100 +2060 PRINT "I SMELL A WUMPUS!" +2070 GOTO 2110 +2080 PRINT "I FEEL A DRAFT" +2090 GOTO 2110 +2100 PRINT "BATS NEARBY!" +2110 NEXT K +2120 NEXT J +2130 PRINT "YOU ARE IN ROOM "L[1] +2140 PRINT "TUNNELS LEAD TO "S[L,1];S[L,2];S[L,3] +2150 PRINT +2160 RETURN +2500 REM-CHOOSE OPTION +2510 PRINT "SHOOT OR MOVE (S-M)"; +2520 INPUT I$ +2530 IF I$#"S" THEN 2560 +2540 O=1 +2550 RETURN +2560 IF I$#"M" THEN 2510 +2570 O=2 +2580 RETURN +3000 REM-ARROW ROUTINE +3010 F=0 +3020 REM-PATH OF ARROW +3030 DIM P[5] +3040 PRINT "NO. OF ROOMS(1-5)"; +3050 INPUT J9 +3060 IF J9<1 OR J9>5 THEN 3040 +3070 FOR K=1 TO J9 +3080 PRINT "ROOM #"; +3090 INPUT P[K] +3100 NEXT K +3110 REM-SHOOT ARROW +3120 A=A-1 +3130 L=L[1] +3140 FOR K=1 TO J9 +3150 FOR K1=1 TO 3 +3160 IF S[L,K1]=P[K] THEN 3295 +3170 NEXT K1 +3180 REM-NO TUNNEL FOR ARROW +3190 L=S[L,FNB(1)] +3200 GOTO 3300 +3210 NEXT K +3220 PRINT "MISSED" +3230 REM-MOVE WUMPUS +3240 GOSUB 3370 +3250 REM-AMMO CHECK +3260 IF A>0 THEN 3280 +3270 F=-1 +3280 RETURN +3290 REM-SEE IF ARROW IS AT L(1) OR L(2) +3295 L=P[K] +3300 IF L#L[2] THEN 3340 +3310 PRINT "AHA! YOU GOT THE WUMPUS!" +3320 F=1 +3330 RETURN +3340 IF L#L[1] THEN 3210 +3350 PRINT "OUCH! ARROW GOT YOU!" +3360 GOTO 3270 +3370 REM-MOVE WUMPUS ROUTINE +3380 K=FNC(0) +3390 IF K=4 THEN 3440 +3400 L[2]=S[L[2],K] +3410 IF L[2]#L THEN 3440 +3420 PRINT "TSK TSK TSK- WUMPUS GOT YOU!" +3430 F=-1 +3440 RETURN +4000 REM- MOVE ROUTINE +4010 F=0 +4020 PRINT "WHERE TO"; +4030 INPUT L +4040 IF L<1 OR L>20 THEN 4020 +4050 FOR K=1 TO 3 +4060 REM- CHECK IF LEGAL MOVE +4070 IF S[L[1],K]=L THEN 4130 +4080 NEXT K +4090 IF L=L[1] THEN 4130 +4100 PRINT "NOT POSSIBLE -"; +4110 GOTO 4020 +4120 REM-CHECK FOR HAZARDS +4130 L[1]=L +4140 REM-WUMPUS +4150 IF L#L[2] THEN 4220 +4160 PRINT "... OOPS! BUMPED A WUMPUS!" +4170 REM-MOVE WUMPUS +4180 GOSUB 3380 +4190 IF F=0 THEN 4220 +4200 RETURN +4210 REM-PIT +4220 IF L#L[3] AND L#L[4] THEN 4270 +4230 PRINT "YYYIIIIEEEE . . . FELL IN PIT" +4240 F=-1 +4250 RETURN +4260 REM-BATS +4270 IF L#L[5] AND L#L[6] THEN 4310 +4280 PRINT "ZAP--SUPER BAT SNATCH! ELSEWHEREVILLE FOR YOU!" +4290 L=FNA(1) +4300 GOTO 4130 +4310 RETURN +5000 END diff --git a/src/common/basic/compiler.ts b/src/common/basic/compiler.ts index 0d63cb20..9cc15cdf 100644 --- a/src/common/basic/compiler.ts +++ b/src/common/basic/compiler.ts @@ -1125,7 +1125,8 @@ export const HP_TIMESHARED_BASIC : BASICOptions = { ], validFunctions : [ 'ABS','ATN','BRK','COS','CTL','EXP','INT','LEN','LIN','LOG','NUM', - 'POS','RND','SGN','SIN','SPA','SQR','TAB','TAN','TIM','TYP','UPS$' // TODO: POS, + 'POS','RND','SGN','SIN','SPA','SQR','TAB','TAN','TIM','TYP','UPS$', // TODO: POS, + 'NFORMAT$', // non-standard, substitute for PRINT USING ], validOperators : [ '=', '<>', '<', '>', '<=', '>=', '+', '-', '*', '/', '^', diff --git a/src/common/basic/runtime.ts b/src/common/basic/runtime.ts index f39520ab..be81a150 100644 --- a/src/common/basic/runtime.ts +++ b/src/common/basic/runtime.ts @@ -34,6 +34,7 @@ function isArray(obj) { class RNG { next : () => number; seed : (aa,bb,cc,dd) => void; + seedfloat : (n) => void; randomize() { this.seed(Math.random()*0x7fffffff, Math.random()*0x7fffffff, Math.random()*0x7fffffff, Math.random()*0x7fffffff); } @@ -43,6 +44,10 @@ class RNG { this.seed = function(aa,bb,cc,dd) { a = aa; b = bb; c = cc; d = dd; } + this.seedfloat = function(n) { + this.seed(n, n*4294, n*429496, n*4294967296); + this.next(); this.next(); this.next(); + } this.next = function() { // sfc32 a >>>= 0; b >>>= 0; c >>>= 0; d >>>= 0; @@ -57,9 +62,7 @@ class RNG { } }; f(); - this.seed(0x12345678, 0xdeadbeef, 0xf0d3984e, 0xfeed3660); //default seed - this.next(); - this.next(); + this.seedfloat(-1); } }; @@ -75,6 +78,7 @@ export class BASICRuntime { datums : basic.Literal[]; builtins : {}; opts : basic.BASICOptions; + margin : number = 80; // number of columns curpc : number; dataptr : number; @@ -128,8 +132,8 @@ export class BASICRuntime { }); }); // try to resume where we left off after loading - this.curpc = this.label2pc[prevlabel] || 0; this.dataptr = Math.min(this.dataptr, this.datums.length); + this.curpc = this.label2pc[prevlabel] || 0; } reset() { @@ -338,37 +342,42 @@ export class BASICRuntime { valueToString(obj) : string { var str; if (typeof obj === 'number') { - var numstr = obj.toString().toUpperCase(); - if (this.opts.printZoneLength > 4) { - var numlen = this.opts.printZoneLength - 4; - var prec = numlen; - while (numstr.length > numlen) { - numstr = obj.toPrecision(prec--); - } - if (numstr.startsWith('0.')) - numstr = numstr.substr(1); - else if (numstr.startsWith('-0.')) - numstr = '-'+numstr.substr(2); - } + var numstr = this.float2str(obj, this.opts.printZoneLength - 4); if (!this.opts.numericPadding) - str = numstr; + return numstr; else if (numstr.startsWith('-')) - str = `${numstr} `; + return `${numstr} `; else - str = ` ${numstr} `; + return ` ${numstr} `; } else if (obj == '\n') { this.column = 0; str = obj; } else if (obj == '\t') { var curgroup = Math.floor(this.column / this.opts.printZoneLength); var nextcol = (curgroup + 1) * this.opts.printZoneLength; - str = this.TAB(nextcol); + if (nextcol >= this.margin) { this.column = 0; str = "\n"; } // return to left margin + else str = this.TAB(nextcol); // next column } else { str = `${obj}`; } return str; } + float2str(arg: number, numlen: number) : string { + var numstr = arg.toString().toUpperCase(); + if (numlen > 0) { + var prec = numlen; + while (numstr.length > numlen) { + numstr = arg.toPrecision(prec--); + } + if (numstr.startsWith('0.')) + numstr = numstr.substr(1); + else if (numstr.startsWith('-0.')) + numstr = '-'+numstr.substr(2); + } + return numstr; + } + printExpr(obj) { var str = this.valueToString(obj); this.column += str.length; @@ -411,7 +420,7 @@ export class BASICRuntime { } else if (expr.args) { // get array slice (HP BASIC) if (this.opts.arraysContainChars && expr.name.endsWith('$')) - s += `this.MID$(this.vars.${expr.name}, ${jsargs})`; + s += `this.getStringSlice(this.vars.${expr.name}, ${jsargs})`; else s += `this.arrayGet(${qname}, ${jsargs})`; } else { // just a variable @@ -606,9 +615,13 @@ export class BASICRuntime { return (v as any) as basic.Value; } - // for HP BASIC string slicing + // for HP BASIC string slicing (TODO?) modifyStringSlice(orig: string, add: string, start: number, end: number) : string { - return orig.substr(0, start-1) + add + orig.substr(end); + orig = orig || ""; + return (orig + ' '.repeat(start)).substr(0, start-1) + add + orig.substr(end); + } + getStringSlice(s: string, start: number, end: number) { + return s.substr(start-1, end+1-start); } checkOnGoto(value: number, labels: string[]) { @@ -1040,6 +1053,7 @@ export class BASICRuntime { } RND(arg : number) : number { // TODO: X<0 restart w/ seed, X=0 repeats + if (arg < 0) this.rng.seedfloat(arg); return this.rng.next(); } ROUND(arg : number) : number { @@ -1107,4 +1121,15 @@ export class BASICRuntime { var n = parseFloat(this.checkString(arg)); return isNaN(n) ? 0 : n; // TODO? altair works this way } + LPAD$(arg : string, len : number) : string { + while (arg.length < len) arg = " " + arg; + return arg; + } + RPAD$(arg : string, len : number) : string { + while (arg.length < len) arg = arg + " "; + return arg; + } + NFORMAT$(arg : number, numlen : number) : string { + return this.LPAD$(this.float2str(arg, numlen), numlen); + } } diff --git a/src/platform/basic.ts b/src/platform/basic.ts index b3cce101..308c2b9f 100644 --- a/src/platform/basic.ts +++ b/src/platform/basic.ts @@ -13,6 +13,7 @@ const BASIC_PRESETS = [ { id: '23match.bas', name: '23 Matches' }, { id: 'wumpus.bas', name: 'Hunt The Wumpus' }, { id: 'hamurabi.bas', name: 'Hammurabi' }, + { id: 'startrader.bas', name: 'Star Trader' }, ]; class BASICPlatform implements Platform { @@ -22,7 +23,7 @@ class BASICPlatform implements Platform { clock: number = 0; timer: AnimationTimer; tty: TeleTypeWithKeyboard; - hotReload: boolean = false; + hotReload: boolean = true; animcount: number = 0; constructor(mainElement: HTMLElement) { @@ -123,8 +124,9 @@ class BASICPlatform implements Platform { this.runtime.load(data); this.tty.uppercaseOnly = true; // this.program.opts.uppercaseOnly; //TODO? views.textMapFunctions.input = this.program.opts.uppercaseOnly ? (s) => s.toUpperCase() : null; - // only reset if we exited, otherwise we try to resume - if (!this.hotReload || didExit) this.reset(); + // only reset if we exited, or couldn't restart at label (PC reset to 0) + if (!this.hotReload || didExit || this.runtime.curpc == 0) + this.reset(); } getROMExtension() {