home *** CD-ROM | disk | FTP | other *** search
/ Boldly Go Collection / version40.iso / TS / 05B / TWVIEW91.ZIP / TELEPORT.INC < prev    next >
Encoding:
Text File  |  1992-03-11  |  3.3 KB  |  118 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 );
  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);
  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 TransWarpMenu( var update : boolean );
  94. {offer transwarp stuff, and update database if anything is changed}
  95. var
  96.   ch : char;
  97. begin
  98.   repeat
  99.     writeln('Your choices: ');
  100.     writeln('  <A>dd new fighter patrol to list');
  101.     writeln('  <D>elete fighter patrol from list');
  102.     writeln('  <L>ist all stored fighter patrols');
  103.     writeln('  <S>hortest path including transwarp to sector');
  104.     writeln('  <Q>uit.  I goofed.');
  105.     writeln;
  106.     write('Menu choice? ');
  107.     readln( ch );
  108.     ch := upcase( ch );
  109.   until ch in ['A', 'D', 'L', 'S', 'Q'];
  110.   case ch of
  111.     'A' : AddFighterCloud( update );
  112.     'D' : DeleteFighterCloud( update );
  113.     'L' : ListFighterClouds;
  114.     'S' : TransWarpPathLength;
  115.     'Q' : ;
  116.   end; {case}
  117. end; {TransWarpMenu}
  118.