home *** CD-ROM | disk | FTP | other *** search
/ Game Killer / Game_Killer.bin / 100.TELEPORT.INC < prev    next >
Text File  |  1992-07-08  |  4KB  |  131 lines
  1. procedure AddFighterCloud( var update : boolean );
  2. {store a sector as having a fighter for transwarp location }
  3. var
  4.   AddSector : sectorindex;
  5. begin
  6.   write('Fighters in which ');
  7.   AddSector := GetSector;
  8.   if AddSector <> 0 then
  9.     begin
  10.       update := true;
  11.       with space.sectors[ AddSector ] do
  12.         etc := etc or HasFighters;
  13.     end; {if}
  14. end; {Add FIghters}
  15.  
  16. procedure DeleteFighterCloud( var update : boolean );
  17. { store a sector as NOT having any fighters for transwarp }
  18. var
  19.   DeleteSector : sectorIndex;
  20. begin
  21.   write('Remove Fighters from which ');
  22.   DeleteSector := GetSector;
  23.   if DeleteSector <> 0 then
  24.     begin
  25.       update := true;
  26.       with space.sectors[ DeleteSector ] do
  27.         etc := etc and (not HasFighters);
  28.     end; {if}
  29. end; {Delete Fighters}
  30.  
  31. procedure ListFighterClouds;
  32. { List all known sectors with transwarp locator beams }
  33. var
  34.   s : sector;
  35.   log : boolean;
  36.   f : text;
  37. begin
  38.   log := prompt( 'Log to disk? ');
  39.   if log then
  40.     begin
  41.       assign( f, GetNewFileName('File name for report?  ', 'report.txt') );
  42.       rewrite( f );
  43.     end;
  44.   for s := 1 to MaxSector do
  45.     if space.sectors[s].etc and HasFighters <> Nothing then
  46.       DisplaySector( s, ' Dist:', Error, log, f );
  47.   if log then
  48.     close( f );
  49. end; {ListFighterClouds}
  50.  
  51. procedure TransWarpPathLength;
  52. { Ask for current sector and target sector.  Give path, which might
  53. include transwarp, using this data. }
  54. var
  55.   CurrentSector, TargetSector : sectorIndex;
  56.   LengthTo, temp              : integer;
  57.   s, WarpTo                   : sector;
  58. begin
  59.   write('Current ');
  60.   CurrentSector := GetSector;
  61.   if CurrentSector = 0 then
  62.     exit;
  63.   write('Destination ');
  64.   TargetSector := GetSector;
  65.   if TargetSector = 0 then
  66.     exit;
  67.   WarpTo := CurrentSector;
  68.   LengthTo := FixPath( currentSector, TargetSector, maxint - 1 );
  69.   if LengthTo = Error then
  70.     writeln('You don''t know how to get from ', CurrentSector, ' to ',
  71.             TargetSector, '!')
  72.   else
  73.     for s := 1 to MaxSector do
  74.       if space.sectors[s].etc and HasFighters <> Nothing then
  75.         begin
  76.           write('.');
  77.           temp := FixPath( s, TargetSector, LengthTo );
  78.           if (temp <> error) and (temp+1 < LengthTo) then
  79.             begin
  80.               WarpTo := s;
  81.               LengthTo := temp + 1;
  82.             end; {if}
  83.         end; {else for if}
  84.   writeln;
  85.   write('Use Transwarp to ', WarpTo, ' and then autopilot to ',
  86.         TargetSector );
  87.   if LengthTo <> Error then
  88.     writeln(' ( ', LengthTo, ' turns )')
  89.   else
  90.     writeln;
  91. end; {TransWarpPathLength}
  92.  
  93. procedure TransMenuText;
  94. begin
  95.   writeln('Your choices: ');
  96.   writeln('  <A>dd new fighter patrol to list');
  97.   writeln('  <D>elete fighter patrol from list');
  98.   writeln('  <L>ist all stored fighter patrols');
  99.   writeln('  find transwarp <P>airs [SSB & SBS]');
  100.   writeln('  <S>hortest path including transwarp to sector');
  101.   writeln('  find <W>eak transwarp pairs [SSB & BBS]');
  102.   writeln('  find <R>eally weak transwarp pairs [SBS & BSB]');
  103.   writeln('  <Q>uit.  I goofed.');
  104.   writeln;
  105.   write('Menu choice? ');
  106. end;
  107.  
  108. procedure TransWarpMenu( var update : boolean );
  109. {offer transwarp stuff, and update database if anything is changed}
  110. var
  111.   ch : char;
  112. begin
  113.   TransMenuText;
  114.   repeat
  115.     readln( ch );
  116.     ch := upcase( ch );
  117.    case ch of
  118.      'A' : AddFighterCloud( update );
  119.      'D' : DeleteFighterCloud( update );
  120.      'L' : ListFighterClouds;
  121.      'P' : PairSearch( 'SSB','SBS');
  122.      'R' : PairSearch( 'SBS', 'BSB');
  123.      'S' : TransWarpPathLength;
  124.      'W' : PairSearch('SSB','BBS');
  125.      'Q' : ;
  126.    else
  127.      TransMenuText;
  128.    end; {case}
  129.   until ch in ['A', 'D', 'L', 'P', 'R', 'S', 'Q', 'W'];
  130. end; {TransWarpMenu}
  131.