10 REM ********************************
14 REM *        STAR MERCHANT         *
18 REM *      BY LLOYD JOHNSON        *
22 REM *   ORIGINALLY PUBLISHED ON    *
26 REM *  "BIG COMPUTER GAMES" BOOK   *
30 REM *    BY DAVID H. AHL (1984)    *
32 REM *  PORTED BY LEONARDO MILIANI  *
36 REM *TO LM80C COLOR COMPUTER (2020)*
40 REM ********************************
50 REM *** INITIALIZATION ***
60 DIM A$(20),B$(8),A(5,4),D(10)
70 DIM H(20,4),P(14),S(6),T(10)
75 DIM MZ$(20)
80 SCREEN 0:COLOR 2,1:PRINT:PRINT TAB(13);"STAR MERCHANT"
90 PRINT:PRINT "You have just spent 2 million credits"
100 PRINT "on a 2 years lease for a merchant"
110 PRINT "starship. This leaves you with 2"
120 PRINT "million credits operating capital."
130 PRINT
140 PRINT "Your ship can hold a total of 20 cargos"
150 PRINT "with a total cargo weight of 200 tons."
160 PRINT "The fuel capacity of your ship is great"
170 PRINT "enough such that travel between any 2"
180 PRINT "starports is possible without"
190 PRINT "refueling."
200 GOSUB 5000:CLS
210 PRINT "You are presently traveling from Alpha"
220 PRINT "Centauri to Sol. You are carrying no"
230 PRINT "cargo."
240 PRINT
260 PRINT "The starport trade classification"
270 PRINT "determines the cargo price but does not"
280 PRINT "determine which cargos are available."
290 PRINT
300 PRINT "Abbreviations used for trade class are"
310 PRINT "as follows:"
320 PRINT "  R: Rich":PRINT "  P: Poor":PRINT "  I: Industrial"
330 PRINT "  NI: Non-Industrial":PRINT "  A: Agricultural"
340 PRINT "  NA: Non-Agricultural"
350 PRINT
370 GOSUB 5000
380 CLS:PRINT "Commands available are as follows:":PRINT
390 GOSUB 3420
395 PRINT:PRINT "Initializing game... please wait..."
400 PRINT "Creating initial data..."
410 R1=1
420 I=INT(RND(-ABS(TMR(0)))*500)+1
450 FOR J=1 TO I
460 D9=RND(R1)
470 NEXT J
480 DEF FNA(R1)=INT(6*RND(R1))+1
490 DEF FNB(N2)=INT(N2*RND(R1))+1
500 DEF FNC(R1)=FNA(R1)+FNA(R1)
510 B2=2000000
520 D(5)=4.3
530 S1=5
540 E1=50000
550 E2=100000
560 E3=500000
570 N2=36
580 N3=10
590 W1=200
600 W2=W1
610 PRINT "Generating items data...":FOR I=1 TO 20
620 H(I,1)=0
630 NEXT
640 GOSUB 3650
650 FOR I=1 TO 14
660 READ P(I)
670 NEXT
680 T5=0
690 T6=0
700 T7=0
710 PRINT "Generating stars data...":GOSUB 2310
720 REM *** Main Logic ***
730 IF RND(R1)>.01+5E-03*B2/E3 THEN 750
740 GOSUB 1120
750 PRINT
760 PRINT "   Account balance: ";:NM=B2:GOSUB 6000:PRINT NM$
765 PRINT " Empty cargo space: ";W2
770 PRINT "         Ship time:";INT(T6*1000)/1000;"years"
780 PRINT:INPUT "Enter command";C1$:C1=VAL(C1$)
790 IF C1>0 AND C1<7 AND C1=INT(ABS(C1)) THEN 820
800 CLS:GOSUB 3420
810 GOTO 720
820 ON C1 GOSUB 1310,1480,1650,1950,2090,2180
830 B3=B2+T1
840 IF B3<O THEN 960
850 IF T6-2*T5<2 THEN 720
860 PRINT
870 PRINT "The lease has expired on your ship."
880 IF B3<2000000 THEN 960
890 PRINT "Another lease will cost 2 million"
900 PRINT "credits."
910 INPUT "Do you wish to renew your lease (Y/N) ";A$
920 IF A$="N" OR A$="n" THEN 960
930 B2=B2-2000000
940 T5=T5+1
950 GOTO 720
960 REM *** End Program ***
970 G1=(B3-4000000)/T6
980 A$="loss"
990 IF G1<O THEN 1010
1000 A$="gain"
1010 IF B3>0 THEN 1040
1020 PRINT
1030 PRINT "You no longer have sufficient funds to"
1035 PRINT "operate your ship."
1040 PRINT
1050 PRINT "You began with 4 million credits and"
1060 IF B2<O THEN B2=0
1070 PRINT "now have";B2;"credits."
1080 PRINT "Cargo in the hold is worth";T1
1090 PRINT
1100 PRINT "This represents a ";A$;" of ";ABS(INT(G1*1000)/1000)
1105 PRINT "credits per year."
1110 GOTO 4690
1120 REM *** Strike sub ***
1130 PRINT
1140 PRINT "The crew has gone on strike! You are"
1150 PRINT "currently paying them";E3;"credits":PRINT "anually."
1160 E5=E3+.5*RND(R1)*E3
1170 PRINT "They are asking for";E5;"credits."
1180 N4=0
1190 E6=E3+N4*(E5-E3)/10
1200 PRINT
1210 INPUT "Enter counter offer";E7
1220 IF E7>=E5 THEN 1280
1230 IF E7<E6 THEN 1250
1240 IF (E5-E7)/(E5-E6)<RND(R1) THEN 1280
1250 PRINT "Offer rejected - try again"
1260 N4=N4+1
1270 GOTO 1190
1280 PRINT "Offer accepted."
1290 E3=E7
1300 RETURN
1310 REM *** List Hold ***
1320 PRINT "Cargo stored in hold:"
1330 IF W2<W1 THEN 1360
1340 PRINT "All partitions are empty."
1350 RETURN
1360 PRINT "Pt Description      AMT  Price     %"
1370 FOR I=1 TO 20
1380 RESTORE
1390 IF H(I,1)=0 THEN 1460
1400 FOR J=1 TO 19+H(I,1)
1410 READ A$
1420 NEXT J
1430 READ A$
1440 PRINT I;TAB(3);A$;TAB(20);H(I,3);
1450 PRINT TAB(25);H(I,2);TAB(35);H(I,4)
1460 NEXT I
1470 RETURN
1480 REM *** List Cargo for Sale ***
1490 CLS:PRINT "Cargos available for purchase:"
1500 IF N1>0 THEN 1530
1510 PRINT "All available cargos have been bought."
1520 RETURN
1530 PRINT "No Description       AMT  Price    %"
1540 FOR I=1 TO 5
1550 RESTORE
1560 IF A(I,1)=0 THEN 1630
1570 FOR J=1 TO 19+A(I,1)
1580 READ A$
1590 NEXT J
1600 READ A$
1610 PRINT I;TAB(3);A$;TAB(20);A(I,3);
1620 PRINT TAB(26);:NM=A(I,2):GOSUB 6000:PRINT NM$;TAB(34);A(I,4)
1630 NEXT I
1640 RETURN
1650 REM *** Buy Cargo Sub ***
1660 PRINT "Enter the lot number of cargo that you"
1665 INPUT "want to purchase";K
1670 IF K=ABS(INT(K)) AND K>O AND K<6 THEN 1700
1680 PRINT "Invalid lot number."
1690 RETURN
1700 IF A(K,1)>0 THEN 1730
1710 PRINT "Lot ";K;"has already been purchased."
1720 RETURN
1730 IF A(K,2)<=B2 THEN 1760
1740 PRINT "You can not buy cargo on credit."
1750 RETURN
1760 IF A(K,3)<=W2 THEN 1790
1770 PRINT "You do not have sufficient cargo space.";
1780 RETURN
1790 FOR I=1 TO 20
1800 IF H(I,1)=0 THEN 1840
1810 NEXT I
1820 PRINT "All 20 cargo partitions are occupied."
1830 RETURN
1840 FOR J=1 TO 4
1850 H(I,J)=A(K,J)
1860 NEXT J
1870 A(K,1)=0
1880 W2=W2-H(I,3)
1890 B2=B2-H(I,2)
1900 T6=T6+3E-03
1910 N1=N1-1
1920 PRINT:PRINT "Transaction completed"
1930 PRINT "Cargo stored in partition";I
1940 RETURN
1950 REM *** Sell Cargo Sub ***
1960 INPUT "Enter partition of cargo to be sold";K
1970 IF K=ABS(INT(K)) AND K>O AND K<21 THEN 2000
1980 PRINT "Invalid partition number"
1990 RETURN
2000 IF H(K,1)>0 THEN 2030
2010 PRINT "Cargo partition is empty."
2020 RETURN
2030 B2=B2+H(K,2)
2040 W2=W2+H(K,3)
2050 T6=T6+3E-03
2060 H(K,1)=0
2070 PRINT "Transaction completed"
2080 RETURN
2090 REM *** List Starports Sub ***
2100 PRINT "No.  Name            Trade   Cl   Ds Dir";
2110 RESTORE
2120 FOR I=1 TO 10
2130 READ A$,B$
2140 PRINT I;TAB(5);A$;TAB(21);B$;
2150 PRINT TAB(29);D(I);TAB(35);T(I)
2160 NEXT I
2170 RETURN
2180 REM *** Travel Sub ***
2190 IF B2>0 THEN 2220
2200 PRINT "You can not leave starport until all"
2205 PRINT "debts are cleared."
2210 RETURN
2220 PRINT "Enter destination star number";
2230 INPUT I
2240 IF I<>S1 THEN 2270
2250 PRINT "You are already at:";I
2260 RETURN
2270 IF I=ABS(INT(I)) AND I>0 AND I<N3+1 THEN 2300
2280 PRINT "Invalid star number"
2290 RETURN
2300 S1=I
2310 REM *** Get Star Trade & Location Data ***
2320 GOSUB 3510:PRINT "Loading stars data..."
2330 IF S1=1 THEN 2370
2340 FOR I=1 TO (S1-1)*3
2350 READ D9
2360 NEXT I
2370 READ X3,Y3,M1
2380 FOR I=1 TO 6
2390 M2=2^(6-I)
2400 S(I)=INT(M1/M2)
2410 M1=M1-S(I)*M2
2420 NEXT I
2430 REM *** Appraise Cargo in Hold ***
2440 T1=O
2450 FOR I=1 TO 20
2460 IF H(I,1)=0 THEN 2660
2470 GOSUB 3580
2480 IF H(I,1)=1 THEN 2520
2490 FOR J=1 TO (H(I,1)-1)*8
2500 READ D9
2510 NEXT J
2520 D2=0
2530 FOR J=1 TO 6
2540 READ D3
2550 D2=D2+D3*S(J)
2560 NEXT J
2570 READ B1
2500 P2=FNC(R1)+D2-1
2590 IF P2>1 THEN 2610
2600 P2=1
2610 IF P2<14 THEN 2630
2620 P2=14
2630 H(I,4)=P(P2)*100
2640 H(I,2)=P(P2)*B1*H(I,3)
2650 T1=T1+H(I,2)
2660 NEXT I
2670 REM *** Get Cargos for Sale ***
2675 PRINT "Loading cargos data..."
2680 N1=5
2690 FOR I=1 TO 5
2700 D2=0
2710 T2=FNB(N2)
2720 A(I,1)=T2
2730 GOSUB 3580
2740 IF T2=1 THEN 2780
2750 FOR J=1 TO (T2-1)*8
2760 READ D9
2770 NEXT J
2780 FOR J=1 TO 6
2790 READ D3
2800 D2=D2+D3*S(J)
2810 NEXT J
2820 P2=FNC(R1)+D2-1
2830 IF P2>1 THEN 2850
2840 P2=1
2850 IF P2<14 THEN 2870
2860 P2=14
2870 A(I,4)=P(P2)*100
2880 READ B1,Q1
2890 Q2=1
2900 IF T2<17 THEN 2940
2910 Q2=5
2920 IF T2<32 THEN 2940
2930 Q2=10
2940 Q3=0
2950 FOR J=1 TO Q1
2960 Q3=FNA(R1)*Q2+Q3
2970 NEXT J
2980 IF Q3>200 THEN Q3=200
2990 A(I,3)=Q3
3000 A(I,2)=B1*Q3*P(P2)
3010 NEXT I
3020 REM *** Dist. and Direction of Stars ***
3025 PRINT "Loading stars data..."
3030 D4=D(S1)
3040 GOSUB 3510
3050 FOR I=1 TO 10
3060 READ X1,Y1,D9
3070 X2=X1-X3
3080 Y2=Y1-Y3
3090 IF X2<>0 THEN 3150
3100 IF Y2<0 THEN 3130
3110 T(I)=90
3120 GOTO 3220
3130 T(I)=270
3140 GOTO 3220
3150 T(I)=ATN(Y2/X2)*180/3.14159
3160 IF X2>0 THEN 3180
3170 T(I)=T(I)+180
3180 IF T(I)<360 THEN 3200
3190 T(I)=T(I)-360
3200 IF T(I)>0 THEN 3220
3210 T(I)=T(I)+360
3220 D(I)=SQR(X2^2+Y2^2)
3230 NEXT I
3240 REM *** Arrival Expense and Star Name ***
3250 T6=T6+.02*D4+.02
3260 E4=(T6-T7)*E3
3270 T7=T6
3280 RESTORE
3290 IF S1=1 THEN 3330
3300 FOR I=1 TO S1-1
3310 READ A$,B$
3320 NEXT I
3330 READ A$,B$
3340 PRINT
3350 CLS:PRINT "You have arrived at ";A$;". ":PRINT
3360 PRINT "Expenses have been deducted as follows:"
3370 PRINT TAB(7)"Docking fee: ";:NM=E1:GOSUB 6000:PRINT NM$
3380 PRINT TAB(14) "Fuel: ";:NM=E2*D4:GOSUB 6000:PRINT NM$
3390 PRINT TAB(7) "Crew salary: ";:NM=E4:GOSUB 6000:PRINT NM$
3400 B2=B2-(E1+E2*D4+E4)
3410 RETURN
3420 PRINT "Command";TAB(12);"Description"
3430 PRINT TAB(3)"1";TAB(12);"List cargo in hold"
3440 PRINT TAB(3)"2";TAB(12);"List cargo which"
3445 PRINT TAB(12)"may be purchased"
3450 PRINT TAB(3)"3";TAB(12);"Buy cargo"
3460 PRINT TAB(3)"4";TAB(12);"Sell cargo"
3470 PRINT TAB(3)"5";TAB(12);"List starports"
3480 PRINT TAB(3)"6";TAB(12);"Travel to new star"
3490 PRINT " Other";TAB(12);"List available commands"
3500 RETURN
3510 REM *** Restore to Star Data Sub ***
3520 RESTORE
3530 FOR L=1 TO (2*N3+N2)
3540 READ A$
3550 NEXT L
3560 IF KQ=1 THEN KQ=0:GOTO 3600
3570 RETURN
3580 REM *** Restore to Cargo Data Sub ***
3590 KQ=1:GOTO 3510
3600 FOR L=1 TO 3*N3
3610 READ D9
3620 NEXT L
3630 IF LQ=1 THEN LQ=0:GOTO 3670
3640 RETURN
3650 REM *** Restore to Price Data Sub ***
3660 LQ=1:GOTO 3590
3670 FOR L=1 TO 8*N2
3680 READ D9
3690 NEXT L
3700 RETURN
3710 REM *** Star Names ***
3720 DATA "Lalande 21185","NI,P"
3730 DATA "Alpha Centauri","NA,I"
3740 DATA "Sirius","A"
3750 DATA "Barnards Star","I,P"
3760 DATA "Sol","R"
3770 DATA "Ross 154","NI,NA"
3780 DATA "Epsilon Eridani","A,P"
3790 DATA "Luyten 726-8","NA"
3800 DATA "Luyten 789-6","A,NI,P"
3810 DATA "Ross 248","A,I"
3820 REM *** Cargo Names ***
3830 DATA "Crystals"
3840 DATA "Radioactives"
3850 DATA "Alloys"
3860 DATA "Medicine"
3870 DATA "Gems"
3880 DATA "Aircraft"
3890 DATA "Grav sleds"
3900 DATA "Computers"
3910 DATA "ATV"
3920 DATA "AFV"
3930 DATA "Firearms"
3940 DATA "Ammunition"
3950 DATA "Plasma guns"
3960 DATA "Tools"
3970 DATA "Body armor"
3980 DATA "Farm machinery"
3990 DATA "Liquor"
4000 DATA "Silver"
4010 DATA "Spices"
4020 DATA "Electronics"
4030 DATA "Mechanical parts"
4040 DATA "Cybernetic parts"
4050 DATA "Computer parts"
4060 DATA "Machine tools"
4070 DATA "Space suits"
4080 DATA "Fruit"
4090 DATA "Textiles"
4100 DATA "Polymers"
4110 DATA "Meat"
4120 DATA "Petrochemicals"
4130 DATA "Grain"
4140 DATA "WCod"
4150 DATA "Copper"
4160 DATA "Tin"
4170 DATA "Steel"
4180 DATA "Aluminum"
4190 REM *** Star Data ***
4200 DATA 2.83,-7.36,20
4210 DATA -2.4,-3.56,9
4220 DATA 8.38,9.93,2
4230 DATA -6.1,0,24
4240 DATA 0,0,32
4250 DATA -8.87,2.05,5
4260 DATA 8.45,6.65,18
4270 DATA 2.99,7.42,1
4280 DATA -4.43,9.3,22
4290 DATA -.89,10.26,10
4300 REM *** Carga Data ***
4310 DATA 3,-2,2,-2,0,-4,20000,1
4320 DATA 0,1,4,-3,0,-2,1000000,1
4330 DATA -2,0,-4,6,1,-2,200000,1
4340 DATA -1,4,-4,3,-2,0,100000,1
4350 DATA 4,-2,4,-4,-1,1,1000000,1
4360 DATA -2,4,-3,3,1,-1,1000000,1
4370 DATA 2.0,-1,1,0,0,6000000,1
4380 DATA 1,0,-2,0,0,0,10000000,1
4390 DATA -2,2,-2, 1,1,0,300000,1
4400 DATA 0,2,-2,0,0,1,700000,1
4410 DATA -2,6,-4,1,0,0,30000,2
4420 DATA -1,6,-5,2,0,0,30000,2
4430 DATA -1,3,-2,0,0, 0,200000,2
4440 DATA -4,7,-8,4,5,0,10000,2
4450 DATA -3,6,-4,1,0,0,50000,2
4460 DATA -2,2,-6,0,6,-4,150000,1
4470 DATA 3,3,-1,0,-3,0,10000,1
4480 DATA 3,-1,3,-1,0,-2,70000,1
4490 DATA 4,-2,3,-1,-5,2,6000,1
4500 DATA 0,0,-4,4,1,,1,100000,1
4510 DATA 0,1,-3,3,2, 1,75000,1
4520 DATA 1,0,-4,2,1,0,250000,1
4530 DATA -1,0,-2,3,0,0,150000,1
4540 DATA 1,0,-2,1,0,0,750000,1
4550 DATA -1,2,-3,2,2,0,400000,1
4560 DATA 1,2,3,3,-4,6,1000,2
4570 DATA 3,0,-3,1,-5,-3,3000,3
4580 DATA -2,0,3,3,0,0,7000,4
4590 DATA 0,0,5,2,-5,5,1500,4
4600 DATA 2,0,4,-2,3,0,10000,6
4610 DATA 0,0,1,3,-5, 6,300,8
4620 DATA 0,0,1,2,-7,3,1000,2
4630 DATA 2,2,3,-2,-1,-4,2000,2
4640 DATA 2,2,3,-4,-1,-2,9000,3
4650 DATA -1,2,6,0,0,0,500,4
4660 DATA -1,1,3,-2,0,-2,1000,5
4670 REM *** Price Data ***
4680 DATA .4,.5,.7,.8,.9,1,1.1,1.2,1.3,1.5,1.7,2,3,4
4690 END
5000 PRINT:PRINT "Press any key to continue..."
5010 A=INKEY(10)
5020 A=INKEY(10):IF A=0 THEN 5020
5030 RETURN
6000 FOR TI=0 TO 20:MZ$(TI)="":NEXT:TP$=STR$(NM)
6010 SM=SGN(NM):A=0:TI=1
6020 IF MID$(TP$,TI,1)="E" THEN A=TI:GOTO 6080
6030 IF TI<LEN(TP$) THEN TI=TI+1:GOTO 6020
6040 IF A<>0 THEN 6080
6050 NM$=STR$(NM):IF LEFT$(NM$,1)<>" " THEN 6070
6060 MT$=RIGHT$(NM$,LEN(NM$)-1):NM$=MT$
6070 RETURN
6080 SE$=MID$(TP$,A+1)
6090 SE=VAL(SE$)
6100 MA$=LEFT$(TP$,A-1)
6110 MT$=RIGHT$(MA$,LEN(MA$)-1):MA$=MT$
6120 TI=0:TJ=1:A=0
6130 A$=MID$(MA$,TJ,1):IF A$="." THEN A=TJ:GOTO 6150
6140 MZ$(TI)=A$:TI=TI+1
6150 TJ=TJ+1:IF TJ<=LEN(MA$) THEN 6130
6160 IF SE>0 THEN EE=LEN(MA$)-A:GOTO 6180
6170 GOTO 6240
6180 IF EE<ABS(SE)+1 THEN EE=ABS(SE)-TI
6185 FOR TJ=TI TO TI+EE:MZ$(TJ)="0":NEXT
6190 NM$="":TI=0
6200 IF MZ$(TI)="" THEN 6230
6210 NM$=NM$+MZ$(TI):TI=TI+1:IF TI>20 THEN 6230
6220 GOTO 6200
6230 SM$="":IF SM<0 THEN SM$="-"
6235 NM$=SM$+NM$:RETURN
6240 TI=0
6250 IF MZ$(TI)<>"" THEN TI=TI+1:GOTO 6250
6260 SM$="":IF SM<0 THEN SM$="-"
6270 NM$=SM$+"0."
6280 FOR TJ=2 TO ABS(SE)-1:NM$=NM$+"0":NEXT
6290 FOR TJ=0 TO TI:NM$=NM$+MZ$(TJ):NEXT
6300 RETURN

