home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / BEEHIVE / GAMES / STARSHIP.ARC / STARCHN.PAS < prev    next >
Pascal/Delphi Source File  |  1989-09-27  |  5KB  |  165 lines
  1. program starchain;
  2.  
  3.  
  4. const
  5.    maxcargo=36;{most allowable cargo types}
  6.    forsalenum=5;{cargoes avail. at each port}
  7.    forsaleplus=10;
  8.    holdnum=20; {number of partitions}
  9.    complement=20; {starting crew}
  10.    probestart=2;
  11.    boatstart=1;
  12.    hullstart=3;
  13.    speedstart=10;
  14.    laserstart=2;
  15.    creditstart=2E5;
  16.    spacestart=200;
  17.    moralestart=100;
  18.    chance=10; {chance of encounter}
  19.    danger=10; {chance of meeting bandits}
  20.    starmax=10;{number of stars}
  21.  
  22. type
  23.    cargotype= record
  24.       cargoname: string[16];
  25.       rfactor,pfactor,ifactor,nifactor,afactor,nafactor: integer;
  26.       unitprice: real;
  27.       weight: byte;
  28.       end;
  29.    cargo= record
  30.       category: byte;
  31.       aunitnumber: byte;
  32.       acargoname: string[16];
  33.       aprice: real;
  34.       aweight: integer;
  35.       arfactor,apfactor,aifactor,anifactor,aafactor,anafactor: integer;
  36.       percent: real;
  37.       end;
  38.  
  39.    startrade=record
  40.       starname: string[15];
  41.       r,p,i,ni,a,na: boolean;
  42.       end;
  43.  
  44. var
  45.    cargorange: array[1..maxcargo] of cargotype;
  46.    thiscargo: cargo;
  47.    availnow: array[1..forsaleplus] of cargo;
  48.    holdnow: array[1..holdnum] of cargo;
  49.    chnfile: file;
  50.    thiscargotype: cargotype;
  51.    filename: string[14]; {used for other jobs too}
  52.    index,jndex,kndex,mndex,cargonum,star,thistar,realstar,
  53.      triplength,gamelength: byte;{the 'indices' are used for all work}
  54.    speed,tspeed,cspeed,hull,thull,chull,probes,boats,laser,tlaser,claser,
  55.       crew: byte;      {ship vars}
  56.    drivecrew, lasercrew, hullcrew, space,morale,moralebounce: integer;
  57.    num,trial,inp: integer;{input and calc}
  58.    yorn: char;
  59.    galaxytrade: array[1..starmax] of startrade;
  60.    distance: array[1..starmax] of byte;
  61.    angle: array[1..starmax] of integer;
  62.    been: array[1..starmax] of boolean;
  63.    t,dt,credits,realvar,salary: real;
  64.    name: string[25];
  65.    stringvar:string[16];
  66.    alienmatch: array[0..4] of byte;
  67.    probehere,boathere,navy,messageflag,autodoc,assignment,roll,
  68.    prize: boolean;
  69. (*----------------------------------------------------*)
  70. var
  71.    OrigEpower:byte;
  72.    Epower: integer;
  73.    action,battle,newship,nomessage,moraleflag,local6:boolean;
  74.    traderflag,quitter:boolean;
  75.    badguys:boolean;   {not shared w/ starship}
  76.    objectcount,docks:byte;    {"}
  77.    local1,local7,leave:boolean;   {not shared with starship or e}
  78. {$R+}
  79.  
  80. function fishrule(var numnum: integer):real;
  81. begin         {this untidy process converts an index to a multiplier}
  82. case numnum of
  83.    1:fishrule:=40;
  84.    2:fishrule:=50;
  85.    3:fishrule:=70;
  86.    4:fishrule:=80;
  87.    5:fishrule:=90;
  88.    6:fishrule:=100;
  89.    7:fishrule:=110;
  90.    8:fishrule:=120;
  91.    9:fishrule:=130;
  92.    10:fishrule:=150;
  93.    11:fishrule:=170;
  94.    12:fishrule:=200;
  95.    13:fishrule:=300;
  96.    14:fishrule:=400;
  97.    end;
  98. end;{function fishrule}
  99.  
  100.  
  101. {$I estar.pro}{info routines, numeric input sub}
  102. {$I star1.pro}{cargo subs}
  103. {$I star2.pro}{arrival routines}
  104. {$I star3.pro}{main menu}
  105.  
  106.  
  107. begin{main}
  108. ErrorPtr:=addr(error);
  109. quitter:=false;
  110. assign(chnfile,'E.CHN');
  111. if traderflag=true then
  112.    begin
  113.    trader2;
  114.    chain(chnfile);
  115.    end;
  116. arrive;
  117. while (t>0) and (not quitter) do command;{play til time expires or player quits}
  118. if (not quitter) and (crew>0) then writeln('Your lease has expired'); {then end}
  119. for index:=1 to holdnum do
  120.    if holdnow[index].category<>0 then credits:=credits+holdnow[index].aprice;
  121. write('after selling your remaining cargo you have ');
  122. format(credits);
  123. writeln;
  124. credits:=credits-(gamelength*1E5+creditstart);
  125. write('minus debt of ');
  126. format(gamelength*1E5+creditstart);
  127. writeln;
  128. credits:=credits+(boats-boatstart)*4E4+(probes-probestart)*6E4;
  129. if boats>boatstart then writeln('plus 40,000 for each extra small craft');
  130. if probes>probestart then writeln('plus 60,000 for each extra probe');
  131. if boats<boatstart then writeln('less 40,000 credits for each missing boat');
  132. if probes<probestart then writeln('minus 60,000 credits each to replace probes');
  133. if autodoc=true then
  134.    begin
  135.    writeln('plus one million for the autodoc');
  136.    credits:=credits+1E6;
  137.    end;{ifthen}
  138. write('GRAND TOTAL ');
  139. format(credits);
  140. writeln(' credits');
  141. realvar:=1E7*(gamelength-1);
  142. if credits>realvar then
  143.    begin
  144.    writeln('You can''t fool me. You wrote this game.');
  145.    halt;
  146.    end;
  147. if credits*1.4>realvar then
  148.    begin
  149.    writeln('How''d you do that?');
  150.    halt;
  151.    end;
  152. if credits*1.7>realvar then
  153.    begin
  154.    writeln('An outstanding accomplishment');
  155.    halt;
  156.    end;
  157. if credits*2>realvar then
  158.    begin
  159.    writeln('You''re becoming an expert trader');
  160.    halt;
  161.    end;
  162. if credits*2.5>realvar then writeln('Now you can retire');
  163. if credits<0 then writeln('You may have some trouble getting the next loan');
  164. end.
  165.