{$ifndef unix}
{$A+,B-,D+,E+,F-,G+,I+,L+,N+,O-,P+,Q-,R-,S+,T-,V-,X+,Y+}
{$else}
{$B-,I+,S-,T-,X+}
{$endif}
unit data;

interface

uses
 types,
 tstring;

var
 missions:array[0..35] of string22;
 rassen:array[0..31] of string30;
 GMissionFlags:array[0..31] of lint;
 UsedRassen,
 GenFlags,
 RundeNr:lint;
 path:string[63];

 Planetsanz:word;
 Planets1:tp_planets1;
 planets2:tp_planets2;

 BasesAnz:word;
 Bases1:tp_bases1;
 Bases2:tp_bases2;
 Bases3:tp_bases3;
 Bases4:tp_bases4;

 shipsanz:word;
 ships1:tp_ships1;
 ships2:tp_ships2;
 ships3:tp_ships3;
 ships4:tp_ships4;
 ships5:tp_ships5;
 ships6:tp_ships6;
 ships7:tp_ships7;

 mfeldanz:word;
 mfelder:t_mfelder;

 msganz:word;
 MsgList:tp_messagelist;

 wmsgs:ta_wmsg;

 engines:t_engines;
 beams:t_beams;
 mines:t_mines;
 torps:t_torps;
 torprohre:t_torprohre;
 hulls:t_hulls;

 FileTag:lint;
 Password:string15;
 error:integer;

const
 natives:array[0..10] of string10=
 ('Amorphisch',
  'Amphibisch',
  'Avian',
  'Bovinoid',
  'Energetisch',
  'Ghipsodal',
  'Humanoid',
  'Insekten',
  'Kristall',
  'Reptilien',
  'Silikonoid');
 klima:array[0..6] of string11=
  ('Arktisch',
   'Kalt',
   'Gem. kalt',
   'Gem. warm',
   'Subtropisch',
   'Tropisch',
   'Wüste');
 air:array[0..3] of string6=
  ('keine',
   'dünn',
   'normal',
   'dicht');
 pmissionen:array [0..6] of string19=
  ('keine',
   'Aufbau automatisch',
   'Aufbau Minen',
   'Aufbau Fabriken',
   'Aufbau Abwehrposten',
   'Aufbau Kasernen',
   'Abwehr Schiffe');
 bmissionen:array[0..9] of string18=
  ('keine',
   'Abwehr Schiffe',
   'Minenfeld legen',
   'Jäger produzieren',
   'Aufbau Abwehr',
   'Schifffe auftanken',
   'Schiffe entladen',
   'Schiffe bauen',
   'Schiffe reparieren',
   'Selbstreperatur');
 bev:array[0..5] of string12=
  ('Bürgerkrieg',
   'kämpfend',
   'aufständisch',
   'unzufrieden',
   'zufrieden',
   'glücklich');
 concern:array[0..9] of string19=
 ('alle',
  'Schiffe',
  'Planeten',
  'Basen',
  'Missionen',
  'national',
  'international',
  'Entdeckungen',
  'Punktestand',
  'System');

const
 starcols:array[0..2,0..4] of byte=
  ((8,1,9,3,$b),   {Stern}
   (7,2,$a,$e,$f), {Schiff}
   (6,4,5,$c,$d)); {Gegner}
 turn:array[0..5,0..24] of byte=
  (( 9,09,23,15,17,13,21,11,19,05,24,03,20,01,22,07,18,06,10,02,14,04,12,08,16),
   (13,13,19,11,21,09,17,15,23,01,18,07,22,05,20,03,24,04,16,08,12,06,14,02,10),
   (18,18,10,24,16,20,14,22,12,17,06,21,04,19,02,23,08,15,07,11,03,13,01,09,05),
   (22,22,14,20,12,24,10,18,16,23,02,19,08,21,06,17,04,09,01,13,05,11,07,15,03),
   (02,02,03,04,01,06,07,08,05,10,11,12,09,14,15,16,13,18,19,20,17,22,23,24,21),
   (04,04,01,02,03,08,05,06,07,12,09,10,11,16,13,14,15,20,17,18,19,24,21,22,23));
 optiKlima:array[0..31] of byte=
  ( 1, 4, 6, 8, 7, 7, 6, 7,
    0, 7, 7, 7, 7, 7, 7,14,
    7, 7, 8, 8, 6, 7, 9,14,
    9, 5, 7, 8, 5, 6, 7,15);

 direct:byte=0;
 AZ10:string[36]='1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ';

var
 maxfuse,
 maxbdamage,
 maxtdamage,
 maxmdamage:lint;

procedure RaceSave;

{$ifndef unix}
type
	mkstring=string;
{$else}
function mkstring(var s):string;
{$endif}

{***Speicher/Ladefunktionen***}

function israce(n:byte):boolean;
function openrace(n:byte):boolean;
function saverace:boolean;
function openracefiles(n:byte;cr:boolean):boolean;
function MsgInRead  (n:word;var m:t_message):boolean;
procedure MsgInWrite (var f:file;var m:t_message);
function MsgOutRead (n:word;var m:t_message):boolean;
function MsgOutWrite(n:word;var m:t_message):boolean;

function blocksave(var f:file;var target;n:word):boolean;
function blockload(var f:file;var target;n:word):boolean;

{***Informationsliefernde Funktionen}

function GetShip(id:lint):tp_schiff;
function shipname(id:lint):string30;

function FirstShip(rasse,x,y,z,mode:integer):lint;
function NextShip(id:lint;rasse,x,y,z,mode:integer):lint;
function LastShip(id:lint;rasse,x,y,z,mode:integer):lint;
{ mode:
   0:alle Schiffe
   1:Schiffe Rasse
   2:Schiffe außer Rasse
   3:Schiffe XYZ
   4:Schiffe XYZ+-100
   5:Schiffe Rasse XYZ
   6:Schiffe Rasse XYZ+-100
   7:Schiffe außer Rasse XYZ
   8:Schiffe außer Rasse XYZ+-100 }

function PlanID(x,y,z:lint):lint;
function GetPlan(id:lint):tp_planet;
function PlanName(id:lint):string20;

function Firstplan(rasse,x,y,z,mode:integer):lint;
function Nextplan(id:lint;rasse,x,y,z,mode:integer):lint;
function Lastplan(id:lint;rasse,x,y,z,mode:integer):lint;

function GetBase(id:lint):tp_starbase;
function BaseID(x,y,z:lint):lint;
function BaseName(id:lint):string20;
function canbuildtyp(base:tp_starbase;typ:lint):boolean;

function Firstbase(rasse,x,y,z,mode:integer):lint;
function Nextbase(id:lint;rasse,x,y,z,mode:integer):lint;
function Lastbase(id:lint;rasse,x,y,z,mode:integer):lint;

const
 baygewicht=10;
 MLegerGewicht=10;
 bgewicht=5;

function tgewicht(id:lint):lint;
function egewicht(id:lint):lint;
function sgewicht(schiff:tp_schiff):lint;

function EngName(id:lint):string20;
function beamName(id:lint):string20;
function torpName(id:lint):string20;
function torprName(id:lint):string20;
function mineName(id:lint):string20;

{***Informationsverarbeitende Funktionen }

function dist(x1,y1,z1,x2,y2,z2:integer):word;
function time(d,w:integer):word;
function fueluse(d,m,warp,engtyp:integer):lint;

function nklima(c:byte):byte;
function nair(c:word):byte;
function ncontent(c:byte):byte;

function maxbuilds(n:lint;z:word):word;
function maxmines(p:tp_planet):word;
function maxfacts(p:tp_planet):word;
function maxdefs(p:tp_planet):word;
function maxforts(p:tp_planet):word;

function income(p:tp_planet):lint;
function soldiers(p:tp_planet):lint;
function nincome(p:tp_planet):lint;
function contentchg(p:tp_planet):integer;
function ncontentchg(p:tp_planet):integer;
function Growth(p:tp_planet):lint;
function Growthn(p:tp_planet):lint;

procedure turnxyz(var x,y,z:sint;rotate:word);  { Koordinaten }
procedure turnxyz2(var x,y,z:sint;rotate:word); { Tastatur }
procedure xyz(x,y,z,px,py,pz:sint;rotate:integer;var x1,y1,d:sword);
{ Umwandlung in Bildschirmkoordinaten kl. Ausschnitt }

function keyhandle(c:char;s:byte;rasse,px,py,pz:integer;
		   var tx,ty,tz:sint;var redraw:byte):boolean;

{***Funktionen mit Ausgabe }

procedure writemissions(s:tp_schiff;rasse:word;var shipdata:t_bdata;
			mission1,mission2,mission3,mission4:lint;
			full:boolean);
{ Ausgabe Missionsdaten }
procedure DisplayStars(rasse,x,y,z,tx,ty,tz:sint);

procedure displayfuel(x,y,typ:word);
procedure displaybeam(x,y,typ:word);
procedure displaytorp(x,y,typ:word);

{*******************************************************}

function optiair(race:byte;climate:word):extended;

const
 OpenedRace:byte=255;
 msgav:boolean=false;

implementation

uses
 utils,
 kb,
 evgraph,
 vbios,
 maus2kb,
 listen,
 schedule,
 menus1,
 menus2,
 menus3,
 menus5,
 menus6,
 grafik,
{$ifndef unix}
 crt,
 dos,
{$else}
 xcrt,
 xdos,
{$endif}
 prandom;

var
 fr1,
 fr2,
 fm1,
 fm2:file;
 f:^file;
 wmsglen:array[0..32] of word;

const
 shipcache:record
  id:lint;
  b:word;
  a:byte;
 end=(id:-1);

 plancache:record
  id:lint;
  x,
  y,
  z:integer;
  b:word;
  a:byte;
 end=(id:-1;x:$800;y:$800;z:$800);

{$ifdef unix}
function Hi(w:word):byte;
begin
	hi:=w shr 8;
end;

function mkstring(var s):string;
var
 t:^string255;
begin
	t:=@s;
	mkstring:=substr(t^,2,byte(t^[0]));
end;
{$endif}

function Growth(p:tp_planet):lint;
begin
end;

function Growthn(p:tp_planet):lint;
begin
end;

function optiair(race:byte;climate:word):extended;
const
 depend:array[0..31] of byte=
  (100,100,100,100,100, 65,  0, 50,
     0,100,100,100,100,100,100,100,
   100, 90, 90,100,100,100, 90,100,
   100,100,100,100,100,100,100,  0);
var
 o:extended;
begin
 case hi(climate) and $f of {Luftdruck}
  0:optiair:=1-0.00975*depend[race];
   1.. 3:optiair:=1-0.95*depend[race]*max(abs(integer(climate shr 12)-optiklima[race])-3,0)/12/100;
   4..11:optiair:=1-0.89*depend[race]*max(abs(integer(climate shr 12)-optiklima[race])-2,0)/13/100;
  12..15:optiair:=1-0.92*depend[race]*max(abs(integer(climate shr 12)-optiklima[race])-1,0)/14/100;
 end;
end;

function israce(n:byte):boolean;
var
 sr:searchrec;
 s:string;
begin
 s:=path+'RACE-'+az10[n+1]+'.hst';
 findfirst(s,anyfile and not volumeid,sr);
 israce:=doserror=0;
end;

function blockload(var f:file;var target;n:word):boolean;
type
 a=array[0..0] of byte;
var
 r:word;
 i:word;
begin
 if n<>0 then begin
  {$i-}
  if ioresult=0 then;
  blockread(f,target,n,r);
  blockload:=(r=n)and(ioresult=0);
  for i:=0 to n-1 do a(target)[i]:=a(target)[i] xor lo(i) xor $be;
  {$i+}
 end else blockload:=true;
end;

function blocksave(var f:file;var target;n:word):boolean;
type
 a=array[0..0] of byte;
var
 i,
 r:word;
begin
 if n<>0 then begin
  {$i-}
  if ioresult=0 then;
  for i:=0 to n-1 do a(target)[i]:=a(target)[i] xor lo(i) xor $be;
  blockwrite(f,target,n,r);
  for i:=0 to n-1 do a(target)[i]:=a(target)[i] xor lo(i) xor $be;
  blocksave:=(r=n)and(ioresult=0);
  {$i+}
 end else blocksave:=true;
end;

function openracefiles(n:byte;cr:boolean):boolean;
var
 nm:string[63];
begin
 openracefiles:=false;
 if ioresult<>0 then;
 nm:=path+'RACE-'+az10[n+1];
 assign(fr1,nm+'.hst');
 assign(fr2,nm+'.chg');
 assign(fm1,nm+'.msg');
 assign(fm2,nm+'.wrt');
 {$i-}
 if cr then begin
  f:=@fr1;
  filemode:=$92;
  rewrite(fr1,1);
  if ioresult<>0 then exit;
  close(fr1);
  reset(fr1,1);
  if ioresult<>0 then exit;
  erase(fr2);
  if ioresult<>0 then;
  erase(fm2);
  openedrace:=n;
  if ioresult<>0 then;
  {$i+}
  exit;
  {$i-}
 end else begin
  filemode:=$90;
  reset(fr1,1);
  if ioresult<>0 then exit;
  f:=@fr2;
  filemode:=$92;
  reset(fr2,1);
  if ioresult<>0 then begin
   f:=@fr1;
   rewrite(fr2,1);
   if ioresult<>0 then begin
    close(fr1);
    exit;
   end;
   close(fr2);
   reset(fr2,1);
   if ioresult<>0 then begin
    close(fr1);
    exit;
   end;
  end;
 end;

 reset(fm1,1);
 msgav:=ioresult=0;
 reset(fm2,1);
 if ioresult<>0 then begin
  rewrite(fm2,1);
  if ioresult<>0 then begin
   close(fr1);
   close(fr2);
   close(fm1);
   if ioresult<>0 then;
   exit;
  end;
  close(fm2);
  reset(fm2,1);
  if ioresult<>0 then begin
   close(fr1);
   close(fr2);
   close(fm1);
   if ioresult<>0 then;
   exit;
  end;
 end;
 openracefiles:=true;
 if ioresult=0 then;
 {$i+}
end;

function openrace(n:byte):boolean;

 procedure fail;
 begin
  error:=ioresult;
  {$i-}
  close(fr1);
  close(fr2);
  close(fm1);
  close(fm2);
  inoutres:=0;
  {$i+}
 end;

var
 nm:string;
{$ifndef unix}
 s,
{$else}
 s:array[0..15] of char;
{$endif}
 p:string;
 t:lint;
 i:word;
 b:byte;

begin
 openrace:=false;
 clearscreen(0);
 if not openracefiles(n,false) then begin fail;exit;end;

 if not blockload(f^,s,50) then begin fail;exit;end;
 if not blockload(f^,RundeNr,4) then begin fail;exit;end;
 if not blockload(f^,filetag,4) then begin fail;exit;end;
 if not blockload(f^,b,1) then begin fail;exit;end;
 if b<>0 then begin fail;exit;end;
 if not blockload(f^,s,16) then begin fail;exit;end;
{ write('3');}

 prandseed:=filetag;
 byte(s[0]):=byte(s[0]) xor prandom(256);
 if byte(s[0])<>0 then begin
  clearscreen(4);
  p:='';
  eingabep(5,5,15,'Passwort:',p);
  for i:=1 to 15 do byte(p[i]):=byte(p[i]) xor prandom(256);
  for i:=0 to byte(s[0]) do if s[i]<>p[i] then begin fail;exit;end;
 end;
{ write('4');}

 if not blockload(f^,usedrassen,4) then begin fail;exit;end;
{ write('5');}

 if not blockload(f^,planetsanz,2) then begin fail;exit;end;
 if planetsanz>0 then begin
  if planetsanz>500 then begin
   if not blockload(f^,planets1^,sizeof(planets1^)) then begin fail;exit;end;
   if not blockload(f^,planets2^,sizeof(planets2^[500])*(planetsanz-500)) then begin fail;exit;end;
  end else begin
   if not blockload(f^,planets1^,sizeof(planets1^[0])*planetsanz) then begin fail;exit;end;
  end;
 end;
{ write('6');}

 if not blockload(f^,basesanz,2) then begin fail;exit;end;
 if basesanz>0 then begin
  if basesanz>300 then begin
   if not blockload(f^,bases1^,sizeof(bases1^)) then begin fail;exit;end;
   if basesanz>600 then begin
    if not blockload(f^,bases2^,sizeof(bases2^)) then begin fail;exit;end;
    if basesanz>900 then begin
     if not blockload(f^,bases3^,sizeof(bases3^)) then begin fail;exit;end;
     if not blockload(f^,bases4^,sizeof(bases4^[900])*basesanz) then begin fail;exit;end;
    end else begin
     if not blockload(f^,bases4^,sizeof(bases3^[600])*basesanz) then begin fail;exit;end;
    end;
   end else begin
    if not blockload(f^,bases4^,sizeof(bases2^[300])*basesanz) then begin fail;exit;end;
   end;
  end else begin
   if not blockload(f^,bases1^,sizeof(bases1^[0])*basesanz) then begin fail;exit;end;
  end;
 end;
{ write('7');}

 if not blockload(f^,shipsanz,2) then begin fail;exit;end;
 if shipsanz>0 then begin
  if shipsanz>500 then begin
   if not blockload(f^,ships1^,sizeof(ships1^)) then begin fail;exit;end;
   if shipsanz>1000 then begin
    if not blockload(f^,ships2^,sizeof(ships2^)) then begin fail;exit;end;
    if shipsanz>1500 then begin
     if not blockload(f^,ships3^,sizeof(ships3^)) then begin fail;exit;end;
     if shipsanz>2000 then begin
      if not blockload(f^,ships4^,sizeof(ships4^)) then begin fail;exit;end;
      if shipsanz>2500 then begin
       if not blockload(f^,ships5^,sizeof(ships5^)) then begin fail;exit;end;
       if shipsanz>3000 then begin
	if not blockload(f^,ships6^,sizeof(ships6^)) then begin fail;exit;end;
	if not blockload(f^,ships7^,sizeof(ships7^[3000])*shipsanz) then begin fail;exit;end;
       end else begin
	if not blockload(f^,ships6^,sizeof(ships6^[2500])*shipsanz) then begin fail;exit;end;
       end;
      end else begin
       if not blockload(f^,ships5^,sizeof(ships5^[2000])*shipsanz) then begin fail;exit;end;
      end;
     end else begin
      if not blockload(f^,ships4^,sizeof(ships4^[1500])*shipsanz) then begin fail;exit;end;
     end;
    end else begin
     if not blockload(f^,ships3^,sizeof(ships3^[1000])*shipsanz) then begin fail;exit;end;
    end;
   end else begin
    if not blockload(f^,ships2^,sizeof(ships2^[500])*shipsanz) then begin fail;exit;end;
   end;
  end else begin
   if not blockload(f^,ships1^,sizeof(ships1^[0])*shipsanz) then begin fail;exit;end;
  end;
 end;
{ write('8');}

 if not blockload(f^,mfeldanz,2) then begin fail;exit;end;
 if not blockload(f^,mfelder,sizeof(mfelder[0])*mfeldanz) then begin fail;exit;end;

 if not blockload(f^,msganz,2) then begin fail;exit;end;
 if not blockload(f^,msglist^,sizeof(msglist^[0])*msganz) then begin fail;exit;end;
 if not blockload(f^,wmsgs,sizeof(wmsgs)) then begin fail;exit;end;

 if not blockload(fm2,wmsglen,sizeof(wmsglen))
 then fillchar(wmsglen,sizeof(wmsglen),0);
{ write('9');}

 if ioresult=0 then;
 {$i+}
 f:=@fr2;
 openrace:=true;
 openedrace:=n;
 prandomize;
end;

function saverace:boolean;

var
 nm:string;
 s,p:string;
 t:lint;
 i:word;
 b:byte;
 ye,mo,da,wd:word;

begin
 saverace:=false;
 if openedrace=255 then exit;
 {$i-}
 if f=@fr2 then begin
  seek(fr2,0);
  truncate(fr2);
  if ioresult<>0 then exit;
 end;

// getdate(ye,mo,da,wd);

 s:=rassen[openedrace]+#13#10+w2s(ye mod 100,2,true,false)
    +w2s(mo,2,true,false)+w2s(da,2,true,false)+'-'
    +l2s(RundeNr,10,false,true,false)+#26;

 for i:=1 to 50 do s[i]:=char(byte(s[i]) xor (i-1) xor $be);
 if not blocksave(f^,s[1],50) then exit;
 if not blocksave(f^,RundeNr,4) then exit;
 if not blocksave(f^,filetag,4) then exit;

 b:=0;
 if not blocksave(f^,b,1) then exit;

 prandseed:=filetag;
 if f=@fr2 then clearscreen(5);
 s:='';
 if f=@fr2 then eingabep(5,5,15,'Neues Passwort:',s);
 for i:=0 to 15 do byte(s[i]):=byte(s[i]) xor prandom(256);
 if f=@fr2 then clearscreen(0);
 textattr:=7;
 if not blocksave(f^,s,16) then exit;

 if not blocksave(f^,usedrassen,4) then exit;

 if not blocksave(f^,planetsanz,2) then exit;
 if planetsanz>0 then begin
  if planetsanz>500 then begin
   if not blocksave(f^,planets1^,sizeof(planets1^)) then exit;
   if not blocksave(f^,planets2^,sizeof(planets2^[500])*(planetsanz-500)) then exit;
  end else begin
   if not blocksave(f^,planets1^,sizeof(planets1^[0])*planetsanz) then exit;
  end;
 end;

 if not blocksave(f^,basesanz,2) then exit;
 if basesanz>0 then begin
  if basesanz>300 then begin
   if not blocksave(f^,bases1^,sizeof(bases1^)) then exit;
   if basesanz>600 then begin
    if not blocksave(f^,bases2^,sizeof(bases2^)) then exit;
    if basesanz>900 then begin
     if not blocksave(f^,bases3^,sizeof(bases3^)) then exit;
     if not blocksave(f^,bases4^,sizeof(bases4^[900])*basesanz) then exit;
    end else begin
     if not blocksave(f^,bases4^,sizeof(bases3^[600])*basesanz) then exit;
    end;
   end else begin
    if not blocksave(f^,bases4^,sizeof(bases2^[300])*basesanz) then exit;
   end;
  end else begin
   if not blocksave(f^,bases1^,sizeof(bases1^[0])*basesanz) then exit;
  end;
 end;

 if not blocksave(f^,shipsanz,2) then exit;
 if shipsanz>0 then begin
  if shipsanz>500 then begin
   if not blocksave(f^,ships1^,sizeof(ships1^)) then exit;
   if shipsanz>1000 then begin
    if not blocksave(f^,ships2^,sizeof(ships2^)) then exit;
    if shipsanz>1500 then begin
     if not blocksave(f^,ships3^,sizeof(ships3^)) then exit;
     if shipsanz>2000 then begin
      if not blocksave(f^,ships4^,sizeof(ships4^)) then exit;
      if shipsanz>2500 then begin
       if not blocksave(f^,ships5^,sizeof(ships5^)) then exit;
       if shipsanz>3000 then begin
	if not blocksave(f^,ships6^,sizeof(ships6^)) then exit;
	if not blocksave(f^,ships7^,sizeof(ships7^[3000])*shipsanz) then exit;
       end else begin
	if not blocksave(f^,ships6^,sizeof(ships6^[2500])*shipsanz) then exit;
       end;
      end else begin
       if not blocksave(f^,ships5^,sizeof(ships5^[2000])*shipsanz) then exit;
      end;
     end else begin
      if not blocksave(f^,ships4^,sizeof(ships4^[1500])*shipsanz) then exit;
     end;
    end else begin
     if not blocksave(f^,ships3^,sizeof(ships3^[1000])*shipsanz) then exit;
    end;
   end else begin
    if not blocksave(f^,ships2^,sizeof(ships2^[500])*shipsanz) then exit;
   end;
  end else begin
   if not blocksave(f^,ships1^,sizeof(ships1^[0])*shipsanz) then exit;
  end;
 end;

 if not blocksave(f^,mfeldanz,2) then exit;
 if not blocksave(f^,mfelder,sizeof(mfelder[0])*mfeldanz) then exit;

 if not blocksave(f^,msganz,2) then exit;
 if not blocksave(f^,msglist^,sizeof(msglist^[0])*msganz) then exit;
 if not blocksave(f^,wmsgs,sizeof(wmsgs)) then exit;

 close(fr1);
 close(fr2);
 close(fm1);
 close(fm2);

 if ioresult=0 then;
 {$i+}
 saverace:=true;
 prandomize;
end;

var
 ws:string;
 xs:array[1..255] of char;

function MsgInRead  (n:word;var m:t_message):boolean;
var
 i:byte;
 l:byte;
begin
 msginread:=false;
 for i:=0 to 29 do setstring(m[i],'');
 if not msgav then exit;
 if n>=msganz then exit;
 {$i-}
 seek(fm1,msglist^[n].ofs);
 if ioresult<>0 then exit;
 for i:=0 to 29 do begin
  if not blockload(fm1,l,1) then exit;
  if not blockload(fm1,xs[1],l) then exit;
  setstring(m[i],substr(xs,1,l));
 end;
 {$i+}
 msginread:=true;
end;

procedure MsgInwrite(var f:file;var m:t_message);
var
 i:byte;
 l:byte;
begin
 {$i-}
 msglist^[msganz].ofs:=filepos(f);
 inc(msganz);
 for i:=0 to 29 do begin
  ws:=getstring(m[i]);
  l:=length(ws);
  if not blocksave(f,l,1) then exit;
  if not blocksave(f,ws[1],l) then exit;
 end;
 if ioresult<>0 then;
 {$i+}
 if ioresult<>0 then exit;
end;

function MsgOutRead (n:word;var m:t_message):boolean;
var
 i:byte;
 l:byte;

begin
 msgoutread:=false;
 for i:=0 to 29 do setstring(m[i],'');
 if n>=33 then exit;
 if wmsgs[n].ofs<>-1 then begin
  seek(fm2,wmsgs[n].ofs);
  for i:=0 to 29 do begin
   if not blockload(fm2,l,1) then exit;
   if not blockload(fm2,xs[1],l) then exit;
   setstring(m[i],substr(xs,1,l));
  end;
 end;
 msgoutread:=true;
end;

function MsgOutWrite(n:word;var m:t_message):boolean;
var
 i,j,g:byte;
 len:word;
 min:lint;
 l:byte;
 gaps:array[1..34] of record
  ofs,len:lint;
 end;

begin
 msgoutwrite:=false;
 if n>=33 then exit;

 len:=30;
 for i:=0 to 29 do inc(len,length(getstring(m[i])));

 if len<>0 then begin

  if (len>wmsglen[n])or(wmsgs[n].ofs=-1) then begin
   g:=1;
   gaps[1].ofs:=66;
   gaps[1].len:=filesize(fm2);
   if gaps[1].len>0 then begin
    dec(gaps[1].len,66);
    for i:=0 to 32 do begin
     if (wmsgs[i].ofs<>-1)and(wmsglen[i]<>0) then begin
      for j:=1 to g
      do if inrange(wmsgs[i].ofs,gaps[j].ofs,gaps[j].ofs+gaps[j].len)
      then begin
       inc(g);
       gaps[g].ofs:=wmsgs[i].ofs+wmsglen[i];
       gaps[g].len:=gaps[j].ofs+gaps[j].len-gaps[g].ofs;
       gaps[j].len:=wmsgs[i].ofs-gaps[j].ofs;
       if gaps[j].len=0 then begin
	gaps[j]:=gaps[g];
	dec(g);
       end;
       if gaps[j].len=0 then begin
	gaps[j]:=gaps[g];
	dec(g);
       end;
       break;
      end;
     end;
     if g=0 then begin
      break;
     end;
    end;
    wmsgs[n].ofs:=filesize(fm2);
    min:=maxlongint;
    for i:=1 to g do if inrange(gaps[i].len,len,min) then begin
     wmsgs[n].ofs:=gaps[i].ofs;
     min:=gaps[i].len;
    end;
   end else wmsgs[n].ofs:=66;
  end;

  if wmsgs[n].ofs=66 then begin
   if not blocksave(fm2,wmsglen,sizeof(wmsglen)) then exit;
   wmsgs[n].ofs:=sizeof(wmsglen);
  end;

  seek(fm2,wmsgs[n].ofs);
  for i:=0 to 29 do begin
   ws:=getstring(m[i]);
   l:=length(ws);
   if not blocksave(fm2,l,1) then exit;
   if not blocksave(fm2,ws[1],l) then exit;
  end;
 end else begin
  wmsgs[n].ofs:=-1;
 end;

 wmsglen[n]:=len;
 seek(fm2,0);
 if not blocksave(fm2,wmsglen,sizeof(wmsglen)) then exit;

 msgoutwrite:=true;
end;

procedure writemissions(s:tp_schiff;rasse:word;var shipdata:t_bdata;
			mission1,mission2,mission3,mission4:lint;
			full:boolean);
begin
 if (s^.owner=rasse) then begin
  writeg(shipdata,#0'C'#$e+missions[mission1]+#13#10);
  case Mission1 of
   8..10,12:begin
    if full then writeg(shipdata,'  Ziel:');
    writeg(shipdata,shipname(mission2)+#0'C'#$f#13#10#10#10);
   end;
   13:begin
    if full then writeg(shipdata,'   Mit:');
    writeg(shipdata,shipname(mission2)+#0'C'#$f#13#10#10#10);
   end;
   15..21,31,32,33,34,35:begin
    if full then writeg(shipdata,'Planet:');
    writeg(shipdata,PlanName(mission2)+#0'C'#$f#13#10#10#10);
   end;
   23,24,29,30:begin
    if full then writeg(shipdata,' Basis:');
    writeg(shipdata,BaseName(mission2)+#0'C'#$f#13#10#10#10);
   end;
   25,26:if s^.owner=rasse then begin
    if full then writeg(shipdata,'    An:');
    writeg(shipdata,rassen[Mission2]+#13#10);
    if full then writeg(shipdata,'Verwendung:');
    writeg(shipdata,missions[byte(Mission3)]+#13#10);
    case byte(mission3) of
     8..10,12:begin
      if full then writeg(shipdata,'  Ziel:');
      writeg(shipdata,shipname(mission4)+#0'C'#$f#13#10);
     end;
     13:begin
      if full then writeg(shipdata,'   Mit:');
      writeg(shipdata,shipname(mission4)+#0'C'#$f#13#10);
     end;
     15..21,31,32,33,34,35:begin
      if full then writeg(shipdata,'Planet:');
      writeg(shipdata,PlanName(mission4)+#0'C'#$f#13#10);
     end;
     23,24,29,30:begin
      if full then writeg(shipdata,' Basis:');
      writeg(shipdata,BaseName(mission4)+#0'C'#$f#13#10);
     end;
    else
     writeg(shipdata,#0'C'#$f#13#10);
    end;
   end;
  else
   writeg(shipdata,#10#10#10);
  end
 end else begin
  writeg(shipdata,#0'C'#$e+missions[byte(mission3)]+#13#10);
  case byte(mission3) of
   26,25:begin
    if full then writeg(shipdata,'    An:');
    writeg(shipdata,rassen[Mission4]+#13#10);
   end;
   8..10,12:begin
    if full then writeg(shipdata,'  Ziel:');
    writeg(shipdata,shipname(mission4)+#0'C'#$f#13#10);
   end;
   13:begin
    if full then writeg(shipdata,'   Mit:');
    writeg(shipdata,shipname(mission4)+#0'C'#$f#13#10);
   end;
   15..21,31:begin
    if full then writeg(shipdata,'Planet:');
    writeg(shipdata,PlanName(mission4)+#0'C'#$f#13#10);
   end;
   23,24,29,30:begin
    if full then writeg(shipdata,' Basis:');
    writeg(shipdata,BaseName(mission4)+#0'C'#$f#13#10);
   end;
  else
   writeg(shipdata,#0'C'#$f#13#10);
  end;
  writeg(shipdata,'Geliehen von:'#13#10);
  if full then writeg(shipdata,'       '#0'C'#$e);
  writeg(shipdata,rassen[s^.owner]+#0'C'#$f#13#10);
 end;
end;

function soldiers(p:tp_planet):lint;
var
 i:lint;
 k:word;
begin
 with p^ do begin
  k:=forts;
  if k>10 then begin
   i:=1000;
   dec(k,10);
   if k>0 then begin
    if k>90 then begin
     i:=46000;
     dec(k,90);
     if k>0 then begin
      inc(i,1000*k);
     end;
    end else begin
     inc(i,k*500);
    end;
   end;
  end else begin
   i:=k*100;
  end;
  if i>raceanz then i:=raceanz;
 end;
 soldiers:=i;
end;

function income(p:tp_planet):lint;
begin
 with p^ do income:=trunc(((1.0*(raceanz-soldiers(p))*racetax*racecont*racecont))/1000000000);
end;

function nincome(p:tp_planet):lint;
begin
 with p^ do nincome:=trunc(((1.0*nativeanz*nativetax*nativecont*nativecont))/1000000000);
end;

function maxbuilds(n:lint;z:word):word;
{z>50}
var
 x:word;
begin
 if n>5000 then begin
  x:=50;
  dec(n,5000);
  x:=50+trunc(sqrt(n)*(z-50)/9999.749947+0.5);
 end else begin
  x:=n div 100;
 end;
 maxbuilds:=x;
end;

function maxmines(p:tp_planet):word;
begin
 maxmines:=maxbuilds(p^.raceanz,1000);
end;

function maxfacts(p:tp_planet):word;
begin
 maxfacts:=maxbuilds(p^.raceanz,750);
end;

function maxdefs(p:tp_planet):word;
begin
 maxdefs:=maxbuilds(p^.raceanz,600);
end;

function maxforts(p:tp_planet):word;
begin
 with p^ do begin
  if raceanz>91000 then maxforts:=101+(raceanz-91001) div 10000
  else if raceanz>1000 then maxforts:=11+(raceanz-1001) div 1000
  else maxforts:=(raceanz+99) div 100;
 end;
end;

function contentchg(p:tp_planet):integer;
var
 t:integer;
 e,
 f:extended;
begin
 with p^ do begin
  e:=1.2-0.3*sqr((raceanz+nativeanz)/size);
  if e<0 then e:=0;
  f:=1+soldiers(p)/(raceanz-soldiers(p)+nativeanz+1);
  if f>1.5 then f:=1.5;
  e:=e*f;
  f:=(1-0.3*((mines+facts)/(maxfacts(p)+maxmines(p))));
  if f<0.7 then f:=0.7;
  e:=e*f;
  {e=Grundzufriedenheit}
  case ncontent(racecont) of
   5:f:=max(80-integer(racetax),0)/75;
   4:f:=max(70-integer(racetax),0)/68;
   3:f:=max(60-integer(racetax),0)/67;
   2:f:=max(50-integer(racetax),0)/71;
   1:f:=max(40-integer(racetax),0)/72;
   0:f:=max(30-integer(racetax),0)/54;
  end;
  e:=e*f;
  if e>1 then e:=1;
  {e=Endzufriedenheit}
  f:=e-racecont/100;
  if f=0 then t:=0
  else if f>0 then t:=trunc(f*10+0.5)
  else t:=trunc(f*40-0.5);
 end;
 contentchg:=t;
end;

function ncontentchg(p:tp_planet):integer;
var
 t:integer;
 e,
 f:extended;
begin
 with p^ do begin
  e:=1-0.4*sqr((raceanz+nativeanz)/size);
  if e<0 then e:=0;
  f:=1+soldiers(p)/(raceanz-soldiers(p)+nativeanz+1);
  if f>1.5 then f:=1.5;
  e:=e*f;
  {e=Grundzufriedenheit}
  case ncontent(nativecont) of
   5:f:=max(80-integer(nativetax),0)/75;
   4:f:=max(70-integer(nativetax),0)/68;
   3:f:=max(60-integer(nativetax),0)/67;
   2:f:=max(50-integer(nativetax),0)/71;
   1:f:=max(40-integer(nativetax),0)/72;
   0:f:=max(30-integer(nativetax),0)/54;
  end;
  e:=e*f;
  if e>1 then e:=1;
  {e=Endzufriedenheit}
  f:=e-nativecont/100;
  if f=0 then t:=0
  else if f>0 then t:=(trunc(f*10+0.5))
  else t:=trunc(f*40-0.5);
 end;
 ncontentchg:=t;
end;


function ncontent(c:byte):byte;
begin
 case c of
  000..012:ncontent:=0;
  013..031:ncontent:=1;
  032..049:ncontent:=2;
  050..070:ncontent:=3;
  071..090:ncontent:=4;
  091..100:ncontent:=5;
 end;
end;

function nklima(c:byte):byte;
begin
 case c of
  000..030:nklima:=0;
  031..069:nklima:=1;
  070..108:nklima:=2;
  109..147:nklima:=3;
  148..186:nklima:=4;
  187..225:nklima:=5;
  226..255:nklima:=6;
 end;
end;

function nair(c:word):byte;
begin
 c:=(c shr 8) and $f;
 case c of
  00    :nair:=0;
  01..03:nair:=1;
  04..11:nair:=2;
  12..15:nair:=3;
 end;
end;

function dist(x1,y1,z1,x2,y2,z2:integer):word;
var
 d:extended;
begin
 d:=sqrt(((x1-x2)*1.0*(x1-x2)+(y1-y2)*1.0*(y1-y2)+(z1-z2)*1.0*(z1-z2)));
 dist:=trunc(d)+byte(frac(d)<>0);
end;

function time(d,w:integer):word;
begin
 if w=0 then time:=0 else time:=((d+w-1)div w+w-1)div w;
end;

procedure displaybeam(x,y,typ:word);
var
 i:word;
 df:extended;
begin
 rectangle(x-1,y-2,x+101,y+51,8);
 filledrectangle(x,y,x+100,y+50,0);
 inc(y,50);
 with beams[typ] do if range<>0 then begin
  for i:=0 to (range+99) div 100 do begin
   df:=(1-sqr(i*100/range))*50;
   plot(x+i,y-trunc(   kill/maxbdamage*df+0.5),$9);
   plot2(x+i,y-trunc(destroy/maxbdamage*df+0.5),$c,2);
  end;
 end;
end;

procedure displaytorp(x,y,typ:word);
var
 i:word;
 df:extended;
begin
 rectangle(x-1,y-2,x+101,y+51,8);
 filledrectangle(x,y,x+100,y+50,0);
 inc(y,50);
 with torps[typ] do if range<>0 then begin
  for i:=0 to 100 do begin
   df:=exp(sqr(i/100)*ln(range/1000))*50;
   plot(x+i,y-trunc(                 1*df+0.5),$8);
   plot(x+i,y-trunc(   kill/maxtdamage*df+0.5),$9);
   plot2(x+i,y-trunc(destroy/maxtdamage*df+0.5),$c,2);
  end;
 end;
end;

procedure displayfuel(x,y,typ:word);
var
 i:word;
begin
 rectangle(x-1,y-2,x+101,y+51,8);
 filledrectangle(x,y,x+100,y+50,0);
 inc(y,50);
 line(x,y,x+10,y-(engines[typ].fueluse[1]*50 div maxfuse),$c,0);
 for i:=1 to 8 do begin
  vline(x+i*10,y-3,y,$e,0);
  line(x+   10*i,y-(engines[typ].fueluse[i]*50 div maxfuse),
       x+10+10*i,y-(engines[typ].fueluse[i+1]*50 div maxfuse),$c xor (i and 1),0);
 end;
 vline(x+9*10,y-3,y,$e,0);
 line(x+   10*9,y-(engines[typ].fueluse[9]*50 div maxfuse),
      x+10+10*9,y-50,$c xor (9 and 1),0);
end;

function tgewicht(id:lint):lint;
begin
 tgewicht:=torps[id].techlvl;
end;

function keyhandle(c:char;s:byte;rasse,px,py,pz:integer;
		   var tx,ty,tz:sint;var redraw:byte):boolean;
var
 dx,
 dy,
 dz:sint;
 t:lint;
begin
 keyhandle:=true;
 case c of
  #0:case s of
   $85:begin
    runmenu(mainmenu,rasse,0,0,0,0,0);
    redraw:=4;
   end;
   $87:begin
    t:=shiplist(rasse,px,py,pz,5,-1,'Wechsel zu:',0);
    if t<>-1 then begin
     runmenu(shipmenu,rasse,t,0,0,0,0);
     redraw:=4;
    end else redraw:=3;
   end;
   $89:begin
    t:=planid(px,py,pz);
    if (t<>-1)and(getplan(t)^.racetyp=rasse)then begin
     runmenu(planmenu,rasse,t,0,0,0,0);
     redraw:=4;
    end else redraw:=3;
   end;
   $8b:begin
    t:=baseid(px,py,pz);
    if (t<>-1)and(getbase(t)^.owner=rasse)then begin
     runmenu(basemenu,rasse,t,0,0,0,0);
     redraw:=4;
    end else redraw:=3;
   end;
   $86:begin
    runmenu(minemenu,rasse,0,px,py,pz,0);
    redraw:=4;
   end;
   $88:begin
    t:=shiplist(rasse,px,py,pz,1,-1,'Wechsel zu:',0);
    if t<>-1 then begin
     runmenu(shipmenu,rasse,t,0,0,0,0);
     redraw:=4;
    end else redraw:=3;
   end;
   $8a:begin
    t:=planlist(rasse,px,py,pz,1);
    if t<>-1 then begin
     runmenu(planmenu,rasse,t,0,0,0,0);
     redraw:=4;
    end else redraw:=3;
   end;
   $8c:begin
    t:=baselist(rasse,0,0,0,1);
    if (t>=0)and(getbase(t)^.owner=rasse)then begin
     runmenu(basemenu,rasse,t,0,0,0,0);
     redraw:=4;
    end else redraw:=3;
   end;
   $50:{down}if kbstatus and $10=0 then begin
    dx:=0;
    dz:=0;
    if kbstatus and 3<>0 then dy:=-10 else dy:=-1;
    turnxyz2(dx,dy,dz,direct);
    inc(tx,dx);
    inc(ty,dy);
    inc(tz,dz);
    if tx>px+100 then tx:=px+100
    else if tx<px-100 then tx:=px-100
    else if ty>py+100 then ty:=py+100
    else if ty<py-100 then ty:=py-100
    else if tz>pz+100 then tz:=pz+100
    else if tz<pz-100 then tz:=pz-100;
    redraw:=2;
    if tx>10000 then tx:=10000;
    if ty>10000 then ty:=10000;
    if tz>10000 then tz:=10000;
    if tx<-10000 then tx:=-10000;
    if ty<-10000 then ty:=-10000;
    if tz<-10000 then tz:=-10000;
   end;
   $48:{up}if kbstatus and $10=0 then begin
    dx:=0;
    dz:=0;
    if kbstatus and 3<>0 then dy:=10 else dy:=1;
    turnxyz2(dx,dy,dz,direct);
    inc(tx,dx);
    inc(ty,dy);
    inc(tz,dz);
    if tx>px+100 then tx:=px+100
    else if tx<px-100 then tx:=px-100
    else if ty>py+100 then ty:=py+100
    else if ty<py-100 then ty:=py-100
    else if tz>pz+100 then tz:=pz+100
    else if tz<pz-100 then tz:=pz-100;
    redraw:=2;
    if tx>10000 then tx:=10000;
    if ty>10000 then ty:=10000;
    if tz>10000 then tz:=10000;
    if tx<-10000 then tx:=-10000;
    if ty<-10000 then ty:=-10000;
    if tz<-10000 then tz:=-10000;
   end;
   $4d:{right}if kbstatus and $10=0 then begin
    dy:=0;
    dz:=0;
    if kbstatus and 3<>0 then dx:=10 else dx:=1;
    turnxyz2(dx,dy,dz,direct);
    inc(tx,dx);
    inc(ty,dy);
    inc(tz,dz);
    if tx>px+100 then tx:=px+100
    else if tx<px-100 then tx:=px-100
    else if ty>py+100 then ty:=py+100
    else if ty<py-100 then ty:=py-100
    else if tz>pz+100 then tz:=pz+100
    else if tz<pz-100 then tz:=pz-100;
    redraw:=2;
    if tx>10000 then tx:=10000;
    if ty>10000 then ty:=10000;
    if tz>10000 then tz:=10000;
    if tx<-10000 then tx:=-10000;
    if ty<-10000 then ty:=-10000;
    if tz<-10000 then tz:=-10000;
   end;
   $4b:{left}if kbstatus and $10=0 then begin
    dy:=0;
    dz:=0;
    if kbstatus and 3<>0 then dx:=-10 else dx:=-1;
    turnxyz2(dx,dy,dz,direct);
    inc(tx,dx);
    inc(ty,dy);
    inc(tz,dz);
    if tx>px+100 then tx:=px+100
    else if tx<px-100 then tx:=px-100
    else if ty>py+100 then ty:=py+100
    else if ty<py-100 then ty:=py-100
    else if tz>pz+100 then tz:=pz+100
    else if tz<pz-100 then tz:=pz-100;
    redraw:=2;
    if tx>10000 then tx:=10000;
    if ty>10000 then ty:=10000;
    if tz>10000 then tz:=10000;
    if tx<-10000 then tx:=-10000;
    if ty<-10000 then ty:=-10000;
    if tz<-10000 then tz:=-10000;
   end;
   $49:{PgUp}if kbstatus and $10=0 then begin
    dx:=0;
    dy:=0;
    if kbstatus and 3<>0 then dz:=10 else dz:=1;
    turnxyz2(dx,dy,dz,direct);
    inc(tx,dx);
    inc(ty,dy);
    inc(tz,dz);
    if tx>px+100 then tx:=px+100
    else if tx<px-100 then tx:=px-100
    else if ty>py+100 then ty:=py+100
    else if ty<py-100 then ty:=py-100
    else if tz>pz+100 then tz:=pz+100
    else if tz<pz-100 then tz:=pz-100;
    if tx>10000 then tx:=10000;
    if ty>10000 then ty:=10000;
    if tz>10000 then tz:=10000;
    if tx<-10000 then tx:=-10000;
    if ty<-10000 then ty:=-10000;
    if tz<-10000 then tz:=-10000;
    redraw:=2;
   end;
   $51:{PgDn}if kbstatus and $10=0 then begin
    dx:=0;
    dy:=0;
    if kbstatus and 3<>0 then dz:=-10 else dz:=-1;
    turnxyz2(dx,dy,dz,direct);
    inc(tx,dx);
    inc(ty,dy);
    inc(tz,dz);
    if tx>px+100 then tx:=px+100
    else if tx<px-100 then tx:=px-100
    else if ty>py+100 then ty:=py+100
    else if ty<py-100 then ty:=py-100
    else if tz>pz+100 then tz:=pz+100
    else if tz<pz-100 then tz:=pz-100;
    if tx>10000 then tx:=10000;
    if ty>10000 then ty:=10000;
    if tz>10000 then tz:=10000;
    if tx<-10000 then tx:=-10000;
    if ty<-10000 then ty:=-10000;
    if tz<-10000 then tz:=-10000;
    redraw:=2;
   end;
   $8d,$47:{^Up}{home}begin
    direct:=turn[2,direct];
    redraw:=2;
   end;
   $91,$4f:{^Down}{end}begin
    direct:=turn[3,direct];
    redraw:=2;
   end;
   $73,$52:{^Left}{ins}begin
    direct:=turn[0,direct];
    redraw:=2;
   end;
   $74,$53:{^Right}{del}begin
    direct:=turn[1,direct];
    redraw:=2;
   end;
   $84:{^PgUp}begin
    direct:=turn[5,direct];
    redraw:=2;
   end;
   $76:{^PgDn}begin
    direct:=turn[4,direct];
    redraw:=2;
   end;
   0:{Mausbewegung}begin
    dx:=mmovex;
    dy:=mmovey;
    dz:=mmovez;
    mreset;
    kbreset;
    if dx>200 then dx:=200
    else if dx<-200 then dx:=-200;
    if dy>200 then dy:=200
    else if dy<-200 then dy:=-200;
    if dy>200 then dy:=200
    else if dy<-200 then dy:=-200;
    turnxyz2(dx,dy,dz,direct);
    inc(tx,dx);
    inc(ty,dy);
    inc(tz,dz);
    if tx>px+100 then tx:=px+100
    else if tx<px-100 then tx:=px-100;
    if ty>py+100 then ty:=py+100
    else if ty<py-100 then ty:=py-100;
    if tz>pz+100 then tz:=pz+100
    else if tz<pz-100 then tz:=pz-100;
    redraw:=2;
    if tx>10000 then tx:=10000;
    if ty>10000 then ty:=10000;
    if tz>10000 then tz:=10000;
    if tx<-10000 then tx:=-10000;
    if ty<-10000 then ty:=-10000;
    if tz<-10000 then tz:=-10000;
   end;
  else
   keyhandle:=false;
  end;
  #27:begin
   runmenu(mainmenu,rasse,0,0,0,0,0);
   redraw:=4;
  end;
  '/':if s=$e0 then begin
   direct:=turn[5,direct];
   redraw:=2;
  end else begin
   keyhandle:=false;
  end;
  '*':if s=$37 then begin
   direct:=turn[4,direct];
   redraw:=2;
  end else begin
   keyhandle:=false;
  end;
  '0'..'9',',','.':begin
   case s of
    $50:{down}if kbstatus and $10=0 then begin
     dx:=0;
     dz:=0;
     if kbstatus and 3<>0 then dy:=-10 else dy:=-1;
     turnxyz2(dx,dy,dz,direct);
     inc(tx,dx);
     inc(ty,dy);
     inc(tz,dz);
     if tx>px+100 then tx:=px+100
     else if tx<px-100 then tx:=px-100
     else if ty>py+100 then ty:=py+100
     else if ty<py-100 then ty:=py-100
     else if tz>pz+100 then tz:=pz+100
     else if tz<pz-100 then tz:=pz-100;
     redraw:=2;
    end;
    $48:{up}if kbstatus and $10=0 then begin
     dx:=0;
     dz:=0;
     if kbstatus and 3<>0 then dy:=10 else dy:=1;
     turnxyz2(dx,dy,dz,direct);
     inc(tx,dx);
     inc(ty,dy);
     inc(tz,dz);
     if tx>px+100 then tx:=px+100
     else if tx<px-100 then tx:=px-100
     else if ty>py+100 then ty:=py+100
     else if ty<py-100 then ty:=py-100
     else if tz>pz+100 then tz:=pz+100
     else if tz<pz-100 then tz:=pz-100;
     redraw:=2;
    end;
    $4d:{right}if kbstatus and $10=0 then begin
     dy:=0;
     dz:=0;
     if kbstatus and 3<>0 then dx:=10 else dx:=1;
     turnxyz2(dx,dy,dz,direct);
     inc(tx,dx);
     inc(ty,dy);
     inc(tz,dz);
     if tx>px+100 then tx:=px+100
     else if tx<px-100 then tx:=px-100
     else if ty>py+100 then ty:=py+100
     else if ty<py-100 then ty:=py-100
     else if tz>pz+100 then tz:=pz+100
     else if tz<pz-100 then tz:=pz-100;
     redraw:=2;
    end;
    $4b:{left}if kbstatus and $10=0 then begin
     dy:=0;
     dz:=0;
     if kbstatus and 3<>0 then dx:=-10 else dx:=-1;
     turnxyz2(dx,dy,dz,direct);
     inc(tx,dx);
     inc(ty,dy);
     inc(tz,dz);
     if tx>px+100 then tx:=px+100
     else if tx<px-100 then tx:=px-100
     else if ty>py+100 then ty:=py+100
     else if ty<py-100 then ty:=py-100
     else if tz>pz+100 then tz:=pz+100
     else if tz<pz-100 then tz:=pz-100;
     redraw:=2;
    end;
    $49:{PgUp}if kbstatus and $10=0 then begin
     dx:=0;
     dy:=0;
     if kbstatus and 3<>0 then dz:=10 else dz:=1;
     turnxyz2(dx,dy,dz,direct);
     inc(tx,dx);
     inc(ty,dy);
     inc(tz,dz);
     if tx>px+100 then tx:=px+100
     else if tx<px-100 then tx:=px-100
     else if ty>py+100 then ty:=py+100
     else if ty<py-100 then ty:=py-100
     else if tz>pz+100 then tz:=pz+100
     else if tz<pz-100 then tz:=pz-100;
     redraw:=2;
    end;
    $51:{PgDn}if kbstatus and $10=0 then begin
     dx:=0;
     dy:=0;
     if kbstatus and 3<>0 then dz:=-10 else dz:=-1;
     turnxyz2(dx,dy,dz,direct);
     inc(tx,dx);
     inc(ty,dy);
     inc(tz,dz);
     if tx>px+100 then tx:=px+100
     else if tx<px-100 then tx:=px-100
     else if ty>py+100 then ty:=py+100
     else if ty<py-100 then ty:=py-100
     else if tz>pz+100 then tz:=pz+100
     else if tz<pz-100 then tz:=pz-100;
     redraw:=2;
    end;
    $8d,$47:{^Up}{home}begin
     direct:=turn[2,direct];
     redraw:=2;
    end;
    $91,$4f:{^Down}{end}begin
     direct:=turn[3,direct];
     redraw:=2;
    end;
    $73,$52:{^Left}{ins}begin
     direct:=turn[0,direct];
     redraw:=2;
    end;
    $74,$53:{^Right}{del}begin
     direct:=turn[1,direct];
     redraw:=2;
    end;
    $84:{^PgUp}begin
     direct:=turn[5,direct];
     redraw:=2;
    end;
    $76:{^PgDn}begin
     direct:=turn[4,direct];
     redraw:=2;
    end;
   else
    keyhandle:=false;
   end;
   if tx>10000 then tx:=10000;
   if ty>10000 then ty:=10000;
   if tz>10000 then tz:=10000;
   if tx<-10000 then tx:=-10000;
   if ty<-10000 then ty:=-10000;
   if tz<-10000 then tz:=-10000;
  end;
 else
  keyhandle:=false;
 end;
end;

function fueluse(d,m,warp,engtyp:integer):lint;
begin
 if warp=0 then fueluse:=0
 else fueluse:=(lint(d)*m*engines[engtyp].fueluse[warp]+999999) div 1000000;
end;

function EngName(id:lint):string20;
var
 s:tp_planet;
begin
 if (id>0)and(id<10)
 then engname:=engines[id].name
 else engname:='¿Antrieb?';
end;

function beamName(id:lint):string20;
var
 s:tp_planet;
begin
 if (id>0)and(id<10)
 then beamname:=beams[id].name
 else beamname:='(keine)';
end;

function torpName(id:lint):string20;
var
 s:tp_planet;
begin
 if (id>0)and(id<10)
 then torpname:=torps[id].name
 else torpname:='(keine)';
end;

function torprName(id:lint):string20;
var
 s:tp_planet;
begin
 if (id>0)and(id<10)
 then torprname:=torprohre[id].name
 else torprname:='(keine)';
end;

function mineName(id:lint):string20;
var
 s:tp_planet;
begin
 if (id>0)and(id<10)
 then minename:=mines[id].name
 else Minename:='(keine)';
end;

procedure turnxyz2(var x,y,z:sint;rotate:word);
var
 t:integer;
begin
 case rotate of
  0,1:;
  2:begin
   t:=x;
   x:=-y;
   y:=t;
  end;
  3:begin
   x:=-x;
   y:=-y;
  end;
  4:begin
   t:=x;
   x:=y;
   y:=-t;
  end;
  5:begin
   z:=-z;
   x:=-x;
  end;
  6:begin
   z:=-z;
   t:=x;
   x:=y;
   y:=t;
  end;
  7:begin
   z:=-z;
   y:=-y;
  end;
  8:begin
   z:=-z;
   t:=x;
   x:=-y;
   y:=-t;
  end;
  9:begin
   t:=x;
   x:=-z;
   z:=t;
  end;
  10:begin
   t:=y;
   y:=x;
   x:=-z;
   z:=-t;
  end;
  11:begin
   y:=-y;
   t:=x;
   x:=-z;
   z:=-t;
  end;
  12:begin
   t:=x;
   x:=-z;
   z:=y;
   y:=-t;
  end;
  13:begin
   t:=x;
   x:=z;
   z:=-t;
  end;
  14:begin
   t:=x;
   x:=z;
   z:=y;
   y:=t;
  end;
  15:begin
   y:=-y;
   t:=x;
   x:=z;
   z:=t;
  end;
  16:begin
   t:=y;
   y:=-x;
   x:=z;
   z:=-t;
  end;
  17:begin
   t:=x;
   x:=y;
   y:=z;
   z:=t;
  end;
  18:begin
   t:=y;
   y:=z;
   z:=-t;
  end;
  19:begin
   t:=x;
   x:=-y;
   y:=z;
   z:=-t;
  end;
  20:begin
   x:=-x;
   t:=y;
   y:=z;
   z:=t;
  end;
  21:begin
   t:=x;
   x:=-y;
   y:=-z;
   z:=t;
  end;
  22:begin
   t:=-y;
   y:=-z;
   z:=-t;
  end;
  23:begin
   t:=x;
   x:=y;
   y:=-z;
   z:=t;
  end;
  24:begin
   x:=-x;
   t:=y;
   y:=-z;
   z:=-t;
  end;
 end;
end;

procedure turnxyz(var x,y,z:sint;rotate:word);
var
 t:integer;
begin
 case rotate of
  0,1:;
  2:begin
   t:=x;
   x:=y;
   y:=-t;
  end;
  3:begin
   x:=-x;
   y:=-y;
  end;
  4:begin
   t:=x;
   x:=-y;
   y:=t;
  end;
  5:begin
   z:=-z;
   x:=-x;
  end;
  6:begin
   z:=-z;
   t:=x;
   x:=y;
   y:=t;
  end;
  7:begin
   z:=-z;
   y:=-y;
  end;
  8:begin
   z:=-z;
   t:=x;
   x:=-y;
   y:=-t;
  end;
  9:begin
   t:=x;
   x:=z;
   z:=-t;
  end;
  10:begin
   t:=x;
   x:=y;
   y:=-z;
   z:=-t;
  end;
  11:begin
   y:=-y;
   t:=x;
   x:=-z;
   z:=-t;
  end;
  12:begin
   t:=x;
   x:=-y;
   y:=z;
   z:=-t;
  end;
  13:begin
   t:=x;
   x:=-z;
   z:=t;
  end;
  14:begin
   t:=x;
   x:=y;
   y:=z;
   z:=t;
  end;
  15:begin
   y:=-y;
   t:=x;
   x:=z;
   z:=t;
  end;
  16:begin
   t:=x;
   x:=-y;
   y:=-z;
   z:=t;
  end;
  17:begin
   t:=x;
   x:=z;
   z:=y;
   y:=t;
  end;
  18:begin
   t:=y;
   y:=-z;
   z:=t;
  end;
  19:begin
   t:=x;
   x:=-z;
   z:=y;
   y:=-t;
  end;
  20:begin
   x:=-x;
   t:=y;
   y:=z;
   z:=t;
  end;
  21:begin
   t:=x;
   x:=-z;
   z:=-y;
   y:=t;
  end;
  22:begin
   t:=y;
   y:=z;
   z:=-t;
  end;
  23:begin
   t:=x;
   x:=z;
   z:=-y;
   y:=-t;
  end;
  24:begin
   x:=-x;
   t:=y;
   y:=-z;
   z:=-t;
  end;
 end;
end;

procedure xyz(x,y,z,px,py,pz:sint;rotate:integer;var x1,y1,d:sword);
var
 t:integer;
begin
 x:=x-px;
 y:=y-py;
 z:=z-pz;
 turnxyz(x,y,z,rotate);
 x1:=485+x+(z+1) div 2;
 y1:=130-y-(z+3) div 4;
 d:=(-z+100) div 40;
 if d=5 then d:=4;
end;

procedure CrossHair(x,y,z:sint);
var
 x1,y1,
 x2,y2,d:sword;
begin
 turnxyz(x,y,z,direct);
 xyz(-101,y,z,0,0,0,0,x1,y1,d);
 xyz(x,y,z,0,0,0,0,x2,y2,d);
 line(x1,y1,x2,y2,$f,3);
 xyz(x,101,z,0,0,0,0,x1,y1,d);
 line(x1,y1,x2,y2,$f,3);
 xyz(x,y,101,0,0,0,0,x1,y1,d);
 line(x1,y1,x2,y2,$f,3);
 xyz(101,-101,z,0,0,0,0,x2,y2,d);
 rectangle(x2-1,y2-1,x2+1,y2+1,$f);
 xyz(-101,y,-101,0,0,0,0,x2,y2,d);
 rectangle(x2-1,y2-1,x2+1,y2+1,$f);
 xyz(x,-101,-101,0,0,0,0,x2,y2,d);
 rectangle(x2-1,y2-1,x2+1,y2+1,$f);
end;

procedure DisplayStars(rasse,x,y,z,tx,ty,tz:sint);
var
 x1,y1,x2,y2,d:sword;
 fid,id,pid:lint;
 ship:tp_schiff;
 plan:tp_planet;
 base:tp_starbase;
 px,py,pz:sint;
begin
 filledrectangle(368,3,637,31,0);
 filledrectangle(333,32,637,256,0);
 vline(435,003    ,205,$7,0);
 hline(435,    637,205,$7);
 line (334,255,435,205,$7,0);
 hline(434,    637,003,$f);
 line (334,053,435,003,$f,0);
 line (536,053,637,003,$f,0);
 begin
  xyz(101,-101,-100,0,0,0,0,x1,y1,d);
  xyz(101,-101,-61,0,0,0,0,x2,y2,d);
  line(x1,y1,x2,y2,starcols[0,d],0);
  xyz(101,-101,-21,0,0,0,0,x1,y1,d);
  line(x1,y1,x2,y2,starcols[0,d],0);
  xyz(101,-101,19,0,0,0,0,x2,y2,d);
  line(x1,y1,x2,y2,starcols[0,d],0);
  xyz(101,-101,59,0,0,0,0,x1,y1,d);
  line(x1-1,y1,x2-1,y2,starcols[0,d],0);
  xyz(101,-101,101,0,0,0,0,x2,y2,d);
  line(x1,y1,x2,y2,starcols[0,d],0);
 end;
 vline(637,003,205,    $f,0);
 rectangle(334,053,536,255,$f);
 xyz(0,0,0,0,0,0,0,x2,y2,d);
 xyz(tx,ty,tz,x,y,z,direct,x1,y1,d);
 if d<2 then line(x1,y1,x2,y2,$6,3)
 else if d<3 then line(x1,y1,x2,y2,$e,3)
 else line(x1,y1,x2,y2,$b,3);
 writex(73,16,$c,'X');
 writes($e,'Y');
 writes($a,'Z');
 x1:=620-x2;
 y1:=240-y2;
 xyz(15,0,0,0,0,0,direct,x2,y2,d);
 inc(x2,x1);
 inc(y2,y1);
 line(620,240,x2,y2,$c,0);
 xyz(0,15,0,0,0,0,direct,x2,y2,d);
 inc(x2,x1);
 inc(y2,y1);
 line(620,240,x2,y2,$e,0);
 xyz(0,0,15,0,0,0,direct,x2,y2,d);
 inc(x2,x1);
 inc(y2,y1);
 line(620,240,x2,y2,$a,0);
 xyz(101,-101,0,0,0,0,0,x2,y2,d);
 rectangle(x2-1,y2-1,x2+1,y2+1,$e);
 crosshair(tx-x,ty-y,tz-z);

 turnxyz(tx,ty,tz,direct);

 fid:=firstplan(rasse,x,y,z,4);
 id:=fid;
 if id<>-1 then repeat
  plan:=getplan(id);
  with plan^ do begin
   xyz(posx,posy,posz,x,y,z,direct,x1,y1,d);
   if racetyp=rasse then begin
    plot(x1,y1,starcols[0,d]);
    rrectangle(x1-3,y1-3,x1+3,y1+3,9,0);
   end else begin
    plot(x1,y1,starcols[0,d]);
   end;
   px:=posx;
   py:=posy;
   pz:=posz;
   turnxyz(px,py,pz,direct);
   if pz=tz then rrectangle(x1-2,y1-2,x1+2,y1+2,$7,0)
   else if pz<tz then rrectangle(x1-2,y1-2,x1+2,y1+2,$8,0)
  end;
  id:=nextplan(id,rasse,x,y,z,4);
 until fid=id;

 fid:=firstbase(rasse,x,y,z,4);
 id:=fid;
 if id<>-1 then repeat
  base:=getbase(id);
  with base^ do begin
   xyz(posx,posy,posz,x,y,z,direct,x1,y1,d);
   if owner=rasse then begin
    filledrectangle(x1-1,y1-1,x1+1,y1+1,starcols[0,d])
   end else begin
    filledrectangle(x1-1,y1-1,x1+1,y1+1,starcols[2,d])
   end;
   px:=posx;
   py:=posy;
   pz:=posz;
   turnxyz(px,py,pz,direct);
   if pz=tz then rrectangle(x1-2,y1-2,x1+2,y1+2,$7,0)
   else if pz<tz then rrectangle(x1-2,y1-2,x1+2,y1+1,$8,0)
  end;
  id:=nextbase(id,rasse,x,y,z,4);
 until fid=id;

 fid:=firstship(rasse,x,y,z,4);
 id:=fid;
 if id<>-1 then repeat
  ship:=getship(id);
  with ship^ do begin
   pid:=planid(posx,posy,posz);
   xyz(posx,posy,posz,x,y,z,direct,x1,y1,d);
   if (owner=rasse)or(mission1=25)and(mission2=rasse)
   then begin
    if pid<>-1 then begin
     if getplan(pid)^.racetyp=rasse
     then rrectangle(x1-4,y1-4,x1+4,y1+4,3,0)
     else rrectangle(x1-4,y1-4,x1+4,y1+4,2,0);
    end else plot(x1,y1,starcols[1,d]);
   end else begin
    if pid<>-1 then rrectangle(x1-4,y1-4,x1+4,y1+4,4,0)
    else plot(x1,y1,starcols[2,d]);
   end;
   px:=posx;
   py:=posy;
   pz:=posz;
   turnxyz(px,py,pz,direct);
   if pz=tz then rrectangle(x1-2,y1-2,x1+2,y1+2,$7,0)
   else if pz<tz then rrectangle(x1-2,y1-2,x1+2,y1+2,$8,0)
  end;
  id:=nextship(id,rasse,x,y,z,4);
 until fid=id;
end;

function FirstShip(rasse,x,y,z,mode:integer):lint;
var
 i:word;
begin
 firstship:=-1;
 if shipsanz>0 then if mode=0 then begin
  if shipsanz>0
  then firstship:=ships1^[0].id_nr
  else firstship:=-1;
 end else begin

  for i:=0 to min(499,shipsanz-1) do begin
   with ships1^[i] do
   if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
   and(((mode<>2)and(mode<>7)and(mode<>8))or((owner<>rasse)and((mission1<>25)or(Mission2<>rasse))))
   and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z)))
   and(((mode<>4)and(mode<>6)and(mode<>8))
       or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
   then begin
    with shipcache do begin
     id:=id_nr;
     a:=0;
     b:=i;
    end;
    firstship:=id_nr;
    exit;
   end;
  end;
  if shipsanz>=500 then begin
   for i:=500 to min(999,shipsanz-1)do begin
    with ships2^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or((owner<>rasse)and((mission1<>25)or(Mission2<>rasse))))
    and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z)))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
    then begin
     with shipcache do begin
      id:=id_nr;
      a:=1;
      b:=i;
     end;
     firstship:=id_nr;
     exit;
    end;
   end;
  end;
  if shipsanz>=1000 then begin
   for i:=1000 to min(1499,shipsanz-1)do begin
    with ships3^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or((owner<>rasse)and((mission1<>25)or(Mission2<>rasse))))
    and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z)))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
    then begin
     with shipcache do begin
      id:=id_nr;
      a:=2;
      b:=i;
     end;
     firstship:=id_nr;
     exit;
    end;
   end;
  end;
  if shipsanz>=1500 then begin
   for i:=1500 to min(1999,shipsanz-1)do begin
    with ships4^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or((owner<>rasse)and((mission1<>25)or(Mission2<>rasse))))
    and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z)))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
    then begin
     firstship:=id_nr;
     with shipcache do begin
      id:=id_nr;
      a:=3;
      b:=i;
     end;
     exit;
    end;
   end;
  end;
  if shipsanz>=2000 then begin
   for i:=2000 to min(2499,shipsanz-1)do begin
    with ships5^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or((owner<>rasse)and((mission1<>25)or(Mission2<>rasse))))
    and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z)))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
    then begin
     with shipcache do begin
      id:=id_nr;
      a:=4;
      b:=i;
     end;
     firstship:=id_nr;
     exit;
    end;
   end;
  end;
  if shipsanz>=2500 then begin
   for i:=2500 to min(2999,shipsanz-1)do begin
    with ships6^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or((owner<>rasse)and((mission1<>25)or(Mission2<>rasse))))
    and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z)))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
    then begin
     firstship:=id_nr;
     with shipcache do begin
      id:=id_nr;
      a:=5;
      b:=i;
     end;
     exit;
    end;
   end;
  end;
  if shipsanz>3000 then begin
   for i:=3000 to min(3499,shipsanz-1)do begin
    with ships7^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or((owner<>rasse)and((mission1<>25)or(Mission2<>rasse))))
    and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z)))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
    then begin
     firstship:=id_nr;
     with shipcache do begin
      id:=id_nr;
      a:=6;
      b:=i;
     end;
     exit;
    end;
   end;
  end;

 end;
end;

function NextShip(id:lint;rasse,x,y,z,mode:integer):lint;
var
 i:word;
 first:lint;
begin
 nextship:=-1;
 first:=-1;
 if id=-1 then exit;
 if(shipcache.id=id) then with shipcache do begin
  if shipsanz<>0 then begin
   if a=0 then begin
    for i:=b to min(499,shipsanz-1) do begin
     with ships1^[i] do
     if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
     and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
     and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z))
     and(((mode<>4)and(mode<>6)and(mode<>8))
	   or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101))))
     then begin
      if id_nr>id then begin
       nextship:=id_nr;
       with shipcache do begin
	id:=id_nr;
	b:=i;
       end;
       exit;
      end;
     end;
    end;
    if shipsanz>500 then begin
     a:=1;
     b:=500
    end else begin
     a:=0;
     b:=0;
    end;
   end;
   if shipsanz>=500 then begin
    if a=1 then begin
     for i:=b to min(999,shipsanz-1) do begin
      with ships2^[i] do
      if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
      and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
      and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z))
      and(((mode<>4)and(mode<>6)and(mode<>8))
	    or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101))))
      then begin
       if id_nr>id then begin
	nextship:=id_nr;
	with shipcache do begin
	 id:=id_nr;
	 b:=i;
	end;
	exit;
       end;
      end;
     end;
    end;
    if shipsanz>1000 then begin
     a:=2;
     b:=1000
    end else begin
     a:=0;
     b:=0;
    end;
   end;
   if shipsanz>=1000 then begin
    if a=2 then begin
      for i:=b to min(1499,shipsanz-1) do begin
      with ships3^[i] do
      if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
      and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
      and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z))
      and(((mode<>4)and(mode<>6)and(mode<>8))
	    or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101))))
      then begin
       if id_nr>id then begin
	nextship:=id_nr;
	with shipcache do begin
	 id:=id_nr;
	 b:=i;
	end;
	exit;
       end;
      end;
     end;
    end;
    if shipsanz>1500 then begin
     a:=3;
     b:=1500
    end else begin
     a:=0;
     b:=0;
    end;
   end;
   if shipsanz>=1500 then begin
    if a=3 then begin
     for i:=b to min(1999,shipsanz-1) do begin
      with ships4^[i] do
      if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
      and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
      and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z))
      and(((mode<>4)and(mode<>6)and(mode<>8))
	    or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101))))
      then begin
       if id_nr>id then begin
	nextship:=id_nr;
	with shipcache do begin
	 id:=id_nr;
	 b:=i;
	end;
	exit;
       end;
      end;
     end;
    end;
    if shipsanz>2000 then begin
     a:=4;
     b:=2000
    end else begin
     a:=0;
     b:=0;
    end;
   end;
   if shipsanz>=2000 then begin
    if a=4 then begin
     for i:=b to min(2499,shipsanz-1) do begin
      with ships5^[i] do
      if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
      and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
      and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z))
      and(((mode<>4)and(mode<>6)and(mode<>8))
	    or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101))))
      then begin
       if id_nr>id then begin
	nextship:=id_nr;
	with shipcache do begin
	 id:=id_nr;
	 b:=i;
	end;
	exit;
       end;
      end;
     end;
    end;
    if shipsanz>2500 then begin
     a:=5;
     b:=2500
    end else begin
     a:=0;
     b:=0;
    end;
   end;
   if shipsanz>=2500 then begin
    if a=5 then begin
     for i:=b to min(2999,shipsanz-1) do begin
      with ships6^[i] do
      if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
      and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
      and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z))
      and(((mode<>4)and(mode<>6)and(mode<>8))
	    or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101))))
      then begin
       if id_nr>id then begin
	nextship:=id_nr;
	with shipcache do begin
	 id:=id_nr;
	 b:=i;
	end;
	exit;
       end;
      end;
     end;
    end;
    if shipsanz>3000 then begin
     a:=6;
     b:=3000
    end else begin
     a:=0;
     b:=0;
    end;
   end;
   if shipsanz>=3000 then begin
    if a=6 then begin
     for i:=b to min(3499,shipsanz-1) do begin
      with ships7^[i] do
      if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
      and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
      and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z))
      and(((mode<>4)and(mode<>6)and(mode<>8))
	    or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101))))
      then begin
       if id_nr>id then begin
	nextship:=id_nr;
	with shipcache do begin
	 id:=id_nr;
	 b:=i;
	end;
	exit;
       end;
      end;
     end;
    end;
    a:=0;
    b:=0;
   end;
  end;
 end;
 if shipsanz<>0 then begin
  for i:=0 to min(499,shipsanz-1) do begin
   with ships1^[i] do
   if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
   and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
   and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z))
   and(((mode<>4)and(mode<>6)and(mode<>8))
	 or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101))))
   then begin
    if first=-1 then first:=id_nr;
    if id_nr>id then begin
     nextship:=id_nr;
     with shipcache do begin
      id:=id_nr;
      a:=0;
      b:=i;
     end;
     exit;
    end;
   end;
  end;
  if shipsanz>=500 then begin
   for i:=500 to min(999,shipsanz-1) do begin
    with ships2^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
    and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	  or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101))))
    then begin
     if first=-1 then first:=id_nr;
     if id_nr>id then begin
      nextship:=id_nr;
      with shipcache do begin
       id:=id_nr;
       a:=1;
       b:=i;
      end;
      exit;
     end;
    end;
   end;
  end;
  if shipsanz>=1000 then begin
   for i:=1000 to min(1499,shipsanz-1) do begin
    with ships3^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
    and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	  or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101))))
    then begin
     if first=-1 then first:=id_nr;
     if id_nr>id then begin
      nextship:=id_nr;
      with shipcache do begin
       id:=id_nr;
       a:=2;
       b:=i;
      end;
      exit;
     end;
    end;
   end;
  end;
  if shipsanz>=1500 then begin
   for i:=1500 to min(1999,shipsanz-1) do begin
    with ships4^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
    and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	  or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101))))
    then begin
     if first=-1 then first:=id_nr;
     if id_nr>id then begin
      nextship:=id_nr;
      with shipcache do begin
       id:=id_nr;
       a:=3;
       b:=i;
      end;
      exit;
     end;
    end;
   end;
  end;
  if shipsanz>=2000 then begin
   for i:=2000 to min(2499,shipsanz-1) do begin
    with ships5^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
    and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	  or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101))))
    then begin
     if first=-1 then first:=id_nr;
     if id_nr>id then begin
      nextship:=id_nr;
      with shipcache do begin
       id:=id_nr;
       a:=4;
       b:=i;
      end;
      exit;
     end;
    end;
   end;
  end;
  if shipsanz>=2500 then begin
   for i:=2500 to min(2999,shipsanz-1) do begin
    with ships6^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
    and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	  or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101))))
    then begin
     if first=-1 then first:=id_nr;
     if id_nr>id then begin
      nextship:=id_nr;
      with shipcache do begin
       id:=id_nr;
       a:=5;
       b:=i;
      end;
      exit;
     end;
    end;
   end;
  end;
  if shipsanz>=3000 then begin
   for i:=3000 to min(3499,shipsanz-1) do begin
    with ships7^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
    and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	  or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101))))
    then begin
     if first=-1 then first:=id_nr;
     if id_nr>id then begin
      nextship:=id_nr;
      with shipcache do begin
       id:=id_nr;
       a:=6;
       b:=i;
      end;
      exit;
     end;
    end;
   end;
  end;

 end;
 nextship:=first;
end;

function LastShip(id:lint;rasse,x,y,z,mode:integer):lint;
var
 i:word;
 this:lint;
begin
 lastship:=-1;
 this:=-1;
 if shipsanz>0 then begin

  for i:=0 to min(499,shipsanz-1) do begin
   with ships1^[i] do
   if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
   and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
   and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z))
   and(((mode<>4)and(mode<>6)and(mode<>8))
	 or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101))))
   then begin
    if id_nr=id then begin
     if this<>-1 then begin
      lastship:=this;
      exit;
     end;
    end;
    this:=id_nr;
   end;
  end;
  if shipsanz>500 then begin
   for i:=500 to min(999,shipsanz-1) do begin
    with ships2^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
    and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	  or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101))))
    then begin
     if id_nr=id then begin
      if this<>-1 then begin
       lastship:=this;
       exit;
      end;
     end;
     this:=id_nr;
    end;
   end;
  end;
  if shipsanz>1000 then begin
   for i:=1000 to min(1499,shipsanz-1) do begin
    with ships3^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
    and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	  or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101))))
    then begin
     if id_nr=id then begin
      if this<>-1 then begin
       lastship:=this;
       exit;
      end;
     end;
     this:=id_nr;
    end;
   end;
  end;
  if shipsanz>1500 then begin
   for i:=1500 to min(1999,shipsanz-1) do begin
    with ships4^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
    and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	  or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101))))
    then begin
     if id_nr=id then begin
      if this<>-1 then begin
       lastship:=this;
       exit;
      end;
     end;
     this:=id_nr;
    end;
   end;
  end;
  if shipsanz>2000 then begin
   for i:=2000 to min(2499,shipsanz-1) do begin
    with ships5^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
    and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	  or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101))))
    then begin
     if id_nr=id then begin
      if this<>-1 then begin
       lastship:=this;
       exit;
      end;
     end;
     this:=id_nr;
    end;
   end;
  end;
  if shipsanz>2500 then begin
   for i:=2500 to min(2999,shipsanz-1) do begin
    with ships6^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
    and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	  or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101))))
    then begin
     if id_nr=id then begin
      if this<>-1 then begin
       lastship:=this;
       exit;
      end;
     end;
     this:=id_nr;
    end;
   end;
  end;
  if shipsanz>3000 then begin
   for i:=3000 to min(3499,shipsanz-1) do begin
    with ships7^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
    and(((mode<>3)and(mode<>5)and(mode<>7))or((posx=x)and(posy=y)and(posz=z))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	  or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101))))
    then begin
     if id_nr=id then begin
      if this<>-1 then begin
       lastship:=this;
       exit;
      end;
     end;
     this:=id_nr;
    end;
   end;
  end;

 end;
 lastship:=this;
end;

function Firstplan(rasse,x,y,z,mode:integer):lint;
var
 id:lint;
 i:word;
 planet:tp_planet;
begin
 firstplan:=-1;
 if mode=0 then begin
  if planetsanz>0
  then firstplan:=planets1^[0].id_nr
  else firstplan:=-1;
 end else if (mode=3)or(mode=5)or(mode=7) then begin
  id:=planid(x,y,z);
  planet:=getplan(id);
  if(id=-1)or(mode=5)and(planet^.racetyp<>rasse)
  or(mode=7)and(planet^.racetyp=rasse)
  then firstplan:=-1 else firstplan:=id;
 end else begin
  if planetsanz>500 then begin
   for i:=0 to 499 do begin
    with planets1^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(racetyp=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(racetyp<>rasse))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
    then begin
     firstplan:=id_nr;
     with plancache do begin
      id:=id_nr;
      x:=posx;
      y:=posy;
      z:=posz;
      a:=0;
      b:=i;
     end;
     exit;
    end;
   end;
   for i:=500 to planetsanz-1 do begin
    with planets2^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(racetyp=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(racetyp<>rasse))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
    then begin
     firstplan:=id_nr;
     with plancache do begin
      id:=id_nr;
      x:=posx;
      y:=posy;
      z:=posz;
      a:=1;
      b:=i;
     end;
     exit;
    end;
   end;
  end else for i:=0 to planetsanz-1 do begin
   with planets1^[i] do
   if (((mode<>1)and(mode<>5)and(mode<>6))or(racetyp=rasse))
   and(((mode<>2)and(mode<>7)and(mode<>8))or(racetyp<>rasse))
   and(((mode<>4)and(mode<>6)and(mode<>8))
       or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
   then begin
    with plancache do begin
     id:=id_nr;
     x:=posx;
     y:=posy;
     z:=posz;
     a:=0;
     b:=i;
    end;
    firstplan:=id_nr;
    exit;
   end;
  end;
 end;
end;

function Nextplan(id:lint;rasse,x,y,z,mode:integer):lint;
var
 fid:lint;
 i:word;
 planet:tp_planet;
begin
 fid:=-1;
 if (mode=3)or(mode=5)or(mode=7) then begin
  nextplan:=id;
 end else begin
  if id=plancache.id then begin
   if planetsanz>500 then begin
    if plancache.a=0 then begin
     for i:=plancache.b to 499 do begin
      with planets1^[i] do
      if (((mode<>1)and(mode<>5)and(mode<>6))or(racetyp=rasse))
      and(((mode<>2)and(mode<>7)and(mode<>8))or(racetyp<>rasse))
      and(((mode<>4)and(mode<>6)and(mode<>8))
	  or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
      then begin
       if fid=-1 then fid:=id_nr;
       if id_nr>id then begin
	nextplan:=id_nr;
	with plancache do begin
	 id:=id_nr;
	 b:=i;
	 x:=posx;
	 y:=posy;
	 z:=posz;
	end;
	exit;
       end;
      end;
     end;
     with plancache do begin
      if planetsanz>500 then a:=1;
      b:=500;
     end;
    end;
    if plancache.a=1 then begin
     for i:=plancache.b to planetsanz-1 do begin
      with planets2^[i] do
      if (((mode<>1)and(mode<>5)and(mode<>6))or(racetyp=rasse))
      and(((mode<>2)and(mode<>7)and(mode<>8))or(racetyp<>rasse))
      and(((mode<>4)and(mode<>6)and(mode<>8))
	  or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
      then begin
       if fid=-1 then fid:=id_nr;
       if id_nr>id then begin
	nextplan:=id_nr;
	with plancache do begin
	 id:=id_nr;
	 b:=i;
	 x:=posx;
	 y:=posy;
	 z:=posz;
	end;
	exit;
       end;
      end;
     end;
     with plancache do begin
      a:=0;
      b:=0;
     end;
    end;
   end else for i:=0 to planetsanz-1 do begin
    with planets1^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(racetyp=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(racetyp<>rasse))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
    then begin
     if fid=-1 then fid:=id_nr;
     if id_nr>id then begin
      nextplan:=id_nr;
      with plancache do begin
       id:=id_nr;
       b:=i;
       x:=posx;
       y:=posy;
       z:=posz;
      end;
      exit;
     end;
    end;
   end;
  end;
  if planetsanz>500 then begin
   for i:=0 to 499 do begin
    with planets1^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(racetyp=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(racetyp<>rasse))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
    then begin
     if fid=-1 then fid:=id_nr;
     if id_nr>id then begin
      nextplan:=id_nr;
      with plancache do begin
       id:=id_nr;
       a:=0;
       b:=i;
       x:=posx;
       y:=posy;
       z:=posz;
      end;
      exit;
     end;
    end;
   end;
   for i:=500 to planetsanz-1 do begin
    with planets2^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(racetyp=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(racetyp<>rasse))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
    then begin
     if fid=-1 then fid:=id_nr;
     if id_nr>id then begin
      nextplan:=id_nr;
      with plancache do begin
       id:=id_nr;
       a:=1;
       b:=i;
       x:=posx;
       y:=posy;
       z:=posz;
      end;
      exit;
     end;
    end;
   end;
  end else for i:=0 to planetsanz-1 do begin
   with planets1^[i] do
   if (((mode<>1)and(mode<>5)and(mode<>6))or(racetyp=rasse))
   and(((mode<>2)and(mode<>7)and(mode<>8))or(racetyp<>rasse))
   and(((mode<>4)and(mode<>6)and(mode<>8))
       or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
   then begin
    if fid=-1 then fid:=id_nr;
    if id_nr>id then begin
     nextplan:=id_nr;
     with plancache do begin
      id:=id_nr;
      a:=0;
      b:=i;
      x:=posx;
      y:=posy;
      z:=posz;
     end;
     exit;
    end;
   end;
  end;
 end;
 nextplan:=fid;
end;

function Lastplan(id:lint;rasse,x,y,z,mode:integer):lint;
var
 tid:lint;
 i:word;
 planet:tp_planet;
begin
 tid:=-1;
 if (mode=3)or(mode=5)or(mode=7) then begin
  lastplan:=id;
 end else begin
  if planetsanz>500 then begin
   for i:=0 to 499 do begin
    with planets1^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(racetyp=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(racetyp<>rasse))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
    then begin
     if (id_nr=id)and(tid<>-1) then begin
      lastplan:=tid;
      exit;
     end;
     tid:=id_nr;
    end;
   end;
   for i:=500 to planetsanz-1 do begin
    with planets2^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(racetyp=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(racetyp<>rasse))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
    then begin
     if (id_nr=id)and(tid<>-1) then begin
      lastplan:=tid;
      exit;
     end;
     tid:=id_nr;
    end;
   end;
  end else for i:=0 to planetsanz-1 do begin
   with planets1^[i] do
   if (((mode<>1)and(mode<>5)and(mode<>6))or(racetyp=rasse))
   and(((mode<>2)and(mode<>7)and(mode<>8))or(racetyp<>rasse))
   and(((mode<>4)and(mode<>6)and(mode<>8))
       or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
   then begin
    if (id_nr=id)and(tid<>-1) then begin
     lastplan:=tid;
     exit;
    end;
    tid:=id_nr;
   end;
  end;
 end;
 lastplan:=tid;
end;

function Firstbase(rasse,x,y,z,mode:integer):lint;
var
 id:lint;
 i:word;
 base:tp_starbase;
begin
 firstbase:=-1;
 if mode=0 then begin
  if basesanz>0
  then firstbase:=bases1^[0].id_nr
  else firstbase:=-1;
 end else if (mode=3)or(mode=5)or(mode=7) then begin
  id:=baseid(x,y,z);
  base:=getbase(id);
  if(id=-1)or(mode=5)and(base^.owner<>rasse)
  or(mode=7)and(base^.owner=rasse)
  then firstbase:=-1 else firstbase:=id;
 end else begin

  for i:=0 to min(299,basesanz-1) do begin
   with bases1^[i] do
   if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
   and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
   and(((mode<>4)and(mode<>6)and(mode<>8))
       or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
   then begin
    firstbase:=id_nr;
    exit;
   end;
  end;
  if basesanz>=300 then begin
   for i:=300 to min(599,basesanz-1) do begin
    with bases2^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
    then begin
     firstbase:=id_nr;
     exit;
    end;
   end;
  end;
  if basesanz>=600 then begin
   for i:=600 to min(899,basesanz-1) do begin
    with bases2^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
    then begin
     firstbase:=id_nr;
     exit;
    end;
   end;
  end;
  if basesanz>=900 then begin
   for i:=900 to min(1199,basesanz-1) do begin
    with bases2^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
    then begin
     firstbase:=id_nr;
     exit;
    end;
   end;
  end;

 end;
end;

function nextbase(id:lint;rasse,x,y,z,mode:integer):lint;
var
 fid:lint;
 i:word;
 base:tp_starbase;
begin
 fid:=-1;
 if (mode=3)or(mode=5)or(mode=7) then begin
  fid:=baseid(x,y,z);
  base:=getbase(fid);
  if(fid=-1)or(mode=5)and(base^.owner<>rasse)
  or(mode=7)and(base^.owner=rasse)
  then nextbase:=-1 else nextbase:=fid;
 end else begin

  for i:=0 to min(299,basesanz-1) do begin
   with bases1^[i] do
   if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
   and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
   and(((mode<>4)and(mode<>6)and(mode<>8))
       or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
   then begin
    if fid=-1 then fid:=id_nr;
    if id_nr>id then begin
     nextbase:=id_nr;
     exit;
    end;
   end;
  end;
  if basesanz>=300 then begin
   for i:=300 to min(599,basesanz-1) do begin
    with bases2^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
    then begin
     if fid=-1 then fid:=id_nr;
     if id_nr>id then begin
      nextbase:=id_nr;
      exit;
     end;
    end;
   end;
  end;
  if basesanz>=600 then begin
   for i:=600 to min(899,basesanz-1) do begin
    with bases3^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
    then begin
     if fid=-1 then fid:=id_nr;
     if id_nr>id then begin
      nextbase:=id_nr;
      exit;
     end;
    end;
   end;
  end;
  if basesanz>=900 then begin
   for i:=900 to min(1199,basesanz-1) do begin
    with bases4^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
    then begin
     if fid=-1 then fid:=id_nr;
     if id_nr>id then begin
      nextbase:=id_nr;
      exit;
     end;
    end;
   end;
  end;

 end;
 nextbase:=fid;
end;

function lastbase(id:lint;rasse,x,y,z,mode:integer):lint;
var
 tid:lint;
 i:word;
 base:tp_starbase;
begin
 tid:=-1;
 if (mode=3)or(mode=5)or(mode=7) then begin
  tid:=baseid(x,y,z);
  base:=getbase(tid);
  if(tid=-1)or(mode=5)and(base^.owner<>rasse)
  or(mode=7)and(base^.owner=rasse)
  then lastbase:=-1 else lastbase:=tid;
 end else begin

  for i:=0 to min(599,basesanz-1) do begin
   with bases1^[i] do
   if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
   and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
   and(((mode<>4)and(mode<>6)and(mode<>8))
       or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
   then begin
    if (id_nr=id)and(tid<>-1) then begin
     lastbase:=tid;
     exit;
    end;
    tid:=id_nr;
   end;
  end;
  if basesanz>=300 then begin
   for i:=300 to min(599,basesanz-1) do begin
    with bases2^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
    then begin
     if (id_nr=id)and(tid<>-1) then begin
      lastbase:=tid;
      exit;
     end;
     tid:=id_nr;
    end;
   end;
  end;
  if basesanz>=600 then begin
   for i:=600 to min(899,basesanz-1) do begin
    with bases3^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
    then begin
     if (id_nr=id)and(tid<>-1) then begin
      lastbase:=tid;
      exit;
     end;
     tid:=id_nr;
    end;
   end;
  end;
  if basesanz>=900 then begin
   for i:=900 to min(1199,basesanz-1) do begin
    with bases4^[i] do
    if (((mode<>1)and(mode<>5)and(mode<>6))or(owner=rasse))
    and(((mode<>2)and(mode<>7)and(mode<>8))or(owner<>rasse))
    and(((mode<>4)and(mode<>6)and(mode<>8))
	or((abs(integer(x-posx))<101)and(abs(integer(y-posy))<101)and(abs(integer(z-posz))<101)))
    then begin
     if (id_nr=id)and(tid<>-1) then begin
      lastbase:=tid;
      exit;
     end;
     tid:=id_nr;
    end;
   end;
  end;

 end;
 lastbase:=tid;
end;

function GetShip(id:lint):tp_schiff;
var
 i:lint;
 m,x,d:word;

 function ship(n:word):tp_schiff;
 begin
  if n>=1500 then begin
   if n>=2500 then begin
    if n>=3000 then ship:=@ships7^[n] else ship:=@ships6^[n];
   end else begin
    if n>=2000 then ship:=@ships5^[n] else ship:=@ships4^[n];
   end;
  end else begin
   if n>=1000 then begin
    ship:=@ships3^[n];
   end else begin
    if n>=500 then ship:=@ships2^[n] else ship:=@ships1^[n];
   end;
  end;
 end;

begin
 GetShip:=nil;
 if shipsanz>0 then begin
  m:=0;
  x:=shipsanz-1;
  if id>ship(x)^.id_nr then exit;
  if id<ship(m)^.id_nr then exit;
  repeat
   d:=(x+m) div 2;
   i:=ship(d)^.id_nr;
   if i=id then begin
    getship:=ship(d);
    exit;
   end else if id>i then begin
    m:=d+1;
   end else begin
    x:=d-1;
   end;
  until m>x;
 end;
end;

function shipname(id:lint):string30;
var
 s:tp_schiff;
begin
 s:=getship(id);
 if s=nil then shipname:='kein Schiff'
 else shipname:=s^.schiffname;
end;

function PlanID(x,y,z:lint):lint;
var
 i:word;
begin
 PlanID:=-1;
 if planetsanz>500 then begin
  for i:=0 to 499 do with planets1^[i] do if (x=posx)and(y=posy)and(z=posz)
  then begin
   planID:=id_nr;
   exit;
  end;
  for i:=500 to planetsanz-1 do with planets2^[i] do if (x=posx)and(y=posy)and(z=posz)
  then begin
   planID:=id_nr;
   exit;
  end;
 end else for i:=0 to planetsanz-1 do with planets1^[i] do if (x=posx)and(y=posy)and(z=posz)
 then begin
  planID:=id_nr;
  exit;
 end;
end;

function GetPlan(id:lint):tp_planet;
var
 i,j,k:word;
begin
 GetPlan:=nil;
 j:=planetsanz;
 if planetsanz>500 then begin
  for i:=0 to 499 do with planets1^[i] do if id_nr=id
  then begin
   GetPlan:=@planets1^[i];
   exit;
  end;
  for i:=500 to planetsanz-1 do with planets2^[i] do if id_nr=id
  then begin
   GetPlan:=@planets2^[i];
   exit;
  end;
 end else for i:=0 to planetsanz-1 do with planets1^[i] do if id_nr=id
 then begin
  GetPlan:=@planets1^[i];
  exit;
 end;
end;

function GetBase(id:lint):tp_starbase;
var
 i:word;
begin
 Getbase:=nil;

 for i:=0 to min(299,basesanz-1) do with bases1^[i] do if id=id_nr
 then begin
  getbase:=@bases1^[i];
  exit;
 end;
 if basesanz>=300 then begin
  for i:=300 to min(599,basesanz-1) do with bases2^[i] do if id=id_nr
  then begin
   getbase:=@bases2^[i];
   exit;
  end;
 end;
 if basesanz>=600 then begin
  for i:=300 to min(899,basesanz-1) do with bases3^[i] do if id=id_nr
  then begin
   getbase:=@bases3^[i];
   exit;
  end;
 end;
 if basesanz>=900 then begin
  for i:=900 to min(1199,basesanz-1) do with bases4^[i] do if id=id_nr
  then begin
   getbase:=@bases4^[i];
   exit;
  end;
 end;

end;

function BaseID(x,y,z:lint):lint;
var
 i:word;
begin
 baseID:=-1;

 for i:=0 to min(299,basesanz-1) do with bases1^[i] do if (x=posx)and(y=posy)and(z=posz)
 then begin
  baseID:=id_nr;
  exit;
 end;
 if basesanz>=300 then begin
  for i:=300 to min(599,basesanz-1) do with bases2^[i] do if (x=posx)and(y=posy)and(z=posz)
  then begin
   baseID:=id_nr;
   exit;
  end;
 end;
 if basesanz>=600 then begin
  for i:=600 to min(899,basesanz-1) do with bases3^[i] do if (x=posx)and(y=posy)and(z=posz)
  then begin
   baseID:=id_nr;
   exit;
  end;
 end;
 if basesanz>=900 then begin
  for i:=900 to min(1199,basesanz-1) do with bases4^[i] do if (x=posx)and(y=posy)and(z=posz)
  then begin
   baseID:=id_nr;
   exit;
  end;
 end;
end;

function PlanName(id:lint):string20;
var
 s:tp_planet;
begin
 s:=getplan(id);
 if s=nil then planname:='(Planet?)'
 else planname:=s^.name;
end;

function BaseName(id:lint):string20;
var
 s:tp_starbase;
begin
 s:=getbase(id);
 if s=nil then Basename:='(keine Basis)'
 else Basename:=s^.name;
end;

function canbuildtyp(base:tp_starbase;typ:lint):boolean;
begin
 canbuildtyp:=(typ>-1)and(typ<160)and(base<>nil)
 and(base^.canbuild[typ div 32] and (lint(1) shl (typ and 31))<>0);
end;

function egewicht(id:lint):lint;
begin
 egewicht:=(engines[id].techlvl*5) div 2;
end;

function sgewicht(schiff:tp_schiff):lint;
begin
 with schiff^ do with hulls[typnr]
 do sgewicht:=Masse+enganz*egewicht(engtyp)+beams*BGewicht
 +TorpRohre*tgewicht(torprohretyp)+bays*BayGewicht+Minenleger*MLegerGewicht
 +(crew+colons+99)div 100+neutr+molyb+dura+trit+torps[1]+torps[2]+torps[3]
 +torps[4]+torps[5]+torps[6]+torps[7]+torps[8]+torps[9]+Minen[1]+Minen[2]
 +Minen[3]+Minen[4]+Minen[5]+Minen[6]+Minen[7]+Minen[8]+Minen[9]+fighter
 +supplies;
end;

procedure RaceLoad;
var
 f:file;
 i,j:word;
begin
 filemode:=0;
 assign(f,path+'races.db');
 {$i-}
 reset(f,1);
 if ioresult<>0 then begin
(*  {$ifdef Raceedit}
   gmissionFlags:=gmissionFlags2;
   races:=races2;
  {$else}
*)   setvideomode(3);
   writeln(path+'races.db fehlt!');
   halt(255);
(*  {$endif} *)
 end else begin
  blockread(f,rassen,sizeof(rassen),j);
  blockread(f,GMissionFlags,sizeof(gmissionflags),j);
  blockread(f,missions,sizeof(missions),j);
  blockread(f,engines,sizeof(engines),j);
  blockread(f,beams,sizeof(beams),j);
  blockread(f,mines,sizeof(mines),j);
  blockread(f,torps,sizeof(torps),j);
  blockread(f,torprohre,sizeof(torprohre),j);
  blockread(f,hulls,sizeof(hulls),j);
  blockread(f,genflags,sizeof(genflags),j);
  close(f);
  maxfuse:=1;
  maxbdamage:=1;
  maxtdamage:=1;
  maxmdamage:=1;
  for i:=1 to 9 do begin
   with engines[i]
   do for j:=1 to 9 do if fueluse[j]>maxfuse then maxfuse:=fueluse[j];
   with beams[i] do if kill>maxbdamage then maxbdamage:=kill;
   with beams[i] do if destroy>maxbdamage then maxbdamage:=destroy;
   with torps[i] do if kill>maxtdamage then maxtdamage:=kill;
   with torps[i] do if destroy>maxtdamage then maxtdamage:=destroy;
   with mines[i] do if kill>maxmdamage then maxmdamage:=kill;
   with mines[i] do if destroy>maxmdamage then maxmdamage:=destroy;
  end;
 end;
 {$i+}
end;

procedure RaceSave;
var
 f:file;
begin
 assign(f,path+'races.db');
 inoutres:=0;
 rewrite(f,1);
 blockwrite(f,rassen,sizeof(rassen));
 blockwrite(f,GMissionFlags,sizeof(gmissionflags));
 blockwrite(f,missions,sizeof(missions));
 blockwrite(f,engines,sizeof(engines));
 blockwrite(f,beams,sizeof(beams));
 blockwrite(f,mines,sizeof(mines));
 blockwrite(f,torps,sizeof(torps));
 blockwrite(f,torprohre,sizeof(torprohre));
 blockwrite(f,hulls,sizeof(hulls));
 blockwrite(f,genflags,sizeof(genflags));
 close(f);
end;

procedure initdata;
begin
 path:=paramstr(1);
{$ifndef unix}
 if (path<>'')and(path[byte(path[0])]<>'\')and(path[byte(path[0])]<>':')
 then path:=path+'\';
{$else}
 if (path<>'')and(path[length(path)]<>'/') then path:=path+'/';
{$endif}
 kbsetrate(0,0);
 raceload;
end;
begin
 initdata;
end.