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 / STAR1.PRO < prev    next >
Text File  |  1989-09-27  |  8KB  |  271 lines
  1. {   This file contains the cargo routines for the trading game STARSHIP}
  2. {They are: forsale, buy, sell, showhold, showforsale}
  3. {This is a turbo pascal source file}
  4.  
  5. procedure evaluate;
  6. begin
  7. for index:=1 to holdnum do if holdnow[index].category<>0 then
  8.   begin
  9.   with holdnow[index],galaxytrade[star] do
  10.      begin
  11.      num:=random(7)+random(5)+2;
  12. (**) if (index=7) or (index=24) or (index=8) then num:=5+random(5);
  13.      if r then num:=num+arfactor;
  14.      if p then num:=num+apfactor;
  15.      if i then num:=num+aifactor;
  16.      if ni then num:=num+anifactor;
  17.      if a then num:=num+aafactor;
  18.      if na then num:=num+anafactor;
  19.      if num<1 then num:=1;
  20.      if num>14 then num:=14;
  21.      aprice:=aprice/(percent/100);{restore price to par}
  22.      realround(aprice);
  23.      percent:=fishrule(num);
  24.      aprice:=aprice*(percent/100);
  25.      end;{with}
  26.    end;{ifthen after fordo}
  27. end;{procedure evaluate}
  28.  
  29. procedure strike;
  30. begin
  31. writeln;
  32. if salary>0.2*credits then exit;
  33. if (salary>0.05*credits) and (morale>100) and (random>0.3) then exit;
  34. writeln('Your crew has gone on strike');
  35. salary:=(random*random*random*salary*100/morale)+salary;
  36. write('They demand ');
  37. format(salary);
  38. writeln(' credits a year');
  39. morale:=morale-1;
  40. moralebounce:=moralebounce-1;
  41. writeln;
  42. end;{procedure strike}
  43.  
  44. procedure lifeboats;
  45. begin
  46. writeln('You can always sell probes and lifeboats, and sometimes buy.');
  47. writeln('Lifeboats cost forty thousand credits each, and sell for twenty.');
  48. writeln('Probes cost sixty thousand, and sell for ten');
  49. writeln(name,' now has ',boats,' small craft and ',probes,' probes.');
  50. writeln('Will you:');
  51. writeln('1. buy a lifeboat, 2. sell one, 3. buy a probe, 4. sell one, or 5. nothing');
  52. inputs;
  53. jndex:=inp;
  54. case jndex of
  55.    1: begin
  56.          if boathere=true then begin
  57.          credits:=credits-4E4;
  58.          boats:=boats+1;
  59.          writeln('you now have ',boats,' boats');
  60.          end
  61.       else writeln('no boats here');
  62.       end;{case 1}
  63.    2: begin
  64.          if boats>0 then begin
  65.          boats:=boats-1;
  66.          writeln('you now have ',boats,' boats');
  67.          credits:=credits+20000;
  68.          end
  69.       else writeln('you have no boats to sell');
  70.       end; {case 2}
  71.    3: begin
  72.          if probehere=true then begin
  73.          credits:=credits-6E4;
  74.          probes:=probes+1;
  75.          writeln('you now have ',probes,' probes');
  76.          end
  77.       else writeln('no probes for sale');
  78.       end;{case 3}
  79.    4: begin
  80.          if probes>0 then begin
  81.          probes:=probes-1;
  82.          writeln('you now have ',probes,' probes');
  83.          credits:=credits+10000;
  84.          end
  85.       else writeln('no probes aboard the ',name);
  86.       end;{case 4}
  87.    5: ;
  88.    else writeln(chr(7),'wrong input, leaving lifeboat routine');
  89.    end;{case}
  90. end;{lifeboats}
  91.  
  92. procedure showstars;
  93. begin
  94. writeln('                                        distance   angle  visited?');
  95. for index:=1 to starmax do with galaxytrade[index] do
  96.    begin
  97.    if index<10 then write(' ');
  98.    write(index);
  99.    write(' ',starname,' ');
  100.    mndex:=0;
  101.    if r=true then begin write('R '); mndex:=mndex+2; end;
  102.    if p=true then begin write('P '); mndex:=mndex+2; end;
  103.    if a=true then begin write('A '); mndex:=mndex+2; end;
  104.    if na=true then begin write('NA '); mndex:=mndex+3; end;
  105.    if i=true then begin write('I '); mndex:=mndex+2; end;
  106.    if ni=true then begin write('NI '); mndex:=mndex+3; end;
  107.    for jndex:=mndex to 21 do write('.');
  108.    jndex:=distance[index];          {new use of jndex}
  109.    num:=angle[index];
  110.    if index<>thistar then write(jndex:3,'         ',num:3)
  111.       else write('You are here');
  112.    if been[index]=false then write('      **');
  113.    writeln;
  114.    end;{with}
  115. writeln('you have not been to stars marked "**"');
  116. end;{showstars}
  117.  
  118. procedure forsale;
  119. begin
  120. writeln('  CARGOS FOR SALE  **   CARGOS FOR SALE');
  121. writeln('       dock # and cargo |     price    | weight |  %of par value');
  122. docks:=forsalenum;
  123. if local6=true then docks:=docks+5;
  124. for index:=1 to docks do
  125.   begin
  126.   jndex:=random(cargonum)+1;
  127.   with cargorange[jndex], availnow[index] do
  128.      begin
  129.      category:=jndex;
  130.      acargoname:=cargoname;
  131.      aunitnumber:=(random(8)+1);
  132. (**) { bad programing warning! this should depend on the cargo file}
  133. (**) if jndex>27 then aunitnumber:=aunitnumber+3;
  134. (**) if jndex>13 then aunitnumber:=aunitnumber*5;
  135.      aprice:=unitprice*aunitnumber;
  136.      aweight:=weight*aunitnumber;
  137.      arfactor:=rfactor;
  138.      apfactor:=pfactor;
  139.      aifactor:=ifactor;
  140.      anifactor:=nifactor;
  141.      aafactor:=afactor;
  142.      anafactor:=nafactor;
  143.      end;{with}
  144.   with availnow[index],galaxytrade[star] do {adjust for local prices}
  145.      begin
  146.      num:=random(5)+random(5)+random(4)+1;
  147. (**) if (index=7) or (index=24) or (index=8) then num:=5+random(5);
  148. {7=sleds, 8=computers, 24=machine tools}
  149.      if r=true then num:=num+arfactor;
  150.      if p=true then num:=num+apfactor;
  151.      if i=true then num:=num+aifactor;
  152.      if ni=true then num:=num+anifactor;
  153.      if a=true then num:=num+aafactor;
  154.      if na=true then num:=num+anafactor;
  155.      if num<1 then num:=1;
  156.      if num>14 then num:=14;
  157.      percent:=fishrule(num);
  158.      realround(aprice);
  159.      aprice:=aprice*(percent/100);
  160.      write('          ',index,' ',acargoname);
  161.      format(aprice);
  162.      writeln(aweight:5,percent:8:0,'%');
  163.      end;{with}
  164.   end;{fordo}
  165. end;{forsale}
  166.  
  167. procedure buy;
  168. begin
  169. index:=0;         {find an empty hold}
  170. repeat
  171.    index:=index+1;
  172.    if (index=holdnum) and (holdnow[index].category<>0) then
  173.       begin
  174.       writeln(chr(7),'no empty holds');
  175.       exit;
  176.       end;{ifthen}
  177.    until holdnow[index].category=0;
  178. writeln('buy which cargo?');
  179. inputs;
  180. if (inp<1) or (inp>docks) then begin
  181.    writeln(chr(7),'wrong number');
  182.    exit;
  183.    end;{ifthen}
  184. with availnow[inp] do
  185.    begin
  186.    if aweight>space then
  187.       begin
  188.       writeln(chr(7),'too heavy for the ',name,' to lift');
  189.       exit;
  190.       end;{ifthen}
  191.    if category=0 then writeln(chr(7),'you already bought that cargo')
  192.    else begin
  193.       if aprice>credits then
  194.          begin
  195.          writeln(chr(7),'not enough cash');
  196.          exit
  197.          end;{ifthen on aprice}
  198.       credits:=credits-aprice;
  199.       space:=space-availnow[inp].aweight;
  200.       holdnow[index]:=availnow[inp];
  201.       availnow[inp].category:=0;
  202.       t:=t-0.003;
  203.       end;{else}
  204.    end;{with}
  205. end;{procedure buy}
  206.  
  207. procedure sell;
  208. begin
  209. writeln('Which hold number will you sell?');
  210. inputs;
  211. if (inp>holdnum) or (inp<1) then
  212.    begin
  213.    writeln(chr(7),'no such hold number');
  214.    exit;
  215.    end;{ifthen}
  216. if holdnow[inp].category=0 then writeln(chr(7),'No cargo in that hold.')
  217. else
  218.    begin
  219.    holdnow[inp].category:=0;
  220.    credits:=credits+holdnow[inp].aprice;
  221.    space:=space+holdnow[inp].aweight;
  222.    writeln('Your supercargo reports the transaction completed.');
  223.    t:=t-0.003;
  224.    end;{else}
  225. end;
  226.  
  227. procedure showhold;
  228. begin
  229. writeln('Cargos stored in hold.........');
  230. writeln('hold # and cargo |    price   | weight |  %of par value');
  231. messageflag:=true;
  232. for index:=1 to 20 do
  233.    begin
  234.    with holdnow[index] do
  235.       if category>0 then
  236.          begin
  237.          write(index:2,' ',acargoname);
  238.          format(aprice);
  239.          writeln(aweight:5,percent:8:0,'%');
  240.          messageflag:=false;
  241.          end;{ifthen}
  242.    end;{fordo}
  243. if messageflag=true then
  244.    begin
  245.    writeln('All cargo spaces are empty.');
  246.    if credits<(-10000*probes-20000*boats) then begin
  247.       writeln('And you are bankrupt. Better luck in some other profession.');
  248.       halt;
  249.       end;{ifthen on credits}
  250.    end;{ifthen on messageflag}
  251. end;{showhold}
  252.  
  253. procedure showforsale;
  254. begin
  255. writeln('  CARGOS FOR SALE  **   CARGOS FOR SALE');
  256. writeln('       dock # and cargo    |    price   | weight |  %of par value');
  257. messageflag:=true;
  258. for index:=1 to docks do
  259.    begin
  260.      with availnow[index] do
  261.         if category>0 then
  262.            begin
  263.            messageflag:=false;
  264.              write('          ',index:2,' ',acargoname);
  265.              format(aprice);
  266.              writeln(aweight:5,percent:8:0,'%');
  267.            end;{ifthen}
  268.    end;{fordo}
  269. if messageflag=true then writeln('Nothing left for sale.');
  270. end;{showforsale}
  271.