home *** CD-ROM | disk | FTP | other *** search
/ Game Killer / Game_Killer.bin / 285.PORTDISP.INC < prev    next >
Text File  |  1991-07-08  |  8KB  |  247 lines
  1. function compatible( i1, i2 : stuff; greed : boolean ) : boolean;
  2. { if each sells something the other buys; if greed is true, only org/equip
  3. trades. }
  4. begin
  5.   if i2 = -1 then
  6.     compatible := false
  7.   else if not greed then
  8.     case i1 of
  9.       Class0, 0, 7 : compatible := false;
  10.       1 : compatible := i2 in [2, 4, 6];
  11.       2 : compatible := i2 in [1, 4, 5];
  12.       3 : compatible := i2 in [4, 5, 6];
  13.       4 : compatible := i2 in [1, 2, 3];
  14.       5 : compatible := i2 in [2, 3, 6];
  15.       6 : compatible := i2 in [1, 3, 5];
  16.     end {case}
  17.   else
  18.     case i1 of
  19.       Class0, 0, 1, 6, 7 : compatible := false;
  20.       2, 3 : compatible := i2 in [4,5];
  21.       4, 5 : compatible := i2 in [2,3];
  22.     end; {case}
  23. end;
  24.  
  25. function deal( good1, good2 : stuff ) : string;
  26. { Port type "good1" selling to port type "good2" }
  27. const
  28.   ND = 'no deal';
  29.   F  = 'Fuel Ore';
  30.   O  = 'Organics';
  31.   Q  = 'Equipment';
  32.   any = 'anything';
  33.  
  34. begin
  35.   deal := ND;
  36.   case good1 of
  37.     Class0, 0 : ;  {error}
  38.         1 : if good2 in [0,2,4,6] then deal := F;
  39.         2 : if good2 in [0,1,4,5] then deal := O;
  40.         3 : if good2 in [0,4] then deal := O + ' or ' + F
  41.             else if good2 in [1,5] then deal := O
  42.             else if good2 in [2,6] then deal := F;
  43.         4 : if good2 in [0,1,2,3] then deal := Q;
  44.         5 : if good2 in [0,2] then deal := Q + ' or ' + F
  45.             else if good2 in [1,3] then deal := Q
  46.             else if good2 in [4,6] then deal := F;
  47.         6 : if good2 in [0,1] then deal := Q + ' or ' + O
  48.             else if good2 in [2,3] then deal := Q
  49.             else if good2 in [4,5] then deal := O;
  50.         7 : case good2 of
  51.                Class0,7 : ; {error}
  52.                0 : deal := any;
  53.                1 : deal := Q + ' or ' + O;
  54.                2 : deal := Q + 'or ' + F;
  55.                3 : deal := Q;
  56.                4 : deal := O + ' or ' + F;
  57.                5 : deal := O;
  58.                6 : deal := F;
  59.              end; {case 7}
  60.         end; {case}
  61. end; {deal}
  62.  
  63. function letterOfGood( g : goods ) : char;
  64. begin
  65.   case g of
  66.     fuel      : LetterOfGood := 'F';
  67.     Organics  : LetterOfGood := 'O';
  68.     Equipment : LetterOfGood := 'E';
  69.   end; {case}
  70. end; {letterOfGood}
  71.  
  72. procedure ComputeStores( psell, pbuy : PortIndex; var f : real;
  73.                          which : goods; dump : boolean; var into : text);
  74. var
  75.   level1, level2 : integer;
  76.   mss : string;
  77. begin
  78.   level1 := space.ports.data[ psell ].amts[ which ];
  79.   level2 := space.ports.data[ pbuy ].amts[ which ];
  80.   mss := letterOfGood( which ) + ':' + str( level1, 5) + ' to ' + 
  81.          str( level2, 4) + '  ';
  82.   write( mss );
  83.   if dump then
  84.     write( into, mss );
  85.   f := -minreal( -f, -minreal( level1, -level2 ) );
  86. end; {ComputeStores}
  87.  
  88. procedure DisplayStores( psell, pbuy : PortIndex; s : string;
  89.                         var f : real;
  90.                         EOonly, Dump : boolean;  var T : text );
  91. { we are given two ports, and a string s that represents the goods we are
  92. going to be trading there.  For each good in s compute the minimum of
  93. the stores we have to sell and amount to purchase, and store the maximum in f,
  94. while also displaying the quantities the port holds. }
  95. begin
  96.   f := 0;
  97.   if not EOonly then
  98.     if pos( 'Fuel', s ) > 0 then
  99.       ComputeStores( psell, pbuy, f, Fuel, Dump, t );
  100.   if pos( 'Organic', s ) > 0 then
  101.     ComputeStores( psell, pbuy, f, Organics, Dump, t );
  102.   if pos( 'Equip', s ) > 0 then
  103.     ComputeStores( psell, pbuy, f, Equipment, Dump, t );
  104. end; {DisplayStores}
  105.  
  106. procedure PortTradeFactor( s1, s2 : sector;
  107.                            items12, items21 : string;
  108.                            EOonly, FileDump : boolean;
  109.                        var DumpFile : text );
  110. { Print port information from these two ports corresponding to trading
  111.   items from 1 to 2 and from 2 to 1; compute relative factor. }
  112. var
  113.   p1, p2 : PortIndex;
  114.   factor1, factor2 : real;
  115.   line : string;
  116. begin
  117.   p1 := PortNumber( s1 );
  118.   p2 := PortNumber( s2 );
  119.   if (p1 = 0) or (p2 = 0) then
  120.     begin
  121.       if p1 = 0 then
  122.         line := 'No info available for ' + str( s1 , 1)
  123.       else if p2 = 0 then
  124.         line := 'No info available for ' +  str( s2, 1 );
  125.       writeln( line );
  126.       if Filedump then
  127.         writeln( Dumpfile, line );
  128.     end
  129.   else
  130.     begin
  131.       write( 'Quantities: ' );
  132.       if FileDump then
  133.         write(DumpFile, 'Quantities: ');
  134.       DisplayStores( p1, p2, items12, factor1, EOonly, FileDump, DumpFile);
  135.       DisplayStores( p2, p1, items21, factor2, EOonly, FileDump, DumpFile);
  136.       writeln(' Factor: ', round( sqrt( factor1 * factor2 ) ) );
  137.       if FileDump then
  138.         writeln(DumpFile,' Factor: ', round( sqrt( factor1 * factor2 ) ) );
  139.     end; {else}
  140. end; {PortTradeFactor}
  141.  
  142. procedure AddEtc( s : sector; var line : string );
  143. { add special information to code Fighters there or SpaceLane there }
  144. begin
  145.   if space.sectors[s].etc and HasFighters <> nothing then
  146.     line := line + '*'
  147.   else if space.sectors[s].etc and SpaceLane <> nothing then
  148.     line := line + '\';
  149. end; {AddEtc}
  150.  
  151. procedure DisplayLotsOfPortStuff( s, s1, WhichDistanceIndex : sector;
  152.                                   logging, AsciiDump, showLevels, EquipOnly : boolean;
  153.                                   var f, h : text);
  154. var
  155.   g, g1 : stuff;
  156.   line  : string;
  157. begin
  158.   if logging then
  159.     begin
  160.       writeln( h, 'R', s );
  161.       writeln( h, 'R', s1);
  162.     end; {log}
  163.   g := space.sectors[s].portType;
  164.   g1 := space.sectors[s1].portType;
  165.   line := '(' + str( s, 3);
  166.   AddEtc( s, line );
  167.   line := line + ' & ' + str(s1,3);
  168.   AddEtc( s1, line );
  169.   line := line + ' ) at distance ' + str( distances[WhichDistanceIndex].d,3)
  170.           + ' trading ' +  deal( g, g1) + ' for ' +
  171.            deal( g1, g );
  172.   writeln( line );
  173.   if AsciiDump then
  174.     writeln( f, line );
  175.   if ShowLevels then
  176.     PortTradeFactor( s, s1, deal( g, g1), deal( g1, g ),
  177.                      EquipOnly, AsciiDump, f );
  178. end; {Display Lots of Port Stuff}
  179.  
  180. procedure SearchPairs( NumPorts : integer;
  181.                        logging : boolean; var h : text;
  182.                        asciiDump : boolean; var f : text;
  183.                        EquipOnly, ShowLevels : boolean );
  184. var
  185.   i         : integer;
  186.   s, s1     : sector;
  187.   g, g1     : stuff;
  188.   t         : warpIndex;
  189.   NumPairs  : integer;
  190.   PauseAt   : integer;
  191.   line      : string;
  192.  
  193. begin
  194.   NumPairs := 0;
  195.   if ShowLevels then
  196.     PauseAt := 10
  197.   else
  198.     PauseAt := 20;
  199.   for i := 1 to NumPorts do
  200.     begin
  201.       s := distances[ i ].s;
  202.       if space.sectors[s].number <> Unexplored then
  203.         for t := 1 to space.sectors[s].number do
  204.           begin
  205.             s1 := space.sectors[s].data[t];
  206.             if  (space.sectors[ s1].portType <> NotAPort )
  207.                 and (s < s1) and IsWarp( s1, s) then
  208.                 { must be a port; print only once; check if can get back }
  209.               if compatible( space.sectors[s].portType, space.sectors[s1].portType, EquipOnly ) then
  210.                 begin
  211.                   DisplayLotsOfPortStuff(s, s1, i, logging, asciidump, 
  212.                                         showlevels, EquipOnly, f, h);
  213.                   NumPairs := NumPairs + 1;
  214.                   if numPairs mod PauseAt = 0 then
  215.                     if not prompt('more? ') then
  216.                       exit;
  217.                 end; {if if}
  218.           end; {for t}
  219.     end; {for i}
  220. end; {SearchPairs}
  221.  
  222. procedure pairport;
  223. var
  224.   s        : sector;
  225.   QuantInfo,
  226.   Greedy   : boolean;
  227.   NumSectors : integer;
  228.   AsciiDump,
  229.   loggit   : boolean;
  230.   h, fp    : text;
  231. begin
  232.   SortPorts( NumSectors );
  233.   SortDistances( distances, NumSectors );
  234.   QuantInfo := prompt('Do you want to see port quantity information? ');
  235.   greedy := prompt('Do you want to only see Equip/Organic trades? ');
  236.   loggit := LogToDisk( h,
  237.         'Do you want to log the results in a format suitable for upload? ',
  238.         BBSname+'.upl' );
  239.   AsciiDump := LogToDisk( fp,
  240.         'Do you want an echo of the results to an ascii file? ',
  241.         BBSName+'.txt');
  242.   SearchPairs( NumSectors, Loggit, h, AsciiDump, fp, greedy, QuantInfo );
  243.   if loggit then
  244.     close( h );
  245.   if AsciiDump then
  246.     close( fp );
  247. end; {pair ports}