home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / bbs_door / twview91.arj / PORTDISP.INC < prev    next >
Encoding:
Text File  |  1992-03-11  |  8.4 KB  |  256 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. var
  145.   p : PortIndex;
  146. begin
  147.   if space.sectors[s].etc and HasFighters <> nothing then
  148.     line := line + 'F'
  149.   else if space.sectors[s].etc and SpaceLane <> nothing then
  150.     line := line + 'SL';
  151.   p := PortNumber( s );
  152.   if p <> 0 then
  153.     with space.ports do
  154.       if (data[ p ].amts[equipment] <> 0) and 
  155.          (data[p].usage[equipment]=0) then
  156.         line := line + 'B';
  157. end; {AddEtc}
  158.  
  159. procedure DisplayLotsOfPortStuff( s, s1, WhichDistanceIndex : sector;
  160.                                   logging, AsciiDump, showLevels, EquipOnly : boolean;
  161.                                   var f, h : text);
  162. var
  163.   g, g1 : stuff;
  164.   line  : string;
  165. begin
  166.   if logging then
  167.     begin
  168.       writeln( h, 'R', s );
  169.       writeln( h, 'R', s1);
  170.     end; {log}
  171.   g := space.sectors[s].portType;
  172.   g1 := space.sectors[s1].portType;
  173.   line := '(' + str( s, 3);
  174.   AddEtc( s, line );
  175.   line := line + ' & ' + str(s1,3);
  176.   AddEtc( s1, line );
  177.   line := line + ' ) at distance ' + str( distances[WhichDistanceIndex].d,3)
  178.           + ' trading ' +  deal( g, g1) + ' for ' +
  179.            deal( g1, g );
  180.   writeln( line );
  181.   if AsciiDump then
  182.     writeln( f, line );
  183.   if ShowLevels then
  184.     PortTradeFactor( s, s1, deal( g, g1), deal( g1, g ),
  185.                      EquipOnly, AsciiDump, f );
  186. end; {Display Lots of Port Stuff}
  187.  
  188. procedure SearchPairs( NumPorts : integer;
  189.                        logging : boolean; var h : text;
  190.                        asciiDump : boolean; var f : text;
  191.                        EquipOnly, ShowLevels : boolean );
  192. var
  193.   i         : integer;
  194.   s, s1     : sector;
  195.   g, g1     : stuff;
  196.   t         : warpIndex;
  197.   NumPairs  : integer;
  198.   PauseAt   : integer;
  199.   line      : string;
  200.  
  201. begin
  202.   NumPairs := 0;
  203.   if ShowLevels then
  204.     PauseAt := 10
  205.   else
  206.     PauseAt := 20;
  207.   for i := 1 to NumPorts do
  208.     begin
  209.       s := distances[ i ].s;
  210.       g := space.sectors[s].portType;
  211.       if space.sectors[s].number <> Unexplored then
  212.         for t := 1 to space.sectors[s].number do
  213.           begin
  214.             s1 := space.sectors[s].data[t];
  215.             g1 := space.sectors[s1].porttype;
  216.             if  (g1<> NotAPort) and (g < g1) and IsWarp( s1, s) then
  217.                 { must be a port; print only once; check if can get back }
  218.               if compatible( g, g1, EquipOnly ) then
  219.                 begin
  220.                   DisplayLotsOfPortStuff(s, s1, i, logging, asciidump, 
  221.                                         showlevels, EquipOnly, f, h);
  222.                   NumPairs := NumPairs + 1;
  223.                   if numPairs mod PauseAt = 0 then
  224.                     if not prompt('more? ') then
  225.                       exit;
  226.                 end; {if if}
  227.           end; {for t}
  228.     end; {for i}
  229. end; {SearchPairs}
  230.  
  231. procedure pairport;
  232. var
  233.   s        : sector;
  234.   QuantInfo,
  235.   Greedy   : boolean;
  236.   NumSectors : integer;
  237.   AsciiDump,
  238.   loggit   : boolean;
  239.   h, fp    : text;
  240. begin
  241.   SortPorts( NumSectors );
  242.   SortDistances( distances, NumSectors );
  243.   QuantInfo := prompt('Do you want to see port quantity information? ');
  244.   greedy := prompt('Do you want to only see Equip/Organic trades? ');
  245.   loggit := LogToDisk( h,
  246.         'Do you want to log the results in a format suitable for upload? ',
  247.         BBSname+'.upl' );
  248.   AsciiDump := LogToDisk( fp,
  249.         'Do you want an echo of the results to an ascii file? ',
  250.         BBSName+'.txt');
  251.   SearchPairs( NumSectors, Loggit, h, AsciiDump, fp, greedy, QuantInfo );
  252.   if loggit then
  253.     close( h );
  254.   if AsciiDump then
  255.     close( fp );
  256. end; {pair ports}