Game Killer/Game_Killer.bin/108.EDITBASE.INC

Text File | 1992-06-28 | 5KB | 198 lines

procedure MakePort;
var
  s : SectorIndex;
  pt : integer;
begin
  write('Make a port out of which ');
  s := GetSector;
  if s <> 0 then
    if space.sectors[ s ].portType <> NotAPort then
      writeln( s, ' is already a port!')
    else
      begin
        space.sectors[s].portType := GetPortType;
        space.sectors[s].etc := space.sectors[s].etc or IsPort;
      end;
end;

procedure KillPort;
var
  s : SectorIndex;
  p1 : portIndex;
begin
  write('Remove Record for Port in which ');
  s := GetSector;
  if s <> 0 then
    if space.sectors[s].PortType = NotAPort then
      writeln( 'I have no record of ', s, ' being a port.')
    else
      begin
        space.sectors[s].portType := NotAPort;
        space.sectors[s].etc := space.sectors[s].etc and (not IsPort);
        p1 := portNumber( s );
        space.ports.data[ p1 ] := space.ports.data[ space.ports.top ];
        space.ports.top := space.ports.top - 1;
      end;
end;

procedure SetDock;
var
  sd : SectorIndex;
begin
  if space.dock = 0 then
    writeln('Space Dock location is not known')
  else
    writeln('Current space dock in sector ', space.dock );
  write('Put Space Dock in which ');
  sd := GetSector;
  if sd = 0 then
    if not prompt('Make stardock location unknown?') then
      exit;
  if sd = 0 then
    space.sectors[ space.dock ].etc :=
          space.sectors[ space.dock ].etc and (not StarDock)
  else
    space.sectors[ sd ].etc := space.sectors[ sd ].etc or StarDock;
  space.dock := sd;
end;

procedure Unexplore;
var
  us : sectorIndex;
begin
  write('Mark as Unexplored Which ');
  us := GetSector;
  if us <> 0 then
    if space.sectors[ us ].number = Unexplored then
      writeln( 'Sector ', us, ' is already marked as unexplored.')
    else
      begin
        writeln('Marking ', us, ' as unexplored.');
        space.sectors[ us ].number := Unexplored;
      end; {if else}
end; {unexplore}

procedure AvoidSector;
var
  us : sectorIndex;
begin
  write('Toggle avoid state on which? ');
  us := GetSector;
  if us <> 0 then
    with space.sectors[ us ] do
      if (etc and avoid) = Nothing  then
        begin
          etc := etc or avoid;
          writeln('Sector ', us, ' marked as avoided.');
        end
      else
        begin
          etc := etc and (not avoid);
          writeln('Sector ', us, ' marked as accessible.');
        end;
end; {avoid sector}

procedure ClearEtcFlags( name : string; flag : integer );
var
  i : sector;
  p : portindex;
begin
  for i := 1 to MaxSector do
    space.sectors[i].etc := space.sectors[i].etc and (not flag);
  if flag = busted then
    for p := 1 to space.ports.top do                { for "busted" we  }
      space.ports.data[p].bustdate := 0;            { also clear ports }
  writeln('All ', name, ' cleared.');
end;

procedure clearflags;
var
  ch : char;
begin
  repeat
    writeln('Which? <A>voids, <B>usts, <F>ighters, <N>otes, <P>orts, <S>pacelanes, <Q>uit: ');
    readln( ch );
    ch := upcase( ch );
  until ch in ['Q', 'A', 'F', 'N', 'P', 'S'];
  case ch of
    'Q' : ;
    'A' : ClearEtcFlags( 'avoids', avoid );
    'B' : ClearEtcFlags( 'busts', busted );
    'F' : ClearEtcFlags( 'fighter clouds', HasFighters );
    'N' : begin
            ClearEtcFlags( 'sector notes', NoteExists );
            space.notes.top := 0;
          end;
    'P' : begin
            ClearEtcFlags( 'port ID''s', IsPort );
            space.ports.top := 0;
          end;
    'S' : ClearEtcFlags( 'Major Space Lane ID''s', SpaceLane );
  end; {case}
end;

procedure ListEtcFlags( name : string; flag : integer );
var
  i : sector;
begin
  writeln('Sectors marked ', name);
  for i := 1 to MaxSector do
    if (space.sectors[i].etc and flag) <> Nothing then
      write( i : 5 );
  writeln;
end;

procedure listFlags;
var
  ch : char;
begin
  repeat
    writeln('Which? <A>voids, <B>usts, <F>ighters, <N>otes, <P>orts, <S>pacelanes, <Q>uit: ');
    readln( ch );
    ch := upcase( ch );
  until ch in ['Q', 'A', 'B', 'F', 'N', 'P', 'S'];
  case ch of
    'Q' : ;
    'A' : ListEtcFlags( 'to be avoided', avoid );
    'B' : ListEtcFlags( 'bust sites', busted );
    'F' : ListEtcFlags( 'as having fighters', HasFighters );
    'N' : ListEtcFlags( 'with notes', NoteExists );
    'P' : ListEtcFlags( 'as a port', IsPort );
    'S' : ListEtcFlags( 'as the Major Space Lanes', SpaceLane );
  end; {case}
end;

procedure EditMenu;
{ choices for direct editing the data base }
var
  ch : char;
begin
  repeat
    repeat
      writeln('Declare a sector to be a <P>ort');
      writeln('Declare a sector <N>OT to be a port');
      writeln('Define location of Star <D>ock');
      writeln('Make sector <U>nexplored');
      writeln('Toggle sector a<V>oidance');
      writeln('<L>ist flagged sectors');
      writeln('<C>lear all flagged sectors');
      writeln;
      writeln('<Q>uit');
      writeln;
      write('Your choice? ');
      readln( ch );
      ch := upcase( ch );
    until ch in ['P', 'N', 'D', 'U', 'V', 'C', 'L', 'Q'];
    case ch of
      'P' : Makeport;
      'N' : Killport;
      'D' : setDock;
      'U' : unexplore;
      'V' : avoidSector;
      'C' : clearFlags;
      'L' : listFlags;
      'Q' : ;
    end; {case}
  until ch = 'Q';
end; {Edit Menu}