{$ifndef unix}
{$A+,B-,D+,E+,F-,G+,I+,L+,N+,P-,Q-,R-,S+,T-,V-,X+,Y+}
{$M 16384,0}
{$else}
{$B-,I+,S-,T-,X+}
{$endif}
program master;
uses
 data,
 types,
 Grafik,
 kb,
 evgraph,
 utils,
 tstring,
 vbios,
 prandom,
{$ifndef unix}
 crt,
{$else}
 xcrt,
{$endif}
 dos,
 plannam,
 ovrfirst;

type
 t_ship500=array[0..499] of t_schiff;
 tp_ship500=^t_ship500;
 t_planet500=array[0..499] of t_planet;
 tp_planet500=^t_planet500;
 xyzpos=array[0..2] of integer;

var
 newship:tp_ship500;			{ 3500 Schiffe }
 newplanet:array[0..1] of tp_planet500;	{ 1000 Planeten }
 newbase:array[0..31] of t_starbase;	{ 32 Basen }
 racesa:array[0..31] of boolean;
 raceknown:array[0..32] of longint;
 nrraces,
 nrships:word;
 nrplans:word;

 planpos:array[0..999] of xyzpos;

 tagb:array[0..1000] of boolean;
 tagw:array[0..1000] of word;
 tagl:array[0..1031] of longint;

 o:t_bdata;
 i,j,k:word;

 c:char;
 sc,
 redraw:byte;
 syspos:array[0..3] of byte;
 Sysmsg:array[0..3] of t_message;

const
 tetraAnz:array[14..17] of word=(590,710,846,999);
 Rohstoffavg:word=2000;
 firstships:array[0..31,0..1] of byte=
 ((  4,  5),
  (  0, 21),
  (  0, 28),
  ( 39, 40),
  (  0, 47),
  (  0, 54),
  (  0, 62),
  ( 70, 71),
  (  0, 72),
  (  0, 87),
  (  0, 87),
  (  0, 21),
  (  0, 28),
  (  0, 72),
  (  0, 28),
  (  0,  5),
  (  0, 21),
  (  0,  5),
  (  0, 47),
  (  0, 47),
  (  0, 70),
  (  0, 54),
  (  0, 21),
  ( 70, 55),
  ( 55, 55),
  (  0, 21),
  (  0,  4),
  (  0, 21),
  (  0, 87),
  (  0, 70),
  (  0, 88),
  (  0, 72));

procedure halt2;
begin
 textmode(3);
 writeln('***> Benutzerabbruch <***');
 halt;
end;

procedure cleartag;
begin
 fillchar(tagb,sizeof(tagb),0);
end;

procedure settag;
begin
 fillchar(tagb,sizeof(tagb),1);
end;


procedure DrawRect(px,py,pz:word;
		   xx,xy,xz,
		   yx,yy,yz:double;
		   nx,ny:word);
var
 x,y:word;
begin
 for x:=0 to nx-1
 do for y:=0 to ny-1 do begin
  planpos[nrplans,0]:=px+trunc(x*xx+y*yx+0.5);
  planpos[nrplans,1]:=py+trunc(x*xy+y*yy+0.5);
  planpos[nrplans,2]:=pz+trunc(x*xz+y*yz+0.5);
  inc(nrplans);
 end;
end;

procedure CreateUniverseSpatRegular(surface:boolean);
var
 y,
 nx,
 ny,
 nz,
 mx,
 my,
 mz,
 px,
 py,
 pz,
 dx,
 dy,
 dz:word;
 dxy,
 dxz,
 dyx,
 dyz,
 dzx,
 dzy,
 sx,
 sy,
 sz,
 sd:integer;
 anz,
 ax,
 ay,
 az:longint;
begin
 clearscreen(0);
 y:=0;
 nx:=8;
 ny:=8;
 nz:=8;
 redraw:=0;
 repeat
  writeg(o,#0'@'#0#0#0'C'#$f'Dimensionen w„hlen:'#0'C'#$7' (RETURN=Weiter)');
  writeg(o,#13#10#10#0'C'#$c'  X= '#0'C'#$a+w2s(nx,10,false,false));
  if y=0 then writeg(o,#0'C'#$e#13'');
  writeg(o,#13#10#10#0'C'#$e'  Y= '#0'C'#$8a+w2s(ny,10,false,false));
  if y=1 then writeg(o,#0'C'#$e#13'');
  writeg(o,#13#10#10#0'C'#$a'  Z= '#0'C'#$a+w2s(nz,10,false,false));
  if y=2 then writeg(o,#0'C'#$e#13'');
  if surface and (nx<>1)and(ny<>1)and(nz<>1)
  then anz:=2*(nx*ny+nx*nz+ny*nz)-4*(nx+ny+nz)+8
  else anz:=longint(nx)*ny*nz;
  writeg(o,#13#10#10#0'C'#$7'Anz= '+l2s(anz,10,true,false,false));

  if anz>1000 then writeg(o,#13#10#10#10#0'C'#$4e'zu groá ')
  else if anz<500 then writeg(o,#13#10#10#10#0'C'#$8e'zu klein')
  else writeg(o,#13#10#10#10#0'C'#$2f' OK!    ');

  repeat
   c:=kbreadkey;
   if c=#0 then sc:=byte(kbreadkey) else sc:=kbscancode;
   redraw:=1;
   case c of
    'X':y:=0;
    'Y':y:=1;
    'Z':y:=2;
    '+':case y of
     0:if nx<1000 then inc(nx);
     1:if ny<1000 then inc(ny);
     2:if nz<1000 then inc(nz);
    end;
    '-':case y of
     0:if nx>1 then dec(nx);
     1:if ny>1 then dec(ny);
     2:if nz>1 then dec(nz);
    end;
    #27:halt2;
    #13:redraw:=2;
    #0:case sc of
     $48:if y=0 then y:=2 else dec(y);
     $50:if y=2 then y:=0 else inc(y);
     $4b:case y of
      0:if nx>1 then dec(nx);
      1:if ny>1 then dec(ny);
      2:if nz>1 then dec(nz);
     end;
     $4d:case y of
      0:if nx<1000 then inc(nx);
      1:if ny<1000 then inc(ny);
      2:if nz<1000 then inc(nz);
     end;
    else
     redraw:=0;
    end;
   else
    redraw:=0;
   end;
  until redraw>0;
 until redraw>1;

 y:=0;
 sd:=0;
 sx:=0;
 sy:=0;
 sz:=0;

 clearscreen(0);
 repeat
  writeg(o,#0'@'#0#0#0'C'#$f'Spatverzerrung:'#0'C'#7' (RETURN=Weiter)'#0'C'#$b#13#10#10);
  if y=0 then writeg(o,#0'C'#$e0);
  writeg(o,char(byte('X')+sd)+#0'C'#$f'='+char(byte('X')+sd));
  writeg(o,        #13#10' +X/100*'#0'C'#$a);
  if y=1 then writeg(o,#0'C'#$e0);
  writeg(o,l2s(sx,5,true,false,false));
  if sd=0 then writeg(o,#0'C'#$c' <- wird ignoriert')
  else writeg(o,#0'C'#0'                  ');
  writeg(o,#0'C'#$f#13#10' +Y/100*'#0'C'#$a);
  if y=2 then writeg(o,#0'C'#$e0);
  writeg(o,l2s(sy,5,true,false,false));
  if sd=1 then writeg(o,#0'C'#$c' <- wird ignoriert')
  else writeg(o,#0'C'#0'                  ');
  writeg(o,#0'C'#$f#13#10' +Z/100*'#0'C'#$a);
  if y=3 then writeg(o,#0'C'#$e0);
  writeg(o,l2s(sz,5,true,false,false)+#0'C'#$f);
  if sd=2 then writeg(o,#0'C'#$c' <- wird ignoriert')
  else writeg(o,#0'C'#0'                  ');

  repeat
   c:=kbreadkey;
   if c=#0 then sc:=byte(kbreadkey) else sc:=kbscancode;
   redraw:=1;
   case c of
    '+':case y of
     0:if sd=2 then sd:=0 else inc(sd);
     1:if sx<100 then inc(sx);
     2:if sy<100 then inc(sy);
     3:if sz<100 then inc(sz);
    end;
    '-':case y of
     0:if sd=0 then sd:=2 else dec(sd);
     1:if sx>-100 then dec(sx);
     2:if sy>-100 then dec(sy);
     3:if sz>-100 then dec(sz);
    end;
    #27:halt2;
    #13:redraw:=2;
    #0:case sc of
     $4d:case y of
      0:if sd=2 then sd:=0 else inc(sd);
      1:if sx<100 then inc(sx);
      2:if sy<100 then inc(sy);
      3:if sz<100 then inc(sz);
     end;
     $4b:case y of
      0:if sd=0 then sd:=2 else dec(sd);
      1:if sx>-100 then dec(sx);
      2:if sy>-100 then dec(sy);
      3:if sz>-100 then dec(sz);
     end;
     $48:if y=0 then y:=3 else dec(y);
     $50:if y=3 then y:=0 else inc(y);
    else
     redraw:=0;
    end;
   else
    redraw:=0;
   end;
  until redraw>0;
 until redraw>1;

 case sd of
  0:begin
   dxy:=sy;
   dxz:=sz;
   dyx:=0;
   dyz:=0;
   dzx:=0;
   dzy:=0;
  end;
  1:begin
   dxy:=0;
   dxz:=0;
   dyx:=sx;
   dyz:=sz;
   dzx:=0;
   dzy:=0;
  end;
  2:begin
   dxy:=0;
   dxz:=0;
   dyx:=0;
   dyz:=0;
   dzx:=sx;
   dzy:=sy;
  end;
 end;

 mx:=19998 div nx;
 my:=19998 div ny;
 mz:=19998 div nz;
 if mx>200 then mx:=200;
 if my>200 then my:=200;
 if mz>200 then mz:=200;
 if mx<80 then  dx:=mx else dx:=80;
 if my<80 then dy:=my else dy:=80;
 if mz<80 then dz:=mz else dz:=80;

 y:=1;
 clearscreen(0);
 repeat
  ax:= longint(nx-1)*dx+1+
      (longint(ny-1)*dy+1)*abs(dxy) div 100+
      (longint(nz-1)*dz+1)*abs(dxz) div 100;
  ay:= longint(ny-1)*dy+1+
      (longint(nx-1)*dx+1)*abs(dyx) div 100+
      (longint(nz-1)*dz+1)*abs(dyz) div 100;
  az:= longint(nz-1)*dz+1+
      (longint(nx-1)*dx+1)*abs(dzx) div 100+
      (longint(ny-1)*dy+1)*abs(dzy) div 100;
  writeg(o,#0'@'#0#0#0'C'#$f'Distanz zwischen den Sternen:'#0'C'#7' (RETURN=Weiter)'#0'C'#$f#13#10#10+
	 'Distanz X:'#0'C'#$a);
  if y=1 then writeg(o,#0'C'#$e0);
  writeg(o,w2s(dx,5,false,false)+#0'C'#$f'  Ausdehnung X:'
	 +l2s(ax,6,false,false,false)+
	 #13#10'Distanz Y:'#0'C'#$a);
  if y=2 then writeg(o,#0'C'#$e0);
  writeg(o,w2s(dy,5,false,false)+#0'C'#$f'  Ausdehnung Y:'
	 +l2s(ay,6,false,false,false)+
	 #13#10'Distanz Z:'#0'C'#$a);
  if y=3 then writeg(o,#0'C'#$e0);
  writeg(o,w2s(dz,5,false,false)+#0'C'#$f'  Ausdehnung Z:'
	 +l2s(az,6,false,false,false));
  writeg(o,#13#10#10'Dichte: 0,'+
	 l2s(trunc(anz/ax/ay/az*1000000000000.0+0.5),12,false,true,false)+
	 ' Sterne pro Kubiklichtjahr');

  if (ax>19998)or(ay>19998)or(az>19998)
  then writeg(o,#13#10#10#10#0'C'#$4e'zu groá ')
  else writeg(o,#13#10#10#10#0'C'#$2f' OK!    ');

  repeat
   c:=kbreadkey;
   if c=#0 then sc:=byte(kbreadkey) else sc:=kbscancode;
   redraw:=1;
   case c of
    '+':case y of
     1:if dx<mx then inc(dx);
     2:if dy<my then inc(dy);
     3:if dz<mz then inc(dz);
    end;
    '-':case y of
     1:if dx>20 then dec(dx);
     2:if dy>20 then dec(dy);
     3:if dz>20 then dec(dz);
    end;
    #27:halt2;
    #13:redraw:=2;
    #0:case sc of
     $4d:case y of
      1:if dx<mx then inc(dx);
      2:if dy<my then inc(dy);
      3:if dz<mz then inc(dz);
     end;
     $4b:case y of
      1:if dx>20 then dec(dx);
      2:if dy>20 then dec(dy);
      3:if dz>20 then dec(dz);
     end;
     $48:if y=1 then y:=3 else dec(y);
     $50:if y=3 then y:=1 else inc(y);
    else
     redraw:=0;
    end;
   else
    redraw:=0;
   end;
  until redraw>0;
 until (redraw>1)and(ax<=19998)and(ay<=19998)and(az<=19998);

 nrplans:=0;

 px:=-ax div 2;
 py:=-ay div 2;
 pz:=-az div 2;

 for i:=0 to nx-1
 do drawrect(px+i*dx,
	     py+(i*dyx*dx) div 100,
	     pz+(i*dzx*dx) div 100,

	     (i*dxy*dy) div 100,
	     dy,
	     (i*dzy*dy) div 100,

	     (i*dxz*dz) div 100,
	     (i*dyz*dz) div 100,
	     dz,

	     ny,nz);

 if surface
 then setstring(sysmsg[1,1],#0'C'#$e'Oberfl„che eines Spats mit Ausdehnung: '
		+strg(ax)+'*'+strg(ay)+'*'+strg(az)+' ljü')
 else setstring(sysmsg[1,1],#0'C'#$e'Spat mit Ausdehnung: '
		+strg(ax)+'*'+strg(ay)+'*'+strg(az)+' ljü');
 setstring(sysmsg[1,2],#0'C'#$e'X: '+strg(nx)+' Planeten im Abstand von '
		+strg(dx)+' lj');
 setstring(sysmsg[1,3],#0'C'#$e'Y: '+strg(ny)+' Planeten im Abstand von '
		+strg(dy)+' lj');
 setstring(sysmsg[1,4],#0'C'#$e'Z: '+strg(nz)+' Planeten im Abstand von '
		+strg(dz)+' lj');
 case sd of
  0:setstring(sysmsg[1,5],#0'C'#$e'Verzerrungsformel: '
	+'X=X+Y*('+strg(dxy)+'Y/100)+Z*('+strg(dxz)+'Z/100)');
  1:setstring(sysmsg[1,5],#0'C'#$e'Verzerrungsformel: '
	+'Y=Y+X*('+strg(dyx)+'X/100)+Z*('+strg(dyz)+'Z/100)');
  2:setstring(sysmsg[1,5],#0'C'#$e'Verzerrungsformel: '
	+'Z=Z+X*('+strg(dzx)+'X/100)+Y*('+strg(dzy)+'Y/100)');
 end;
 syspos[1]:=7;
end;

procedure CreateUniverseWurfelRandom;
var
 _Size,
 l,
 m,
 p:word;
 r:boolean;
begin
 clearscreen(0);
 repeat
  nrplans:=eingabenr(1,1,1000,500,'Anzahl Sterne (mind. 500):');
  if escpressed then halt2;
 until nrplans>=500;
 clearscreen(0);
 repeat
  _size:=eingabenr(1,1,19998,750,'Ausdehnung (mind. 300):');
  if escpressed then halt2;
 until _size>=300;

 inc(_size);
 p:=-_size div 2;
 writeg(o,#0'C'#$7'Erzeuge Planetensystem');
 k:=100;
 for i:=0 to 1000 do for j:=0 to 2 do planpos[i,j]:=p+prandom(_size);
 repeat
  fillchar(tagw,sizeof(tagw),0);
  l:=0;
  r:=true;
  for i:=0 to nrplans-2 do for j:=i+1 to nrplans-1
  do if tagw[j]=0
  then if dist(planpos[i,0],planpos[i,1],planpos[i,1],
	     planpos[j,0],planpos[j,1],planpos[j,1])<k div 4
  then begin
   tagw[i]:=1;
   tagw[j]:=2;
   inc(l);
   break;
   r:=false;
   for m:=0 to 2 do planpos[i,m]:=p+prandom(_size);
  end;
  if not r then begin
   writeg(o,w2s(l,4,false,false)+#8#8#8#8);
  end;
  if k>20 then dec(k);
 until r;

 setstring(sysmsg[1,1],#0'C'#$e'W�rfel mit Ausdehnung: '+strg(_size-1)+' ljü');
 setstring(sysmsg[1,2],#0'C'#$e'zuf„llige Verteilung von '+strg(nrplans)+' Planeten');
 syspos[1]:=4;
end;

procedure CreateUniverseWurfelRandomA;
var
 _Size,
 p:word;
 r:boolean;

 function randompm(a:word):word;
 var
  x:double;
 begin
  x:=(prandom(65535)/65535+prandom(65535)/65535000)*2-1;
  randompm:=trunc((x*x*(0.25+0.75*x)+0.5)*a+0.5)
 end;

begin
 clearscreen(0);
 repeat
  nrplans:=eingabenr(1,1,1000,500,'Anzahl Sterne (mind. 500):');
  if escpressed then halt2;
 until nrplans>=500;
 clearscreen(0);
 repeat
  _size:=eingabenr(1,1,19998,1000,'Ausdehnung (mind. 400):');
  if escpressed then halt2;
 until _size>=400;
 inc(_size);
 p:=-_size div 2;
 writeg(o,#0'C'#$7'Erzeuge Planetensystem');
 repeat
  for i:=0 to 1000 do for j:=0 to 2 do planpos[i,j]:=p+randompm(_size);
  fillchar(tagw,sizeof(tagw),0);
  p:=0;
  for i:=0 to nrplans-2 do for j:=i+1 to nrplans-1
  do if dist(planpos[i,0],planpos[i,1],planpos[i,1],
	     planpos[j,0],planpos[j,1],planpos[j,1])<20
  then begin
   inc(tagw[i]);
   inc(tagw[j]);
   inc(p);
  end;
  r:=true;
  for i:=0 to nrplans-1 do if tagw[i]>j then begin
   r:=false;
   j:=i;
  end;
  if not r then begin
   for i:=0 to 2 do planpos[j,i]:=p+randompm(_size);
   writeg(o,w2s(p,4,false,false)+#8#8#8#8);
  end;
 until r;
 setstring(sysmsg[1,1],#0'C'#$e'W�rfel mit Ausdehnung: '+strg(_size-1)+' ljü');
 setstring(sysmsg[1,2],#0'C'#$e'zuf„llige Verteilung von '+strg(nrplans)+' Planeten mit Auáenkonzentration');
 syspos[1]:=4;
end;

procedure CreateUniverseQuaderRegular(surface:boolean);
var
 y,
 nx,
 ny,
 nz,
 mx,
 my,
 mz,
 px,
 py,
 pz,
 dx,
 dy,
 dz:word;
 anz:longint;
begin
 clearscreen(0);
 y:=0;
 nx:=8;
 ny:=8;
 nz:=8;
 redraw:=0;
 repeat
  writeg(o,#0'@'#0#0#0'C'#$f'Dimensionen w„hlen:'#0'C'#$7' (RETURN=Weiter)');
  writeg(o,#13#10#10#0'C'#$c'  X= '#0'C'#$a+w2s(nx,10,false,false));
  if y=0 then writeg(o,#0'C'#$e#13'');
  writeg(o,#13#10#10#0'C'#$e'  Y= '#0'C'#$8a+w2s(ny,10,false,false));
  if y=1 then writeg(o,#0'C'#$e#13'');
  writeg(o,#13#10#10#0'C'#$a'  Z= '#0'C'#$a+w2s(nz,10,false,false));
  if y=2 then writeg(o,#0'C'#$e#13'');
  if surface and(nx<>1)and(ny<>1)and(nz<>1)
  then anz:=2*(nx*ny+nx*nz+ny*nz)-4*(nx+ny+nz)+8
  else anz:=longint(nx)*ny*nz;
  writeg(o,#13#10#10#0'C'#$7'Anz= '+l2s(anz,10,true,false,false));

  if anz>1000 then writeg(o,#13#10#10#10#0'C'#$4e'zu groá ')
  else if anz<500 then writeg(o,#13#10#10#10#0'C'#$8e'zu klein')
  else writeg(o,#13#10#10#10#0'C'#$2f' OK!    ');

  repeat
   c:=kbreadkey;
   if c=#0 then sc:=byte(kbreadkey) else sc:=kbscancode;
   redraw:=1;
   case c of
    'X':y:=0;
    'Y':y:=1;
    'Z':y:=2;
    '+':case y of
     0:if nx<1000 then inc(nx);
     1:if ny<1000 then inc(ny);
     2:if nz<1000 then inc(nz);
    end;
    '-':case y of
     0:if nx>1 then dec(nx);
     1:if ny>1 then dec(ny);
     2:if nz>1 then dec(nz);
    end;
    #27:halt2;
    #13:redraw:=2;
    #0:case sc of
     $48:if y=0 then y:=2 else dec(y);
     $50:if y=2 then y:=0 else inc(y);
     $4b:case y of
      0:if nx>1 then dec(nx);
      1:if ny>1 then dec(ny);
      2:if nz>1 then dec(nz);
     end;
     $4d:case y of
      0:if nx<1000 then inc(nx);
      1:if ny<1000 then inc(ny);
      2:if nz<1000 then inc(nz);
     end;
    else
     redraw:=0;
    end;
   else
    redraw:=0;
   end;
  until redraw>0;
 until redraw>1;

 mx:=19998 div nx;
 my:=19998 div ny;
 mz:=19998 div nz;
 if mx>200 then mx:=200;
 if my>200 then my:=200;
 if mz>200 then mz:=200;
 if mx<80 then dx:=mx else dx:=80;
 if my<80 then dy:=my else dy:=80;
 if mz<80 then dz:=mz else dz:=80;

 y:=1;
 clearscreen(0);
 repeat
  writeg(o,#0'@'#0#0#0'C'#$f'Distanz zwischen den Sternen:'#0'C'#7' (RETURN=Weiter)'#0'C'#$f#13#10#10+
	 'Distanz X:'#0'C'#$a);
  if y=1 then writeg(o,#0'C'#$e0);
  writeg(o,w2s(dx,5,false,false)+#0'C'#$f'  Ausdehnung X:'
	 +w2s(dx*(nx-1)+1,6,false,false)+
	 #13#10'Distanz Y:'#0'C'#$a);
  if y=2 then writeg(o,#0'C'#$e0);
  writeg(o,w2s(dy,5,false,false)+#0'C'#$f'  Ausdehnung Y:'
	 +w2s(dy*(ny-1)+1,6,false,false)+
	 #13#10'Distanz Z:'#0'C'#$a);
  if y=3 then writeg(o,#0'C'#$e0);
  writeg(o,w2s(dz,5,false,false)+#0'C'#$f'  Ausdehnung Z:'
	 +w2s(dz*(nz-1)+1,6,false,false));
  writeg(o,#13#10#10'Dichte: 0,'+
	 l2s(trunc(anz/(dx*(nx-1)+1)/(dy*(ny-1)+1)/(dz*(nz-1)+1)*1000000000000.0+0.5),12,false,true,false)+
	 ' Sterne pro Kubiklichtjahr');
  repeat
   c:=kbreadkey;
   if c=#0 then sc:=byte(kbreadkey) else sc:=kbscancode;
   redraw:=1;
   case c of
    '+':case y of
     1:if dx<mx then inc(dx);
     2:if dy<my then inc(dy);
     3:if dz<mz then inc(dz);
    end;
    '-':case y of
     1:if dx>20 then dec(dx);
     2:if dy>20 then dec(dy);
     3:if dz>20 then dec(dz);
    end;
    #27:halt2;
    #13:redraw:=2;
    #0:case sc of
     $4d:case y of
      1:if dx<mx then inc(dx);
      2:if dy<my then inc(dy);
      3:if dz<mz then inc(dz);
     end;
     $4b:case y of
      1:if dx>20 then dec(dx);
      2:if dy>20 then dec(dy);
      3:if dz>20 then dec(dz);
     end;
     $48:if y=1 then y:=3 else dec(y);
     $50:if y=3 then y:=1 else inc(y);
    else
     redraw:=0;
    end;
   else
    redraw:=0;
   end;
  until redraw>0;
 until redraw>1;

 nrplans:=0;

 px:=-(nx*dx) div 2;
 py:=-(ny*dy) div 2;
 pz:=-(nz*dz) div 2;

 if surface and(nx<>1)and(ny<>1)and(nz<>1) then begin
  drawrect(px,py,pz,       0,dy,0, 0,0,dz, ny,nz);
  drawrect(-px,py,pz,      0,dy,0, 0,0,dz, ny,nz);

  drawrect(px+dx,py,pz,    dx,0,0, 0,0,dz, nx-2,nz);
  drawrect(px+dx,-py,pz,   dx,0,0, 0,0,dz, nx-2,nz);

  drawrect(px+dx,py+dy,pz, dx,0,0, 0,dy,0, nx-2,ny-2);
  drawrect(px+dx,py+dy,pz, dx,0,0, 0,dy,0, nx-2,ny-2);
 end else begin
  for i:=0 to nx-1 do drawrect(px+i*dx,py,pz,0,dy,0,0,0,dz,ny,nz);
 end;

 if surface
 then setstring(sysmsg[1,1],#0'C'#$e'Oberfl„che eines Quaders mit Ausdehnung: '
		+strg(dx*(nx-1)+1)+'*'+strg(dy*(ny-1)+1)+'*'+strg(dz*(nz-1)+1)+' ljü')
 else setstring(sysmsg[1,1],#0'C'#$e'Quader mit Ausdehnung: '
		+strg(dx*(nx-1)+1)+'*'+strg(dy*(ny-1)+1)+'*'+strg(dz*(nz-1)+1)+' ljü');
 setstring(sysmsg[1,2],#0'C'#$e'X: '+strg(nx)+' Planeten im Abstand von '
		+strg(dx)+' lj');
 setstring(sysmsg[1,3],#0'C'#$e'Y: '+strg(ny)+' Planeten im Abstand von '
		+strg(dy)+' lj');
 setstring(sysmsg[1,4],#0'C'#$e'Z: '+strg(nz)+' Planeten im Abstand von '
		+strg(dz)+' lj');
 syspos[1]:=6;
end;

procedure createuniversewurfelRegular(surface:boolean);
var
 n,
 d,
 p,
 anz:word;
begin
 clearscreen(0);
 if surface then n:=11 else n:=8;
 redraw:=0;
 repeat
  writeg(o,#0'@'#0#0#0'C'#$f'Dimensionen w„hlen:'#0'C'#$7' (RETURN=Weiter)');
  writeg(o,#13#10#10#0'C'#$c'  X= '#0'C'#$a+w2s(n,10,false,false));
  writeg(o,#13#10#10#0'C'#$e'  Y= '#0'C'#$8a+w2s(n,10,false,false));
  writeg(o,#13#10#10#0'C'#$a'  Z= '#0'C'#$a+w2s(n,10,false,false));
  if surface
  then writeg(o,#13#10#10#0'C'#$7'Anz= '+l2s(longint(n)*n*6-12*n+8,10,true,false,false))
  else writeg(o,#13#10#10#0'C'#$7'Anz= '+l2s(longint(n)*n*n,10,true,false,false));

  writeg(o,#13#10#10#10#0'C'#$2f' OK!    ');

  repeat
   c:=kbreadkey;
   if c=#0 then sc:=byte(kbreadkey) else sc:=kbscancode;
   redraw:=1;
   case c of
    '8':n:=8;
    '9':n:=9;
    '0','1':n:=10;
    '-':if n>8 then dec(n);
    '+':if n<10 then inc(n);
    #27:halt2;
    #13:redraw:=2;
    #0:if surface then begin
     case sc of
      $4b:if n>11 then dec(n);
      $4d:if n<13 then inc(n);
     else
      redraw:=0;
     end
    end else begin
     case sc of
      $4b:if n>8 then dec(n);
      $4d:if n<10 then inc(n);
     else
      redraw:=0;
     end;
    end;
   else
    redraw:=0;
   end;
  until redraw>0;
 until redraw>1;

 if surface then anz:=n*n*6-12*n+8 else anz:=n*n*n;

 d:=80;
 clearscreen(0);
 repeat
  writeg(o,#0'@'#0#0#0'C'#$f'Distanz zwischen den Sternen:'#0'C'#7' (RETURN=Weiter)'#0'C'#$f#13#10#10+
	 'Distanz:'#0'C'#$a+w2s(d,5,false,false)+#0'C'#$f'  Ausdehnung:'
	 +w2s(d*(n-1)+1,6,false,false));
  writeg(o,#13#10#10'Dichte: 0,'+
	 l2s(trunc(anz/(d*(n-1)+1)/(d*(n-1)+1)/(d*(n-1)+1)*1000000000000.0+0.5),12,false,true,false)+
	 ' Sterne pro Kubiklichtjahr');
  repeat
   c:=kbreadkey;
   if c=#0 then sc:=byte(kbreadkey) else sc:=kbscancode;
   redraw:=1;
   case c of
    '+':if d<200 then inc(d);
    '-':if d>20 then dec(d);
    #27:halt2;
    #13:redraw:=2;
    #0:case sc of
     $4b:if d>20 then dec(d);
     $4d:if d<200 then inc(d);
    else
     redraw:=0;
    end;
   else
    redraw:=0;
   end;
  until redraw>0;
 until redraw>1;

 nrplans:=0;

 p:=-(n*d) div 2;
 if surface then begin
  drawrect( p,p,p, 0,d,0, 0,0,d, n,n);
  drawrect(-p,p,p, 0,d,0, 0,0,d, n,n);
  drawrect(p+d,p,p, d,0,0, 0,0,d, n-2,n);
  drawrect(p+d,-p,p, d,0,0, 0,0,d, n-2,n);
  drawrect(p+d,p+d,p, d,0,0, 0,d,0, n-2,n-2);
  drawrect(p+d,p+d,-p, d,0,0, 0,d,0, n-2,n-2);
 end else begin
  for i:=0 to n-1 do drawrect(p+i*d,p,p, 0,d,0, 0,0,d, n,n);
 end;

 if surface
 then setstring(sysmsg[1,1],#0'C'#$e'Oberfl„che eines W�rfels mit Ausdehnung: '
		+strg(d*(n-1)+1)+'ü ljü')
 else setstring(sysmsg[1,1],#0'C'#$e'W�rfel mit Ausdehnung: '
		+strg(d*(n-1)+1)+'*'+strg(d*(n-1)+1)+'*'+strg(d*(n-1)+1)
		+' ljü');
 setstring(sysmsg[1,2],#0'C'#$e'X,Y,Z: '+strg(nrplans)+' Planeten im Abstand von '
		+strg(d)+' lj');
 syspos[1]:=4;
end;

{{CR}
procedure CreateUniverse;
var
 x,
 y,
 x1,
 y1:byte;

const
 TypPoss:array[1..3,1..6] of byte=
  ((  7,  7,  7,  6,  7,128),
   (  5,  5,  5,  4,  5,128),
   ( 15, 15, 15, 14, 15,  1));
 TypName:array[1..3,0..6] of string15=
  (('   3D'     ,'W�rfel','Quader','Spat','Ball','Tetraeder',''),
   ('Oberfl„che','W�rfel','Quader','Spat','Ball','Tetraeder',''),
   ('   2D'     ,'Quadrat','Rechteck','Parallelogramm','Kreis','Dreieck','Spirale'));
 OptionName:array[0..5] of string20=
  ('Symetrisch','Au'#225'enkonzentraion','Gruppen','Grp. auáerh. Objekt','2D-Grp. auáerh. Obj.','Zuf„llig');

begin
 clearscreen(0);
 x:=1;
 y:=1;
 repeat
  writeg(o,#0'@'#0#0#0'C'#$f' Form des Universums (Return f�r Weiter)'#10);
  for y1:=0 to 6 do begin
   writeg(o,#13#10);
   for x1:=1 to 3 do begin
    writeg(o,#0'C'#$7);
    if ((y1=y)or(x1=x))and(y1<>0) then writeg(o,#0'C'#$1b);
    if ((y1=y)or(x1=x))and(y1=0) then writeg(o,#0'C'#$70);
    if (y1=y)and(x1=x) then writeg(o,#0'C'#$2f);
    writeg(o,nstring(typname[x1,y1],15));
   end;
  end;
  writeg(o,#10#10#0'C'#$7);
  for i:=0 to 4 do if TypPoss[x,y] and (1 shl i)<>0
  then writeg(o,#13#10+nstring(optionname[i],20));
  if TypPoss[x,y]=128 then writeg(o,#13#10'nicht Verf�gbar');
  for i:=0 to 4 do writeg(o,#13#10+spaces(20));
  repeat
   c:=kbreadkey;
   redraw:=1;
   if c=#0 then sc:=byte(kbreadkey) else sc:=kbscancode;
   case c of
    #27:halt2;
    #13:if TypPoss[x,y]<>128 then begin
     i:=0;
     tagw[0]:=5;
     for j:=0 to 4 do if (1 shl j) and typposs[x,y]<>0 then begin
      inc(i);
      tagw[i]:=j;
     end;
     k:=0;
     redraw:=0;
     y1:=0;
     if i<>0 then repeat
      writeg(o,#0'@'#0#10#0'C'#$b);
      for j:=0 to i do begin
       if y1=j then writeg(o,#0'C'#$8f) else writeg(o,#0'C'#$b);
       writeg(o,optionName[tagw[j]]+#13#10);
      end;
      c:=kbreadkey;
      if c=#0 then sc:=byte(kbreadkey);
      case c of
       #27:halt2;
       #13:begin
	redraw:=2;
	k:=tagw[y1];
       end;
       #0:case sc of
	$48:if y1=0 then y1:=i else dec(y1);
	$50:if y1=i then y1:=0 else inc(y1);
       end;
      end;
     until redraw>0;
     case x of
      1:case y of
       1:case k of
	0:CreateUniverseWurfelRegular(false);
	1:CreateUniverseWurfelRandomA;
	2:writeg(o,'2');
	5:CreateUniverseWurfelRandom;
       end;
       2:case k of
	0:CreateUniverseQuaderRegular(false);
	1:writeg(o,'1');
	2:writeg(o,'2');
	5:writeg(o,'5');
       end;
       3:case k of
	0:CreateUniverseSpatRegular(false);
	1:writeg(o,'1');
	2:writeg(o,'2');
	5:writeg(o,'5');
       end;
      end;
      2:case y of
       1:case k of
	0:CreateUniverseWurfelRegular(true);
	1:{CreateUniverseWurfelRandom};
	2:begin writeg(o,'2');halt2;end;
	5:begin writeg(o,'5');halt2;end;
       end;
       2:case k of
	0:CreateUniverseQuaderRegular(true);
	1:writeg(o,'1');
	2:writeg(o,'2');
	5:writeg(o,'5');
       end;
       3:case k of
	0:CreateUniverseSpatRegular(true);
	1:writeg(o,'1');
	2:writeg(o,'2');
	5:writeg(o,'5');
       end;
      end;
      3:;
      4:;
     end;
    end;
    #0:case sc of
     $48:if y=1 then y:=6 else dec(y);
     $50:if y=6 then y:=1 else inc(y);
     $4b:if x=1 then x:=3 else dec(x);
     $4d:if x=3 then x:=1 else inc(x);
    else
     redraw:=0;
    end;
   else
    redraw:=0;
   end;
  until redraw>0;
 until redraw>1;
end;

procedure xchgb(var a,b:byte);
var
 t:byte;
begin
 t:=a;
 a:=b;
 b:=t;
end;

procedure FindPlans;
var
 _31:array[0..31] of byte;
 raceorder:array[0..31] of byte;
 plannrs:array[0..31] of word;
 pdm,
 pdx,
 px,
 dm,
 dx,
 drm,
 drx,
 try:word;
 tp:xyzpos;
begin
 try:=0;
 gotoxy(1,2);
 { getting order of races }
 for i:=0 to 31 do _31[i]:=i;
 for i:=0 to 31 do begin
  k:=prandom(32-i);
  raceorder[i]:=_31[k];
  _31[k]:=_31[31-i];
 end;
 j:=31;
 for i:=0 to nrraces-1 do while not racesa[raceorder[i]] do begin
  xchgb(raceorder[i],raceorder[j]);
  dec(j);
 end;

 {getting planets}
 writeg(o,#0'C'#$f#12'Anzahl Planeten: '#0'C'#$a+w2s(nrplans,4,false,false)+
	  #13#10#10#0'C'#7'Analysiere Universum...'#13#10#0'C'#$c+w2s(nrplans,4,false,false)+#13);
 pdm:=0;
 pdx:=0;
 px:=0;
 for i:=nrplans-1 downto 0 do begin
  drm:=32767;
  drx:=0;
  for j:=0 to nrplans-1 do if i<>j then begin
   k:=dist(planpos[i,0],planpos[i,1],planpos[i,2],
	   planpos[j,0],planpos[j,1],planpos[j,2]);
   if k<drm then drm:=k;
   if k>drx then drx:=k;
  end;
  if (drm>pdx)or(pdx=0) then pdx:=drm;
  if (drm<pdm)or(pdm=0) then pdm:=drm;
  if px<drx then px:=drx;
  writeg(o,w2s(i,4,false,false)+#13);
 end;
 writeg(o,#0'C'#$7'Suche Heimatplaneten...'#13#10);
 repeat
  inc(try);
  repeat
   for i:=0 to nrraces-1 do begin
    plannrs[i]:=prandom(nrplans);
    if i<>0 then for j:=0 to i-1 do if plannrs[i]=plannrs[j] then begin
     plannrs[i]:=prandom(nrplans);
     j:=0;
    end;
   end;
   dm:=0;
   dx:=0;
   if nrraces<>1 then for i:=0 to nrraces-1 do begin
    drm:=32767;
    for j:=0 to nrraces-1 do if j<>i then begin
     k:=dist(planpos[plannrs[i],0],planpos[plannrs[i],1],planpos[plannrs[i],2],
	     planpos[plannrs[j],0],planpos[plannrs[j],1],planpos[plannrs[j],2]);
     if k<drm then drm:=k;
    end;
    if (drm>dx)or(dx=0) then dx:=drm;
    if (drm<dm)or(dm=0) then dm:=drm;
   end;
  until (nrraces=1) or (((px div (nrraces+2))<dm)and(dx<=2*dm));
  writeg(o,#13'Abstand zwischen '#0'C'#$a+w2s(dm,1,true,true)+
	   #0'C'#$7' und '#0'C'#$a+w2s(dx,1,true,true)+
	   #0'C'#$7' lj :'#0'C'#$e'<'#0'C'#$C'W'#0'C'#$e'iederholen>'#0'C'#$7);
  c:=kbreadkey;
  if c=#0 then kbreadkey;
 until upcase(c)<>'W';
 writeg(o,#13'Abstand zwischen '#0'C'#$a+w2s(dm,1,true,true)+
	  #0'C'#$7' und '#0'C'#$a+w2s(dx,1,true,true)+
	  #0'C'#$7' lj               '#13#10);

 {Planeten tauschen }
 for i:=0 to nrraces-1 do begin
  k:=plannrs[i];
  tp:=planpos[k];
  planpos[k]:=planpos[raceorder[i]];
  planpos[raceorder[i]]:=tp;
  for j:=i+1 to nrraces-1
  do if plannrs[j]=raceorder[i]
  then begin
   plannrs[j]:=k;
   break;
  end;
 end;

 setstring(sysmsg[1,syspos[1]],#0'C'#$f'Abstand zu Gegnern:'#0'C'#$e' zwischen '
	+strg(dm)+' und '+strg(dx)+' lj '#0'C'#$7'('+strg(try)+'. Konstellation)');

end;

procedure CreatePlans;
var
 p:^string;
begin
 p:=@plannam_def;
 new(newplanet[0]);
 new(newplanet[1]);
 for i:=0 to 499 do begin
  with newplanet[0]^[i] do begin
   fillchar(newplanet[0]^[i],sizeof(newplanet[0]^[i]),0);
   id_nr:=i;
   size:=100000+30*(prandom(65535)+30*prandom(65535)+25*prandom(65535)+25*prandom(65535));
   Neutr:=prandom(Rohstoffavg)+prandom(Rohstoffavg);
   molyb:=prandom(Rohstoffavg)+prandom(Rohstoffavg);
   dura:=prandom(Rohstoffavg)+prandom(Rohstoffavg);
   Trit:=prandom(Rohstoffavg)+prandom(Rohstoffavg);
   if Random(3)=0 then begin
    NativeAnz:=Random(size);
    nativetyp:=prandom(high(natives)+1);
   end else begin
    nativeanz:=0;
   end;
   climate:=prandom(256) shl 8 or prandom(256);
   if (climate shr 8) and $f=0 then begin
    if climate and $ff<128 then climate:=climate and not $ff
    else climate:=climate or $ff;
   end;
   vertneutr:=prandom(128);
   vertmolyb:=prandom(128);
   vertdura:=prandom(128);
   verttrit:=prandom(128);
   if(i<32)and racesa[i] then begin
    racetyp:=i;
    raceanz:=4326849;
    nativeanz:=0;
    size:=8658871;
    minedNeutr:=prandom(Rohstoffavg div 4)+Rohstoffavg div 8;
    minedmolyb:=prandom(Rohstoffavg div 4)+Rohstoffavg div 8;
    mineddura:=prandom(Rohstoffavg div 4)+Rohstoffavg div 8;
    minedTrit:=prandom(Rohstoffavg div 4)+Rohstoffavg div 8;
    inc(neutr,rohstoffavg div 2);
    inc(molyb,rohstoffavg div 2);
    inc(Dura,rohstoffavg div 2);
    inc(Trit,rohstoffavg div 2);
    climate:=$0880 or optiklima[i] shl 12;
    vertneutr:=96;
    vertmolyb:=96;
    vertdura:=96;
    verttrit:=96;
    supplies:=500;
    creds:=10000;
   end else racetyp:=32;
   nativecont:=100;
   racecont:=100;
   posx:=planpos[i,0];
   posy:=planpos[i,1];
   posz:=planpos[i,2];
   name:=p^;
   bild:=274+prandom(5)+nklima(climate)*5;
   p:=pointer(lint(p)+byte(p^[0])+1);
  end;
 end;
 if nrplans>500 then for i:=0 to nrplans-501 do begin
  with newplanet[1]^[i] do begin
   fillchar(newplanet[1]^[i],sizeof(newplanet[1]^[i]),0);
   id_nr:=i+500;
   size:=100000+50*(prandom(65535)+prandom(65535)+prandom(65535)+prandom(65535));
   Neutr:=prandom(Rohstoffavg)+prandom(Rohstoffavg);
   molyb:=prandom(Rohstoffavg)+prandom(Rohstoffavg);
   dura:=prandom(Rohstoffavg)+prandom(Rohstoffavg);
   Trit:=prandom(Rohstoffavg)+prandom(Rohstoffavg);
   if Random(3)=0 then begin
    NativeAnz:=Random(size);
    nativetyp:=prandom(high(natives)+1);
   end else begin
    nativeanz:=0;
   end;
   racetyp:=32;
   climate:=prandom(256) shl 8 or prandom(256);
   if (climate shr 8) and $f=0 then begin
    if climate and $ff<128 then climate:=climate and not $ff
    else climate:=climate or $ff;
   end;
   vertneutr:=prandom(128);
   vertmolyb:=prandom(128);
   vertdura:=prandom(128);
   verttrit:=prandom(128);
   nativecont:=100;
   racecont:=100;
   posx:=planpos[i+500,0];
   posy:=planpos[i+500,1];
   posz:=planpos[i+500,2];
   name:=p^;
   bild:=274+prandom(5)+nklima(climate)*5;
   p:=pointer(lint(p)+byte(p^[0])+1);
  end;
 end;
end;

procedure placeships;
begin
 writeg(o,#0'C'#7'Erzeuge Schiffe...'#13#10);
 new(newship);
 nrships:=0;
 for i:=0 to 31
 do if racesa[i]
 then for j:=0 to 1 do begin
  fillchar(newship^[nrships],sizeof(newship^[nrships]),0);
  with newship^[nrships] do begin
   typnr:=firstships[i,j];
   with hulls[typnr] do begin
    id_nr:=nrships;
    engtyp:=1;
    beams:=min(maxbeams,3);
    if beams>0 then beamtyp:=1;
    torprohre:=min(maxtorps,2);
    bays:=min(maxbays,2);
    crew:=maxcrew;
    if bays>0 then fighter:=5;
    if torprohre>0 then torps[1]:=9;
    owner:=i;
    posx:=planpos[i,0];
    posy:=planpos[i,1];
    posz:=planpos[i,2];
    targetx:=posx;
    targety:=posy;
    targetz:=posz;
    Schiffname:=rassen[i]+' - '+strg(j);
    if sgewicht(@newship^[nrships])>maxmasse then begin
     while (fighter>0)and(sgewicht(@newship^[nrships])>maxmasse)
     do dec(fighter);
     if sgewicht(@newship^[nrships])>maxmasse then begin
      while (bays>0)and(sgewicht(@newship^[nrships])>maxmasse)
      do dec(bays);
      if sgewicht(@newship^[nrships])>maxmasse then begin
       while (torps[1]>0)and(sgewicht(@newship^[nrships])>maxmasse)
       do dec(torps[1]);
       if sgewicht(@newship^[nrships])>maxmasse then begin
	while (torprohre>0)and(sgewicht(@newship^[nrships])>maxmasse)
	do dec(torprohre);
	if sgewicht(@newship^[nrships])>maxmasse then begin
	 while (beams>0)and(sgewicht(@newship^[nrships])>maxmasse)
	 do dec(beams);
	 if sgewicht(@newship^[nrships])>maxmasse then begin
	 end;
	end;
       end;
      end;
     end;
    end;
   end;
  end;
  inc(nrships);
 end;
end;

procedure setgenflags;
var
 y,
 t:byte;
const
 xo:array[false..true] of char=' '#251;
 ro:array[false..true] of char=' '#004;
 moves:array[0..2,0..8] of byte=
  ((7,7,1,0,2,3,4,5,6),
   (3,2,4,5,6,7,8,0,1),
   (1,0,0,4,3,6,5,8,7));
begin
 y:=0;
 genflags:=0;
 repeat
  writeg(o,#0'C'#$f#12);
  case genflags and $5 of
   0:j:=0;
   1:j:=1;
   4:j:=2;
  end;
  writeg(o,'Schiffe:'#13#10);
  if (y=0) then writeg(o,#0'C'#$1f)
  else writeg(o,#0'C'#$b);
  writeg(o,'('+ro[j=0]+') Schiffbau nach Vorgabe      '#13#10);
  writeg(o,'('+ro[j=1]+') Austausch zw. Waffensystemen'#13#10);
  writeg(o,'('+ro[j=2]+') freie Waffen-Best�ckung     ');
  if y=0 then t:=j;

  j:=byte(genflags and $8=0);
  if (y=1) then writeg(o,#0'C'#$1f)
  else writeg(o,#0'C'#$b);
  writeg(o,#0'@'#39#1'['+xo[boolean(j)]+'] Erzkonverter verf�gbar         ');
  if y=1 then t:=j;

  j:=byte(genflags and $10=0);
  if (y=2) then writeg(o,#0'C'#$1f)
  else writeg(o,#0'C'#$b);
  writeg(o,#0'@'#39#2'['+xo[boolean(j)]+'] Neutroniumraffinerie verf�gbar ');
  if y=2 then t:=j;


  writeg(o,#0'C'#$f#0'@'#0#5'Anzeige:'#13#10);
  case genflags and $1002 of
   0:j:=0;
   $1000:j:=1;
  else
   j:=2;
  end;
  if (y=3) then writeg(o,#0'C'#$1f)
  else writeg(o,#0'C'#$b);
  writeg(o,'('+ro[j=0]+') nahe Planeten sichtbar     '#13#10);
  writeg(o,'('+ro[j=1]+') entdeckte Planeten sichtbar'#13#10);
  writeg(o,'('+ro[j=2]+') alle Planeten sichtbar     '#13#10);
  if y=3 then t:=j;

  j:=byte(genflags and $2000<>0);
  if (y=4) then writeg(o,#0'C'#$1f)
  else writeg(o,#0'C'#$b);
  writeg(o,#0'@'#39#6'('+ro[not boolean(j)]+') nahe Schiffe sichtbar ');
  writeg(o,#0'@'#39#7'('+ro[    boolean(j)]+') alle Schiffe sichtbar ');
  if y=4 then t:=j;


  writeg(o,#0'C'#$f#0'@'#0#10'Punktest„nde der Gegner:'#13#10);
  j:=byte(genflags and $20<>0);
  if (y=5) then writeg(o,#0'C'#$1f)
  else writeg(o,#0'C'#$b);
  writeg(o,'('+ro[not boolean(j)]+') bei Sichtkontakt'#13#10);
  writeg(o,'('+ro[    boolean(j)]+') immer           ');
  if y=5 then t:=j;

  j:=byte(genflags and $40<>0);
  if (y=6) then writeg(o,#0'C'#$1f)
  else writeg(o,#0'C'#$b);
  writeg(o,#0'@'#39#11'('+ro[not boolean(j)]+') keine Details');
  writeg(o,#0'@'#39#12'('+ro[    boolean(j)]+') Detailiert   ');
  if y=6 then t:=j;


  writeg(o,#0'C'#$f#0'@'#0#14'Meteoreinschl„ge:'#13#10);
  if genflags and $f80=0 then begin
   i:=1;
   j:=0;
  end else begin
   i:=byte(genflags and $80<>0);
   j:=(genflags shr 8) and $f+1;
  end;
  if (y=7) then writeg(o,#0'C'#$1f)
  else writeg(o,#0'C'#$b);
  writeg(o,w2s(j,2,false,false));
  if y=7 then t:=j;

  if (y=8) then writeg(o,#0'C'#$1f)
  else writeg(o,#0'C'#$b);
  if i=0 then writeg(o,' Runden pro Meteor')
  else writeg(o,' Meteore pro Runde');
  if y=8 then t:=i;

  writeg(o,#0'C'#$c#0'@'#0#29'RETURN'#0'C'#$e' zum „ndern, '+
	   #0'C'#$c'F10'#0'C'#$e' = Weiter');

  repeat
   redraw:=1;
   c:=kbreadkey;
   if c=#0 then sc:=byte(kbreadkey);
   case c of
    #0:case sc of
     $44:begin
      setstring(sysmsg[0,syspos[0]],#0'C'#$f'Spieloptionen:');
      inc(syspos[0]);

      case genflags and 5 of
       0:setstring(sysmsg[0,syspos[0]],
	 #0'C'#$b'Schiffe k”nnen nur nach Vorgabe gebaut werden');
       1:setstring(sysmsg[0,syspos[0]],
	 #0'C'#$b'Schiffe k”nnen mit alternativen Waffen ausger�stet werden');
       4:setstring(sysmsg[0,syspos[0]],
	 #0'C'#$b'Schiffe frei best�ckbar (max 25 Waffensysteme pro Typ)');
      end;
      inc(syspos[0]);

      if genflags and $8=0
      then setstring(sysmsg[0,syspos[0]],
	 #0'C'#$b'Merlin Erzkonverter funktioniert')
      else setstring(sysmsg[0,syspos[0]],
	 #0'C'#$b'Merlin Erzkonverter funktioniert nicht');
      inc(syspos[0]);

      if genflags and $10=0
      then setstring(sysmsg[0,syspos[0]],
	 #0'C'#$b'Neutroniumraffinerie funktioniert')
      else setstring(sysmsg[0,syspos[0]],
	 #0'C'#$b'Neutroniumraffinerie funktioniert nicht');
      inc(syspos[0]);

      case genflags and $1002 of
       0:setstring(sysmsg[0,syspos[0]],
	 #0'C'#$b'Planeten nur innerhalb Scanreichweite sichtbar');
       $1000:setstring(sysmsg[0,syspos[0]],
	 #0'C'#$b'Einmal entdeckte Planeten sichtbar');
       2:setstring(sysmsg[0,syspos[0]],
	 #0'C'#$b'alle Planeten sichtbar');
      end;
      inc(syspos[0]);

      if genflags and $2000=0
      then setstring(sysmsg[0,syspos[0]],
	 #0'C'#$b'Schiffe nur in Scanreichweite sichtbar')
      else setstring(sysmsg[0,syspos[0]],
	 #0'C'#$b'Alle Schiffe sichtbar');
      inc(syspos[0]);

      if genflags and $40=0
      then setstring(sysmsg[0,syspos[0]],
	 #0'C'#$b'Scores der Gegner ohne Details')
      else setstring(sysmsg[0,syspos[0]],
	 #0'C'#$b'Scores der Gegner detailiert');
      if genflags and $20=0
      then setstring(sysmsg[0,syspos[0]],
	 getstring(sysmsg[0,syspos[0]])+
	 ', nur bei Sichtkontakt');
      inc(syspos[0]);

      if genflags and $f80=0 then setstring(sysmsg[0,syspos[0]],
	 #0'C'#$b'Keine Meteore')
      else if genflags and $80=0
      then setstring(sysmsg[0,syspos[0]],
	 #0'C'#$b+strg(genflags shr 8 and $f+1)+' Runden pro Meteor')
      else setstring(sysmsg[0,syspos[0]],
	 #0'C'#$b+strg(genflags shr 8 and $f+1)+' Meteore pro Runde');
      inc(syspos[0]);

      exit;
     end;
     $48:y:=moves[0,y];
     $50:y:=moves[1,y];
     $4b,$4d:y:=moves[2,y];
    else
     redraw:=0;
    end;
    #13,' ':case y of
     0:case t of
      0:genflags:=genflags or 1;
      1:genflags:=genflags and not 1 or 4;
     else{2}
      genflags:=genflags and not 5;
     end;
     1:genflags:=genflags xor 8;
     2:genflags:=genflags xor $10;
     3:case t of
      0:genflags:=genflags or $1000;
      1:genflags:=genflags or 2 and not $1000;
     else{2}
      genflags:=genflags and not $1002;
     end;
     4:genflags:=genflags xor $2000;
     5:genflags:=genflags xor $20;
     6:genflags:=genflags xor $40;
     8:begin
      if j<2 then genflags:=genflags and not $f80 or $100
      else genflags:=(genflags xor $80);
     end;
    else {7}
     if j=0 then begin
      genflags:=genflags and not $f80 or $80;
     end else if j=16 then begin
      if i<>0 then genflags:=genflags and not $f80 or $100
      else genflags:=genflags and not $f80;
     end else genflags:=genflags and not $f00 or (j and $f)shl 8;
    end;
   else
    redraw:=0;
   end;
  until redraw>0;
 until false;
end;

procedure placebases;
begin
 writeg(o,'Platziere Basen...'#13#10);
 fillchar(newbase,sizeof(newbase),0);
 for i:=0 to 31 do if racesa[i]
 then with newbase[i] do begin
  id_nr:=i;
  crew:=50000;
  fighter:=30;
  defs:=15;
  techh:=$11;
  teche:=$11;
  techb:=$11;
  techt:=$11;
  techm:=$11;
  owner:=i;
  posx:=planpos[i,0];
  posy:=planpos[i,1];
  posz:=planpos[i,2];
  storage[0,1]:=3;
  storage[1,1]:=2;
  torps[1]:=20;
  build.hullid:=$ff;
  repairid:=-1;
  name:=copy(rassen[i],1,15)+' 1';
 end;
end;

procedure scancontact;

 procedure scanships;
 begin
  for i:=0 to nrships-1 do begin
{   if genflags and $2000=0
   then begin
    if i<>0 then for j:=0 to i-1 do begin
     if dist(newship^[i].posx,newship^[i].posy,newship^[i].posz,
	     newship^[j].posx,newship^[j].posy,newship^[j].posz)<=250
     then begin
      tagl[i]:=tagl[i] or longint(1) shl newship^[j].owner;
      tagl[j]:=tagl[j] or longint(1) shl newship^[i].owner;
     end;
    end;
    for j:=0 to 31 do if racesa[i] then begin
     if dist(newship^[i].posx,newship^[i].posy,newship^[i].posz,
	     newbase[j].posx,newbase[j].posy,newbase[j].posz)<=250
     then begin
      tagl[1000+i]:=tagl[1000+i] or longint(1) shl newship^[i].owner;
     end;
    end;
   end else fillchar(tagl,sizeof(tagl),$ff);
}
   if genflags and 2 =0
   then begin
    for j:=0 to nrplans-1
    do if dist(newship^[i].posx,newship^[i].posy,newship^[i].posz,
	     planpos[j,0],planpos[j,1],planpos[j,2])<=250
    then begin
     if j<500 then with newplanet[0]^[j]
     do knownto:=knownto or longint(1) shl newship^[i].owner
     else with newplanet[1]^[j-500]
     do knownto:=knownto or longint(1) shl newship^[i].owner;
    end;
   end;
  end;

  if genflags and 2 <>0
  then begin
   for j:=0 to 499 do with newplanet[0]^[j] do knownto:=-1;
   if nrplans>500 then for i:=500 to nrplans-1
   do with newplanet[1]^[j-500] do knownto:=-1;
  end;
 end;

 procedure scanbases;
 begin
  fillchar(tagl,sizeof(tagl),0);
  fillchar(raceknown,sizeof(raceknown),0);
  if genflags and 2=0 then begin
   for i:=0 to 31 do if racesa[i] then begin
    for j:=0 to 499
    do if dist(planpos[i,0],planpos[i,1],planpos[i,2],
	       planpos[j,0],planpos[j,1],planpos[j,2])<=300
    then with newplanet[0]^[j]
    do begin
     knownto:=knownto or (longint(1) shl i);
     raceknown[racetyp]:=raceknown[racetyp] or (longint(1) shl i);
    end;
    if nrplans>500 then for j:=500 to nrplans-1
    do if dist(planpos[i,0],planpos[i,1],planpos[i,2],
	       planpos[j,0],planpos[j,1],planpos[j,2])<=300
    then with newplanet[1]^[j-500]
    do begin
     knownto:=knownto or (longint(1) shl i);
     raceknown[racetyp]:=raceknown[racetyp] or longint(1) shl i;
    end;
   end;
  end else begin
   for j:=0 to 499 do newplanet[0]^[j].knownto:=-1;
   if nrplans>500
   then for j:=0 to nrplans-501 do newplanet[1]^[j].knownto:=-1;
  end;
{  if genflags and $2000=0
  then begin
   for i:=0 to 31 do if racesa[i] then begin
    for j:=0 to nrships
    do with newship^[j]
    do if dist(planpos[i,0],planpos[i,1],planpos[i,2],posx,posy,posz)<=300
    then tagl[j]:=tagl[j] or longint(1) shl i;
   end;
  end else begin
   fillchar(tagl,sizeof(tagl),$ff);
  end;}
 end;

begin
 writeg(o,'Radarsuche...'#13#10);
 scanbases;
end;

procedure writeraces;
var
 i:byte;
 f:file;
 w:word;

 procedure messagewrite(n:byte);
 var
  i:byte;
 begin
  assign(f,path+'RACE-'+az10[n+1]+'.msg');
  rewrite(f,1);
  msganz:=0;
  for i:=0 to 1 do msginwrite(f,sysmsg[i]);
  close(f);
 end;

begin
 writeg(o,'Schreibe Nachrichtendateien... (*.msg)'#13#10);

 for i:=0 to 31 do if racesa[i] then Messagewrite(i);

 writeg(o,'Schreibe Rassendateien... (*.hst)'#13#10);

  filetag:=prandom(256) shl 24
	or prandom(256) shl 16
	or prandom(256) shl 8
	or prandom(256);
 msganz:=2;
 for i:=0 to 1 do with msglist^[i] do begin
  concern1:=9;
  concern2:=0;
  concern3:=0;
 end;

 Mfeldanz:=0;
 fillchar(wmsgs,sizeof(wmsgs),0);
 for i:=low(wmsgs) to high(wmsgs) do wmsgs[i].ofs:=-1;

 for i:=0 to 31 do if racesa[i] then begin
  shipsanz:=2;
  k:=0;
  for j:=0 to nrships-1 do if newship^[j].owner=i then begin
   ships1^[k]:=newship^[j];
   inc(k);
  end;

  planetsanz:=0;
  for j:=0 to 499
  do if newplanet[0]^[j].knownto and (longint(1) shl i)<>0
  then begin
   planets1^[planetsanz]:=newplanet[0]^[j];
   inc(planetsanz);
  end;
  if nrplans>500
  then for j:=0 to nrplans-501
  do if newplanet[1]^[j].knownto and (longint(1) shl i)<>0
  then begin
   if planetsanz>=500
   then planets2^[planetsanz]:=newplanet[1]^[j]
   else planets1^[planetsanz]:=newplanet[1]^[j];
   inc(planetsanz);
  end;

  basesanz:=1;
  bases1^[0]:=newbase[i];

  gotoxy(1,15);

  openracefiles(i,true);
  saverace;

 end;

 writeg(o,'Schreibe Host-Datei... (host.db)'#13#10);

 assign(f,path+'host.db');
 rewrite(f,1);
 blocksave(f,filetag,sizeof(filetag));
 blocksave(f,usedrassen,sizeof(usedrassen));
 w:=0;
 blocksave(f,w,sizeof(w));{Runden}
 blocksave(f,nrplans,sizeof(nrplans));
 blocksave(f,newplanet[0]^,sizeof(newplanet[0]^));
 if nrplans>500 then blocksave(f,newplanet[1]^,
			  sizeof(newplanet[1]^[1])*(nrplans-500));

 blocksave(f,nrships,sizeof(nrships));
 blocksave(f,newship^,sizeof(newship^[1])*nrships);

 w:=nrraces;
 blocksave(f,w,2);{Basen}
 for i:=0 to 30
 do if not racesa[i]
 then for j:=i to 30
 do newbase[j]:=newbase[j+1];
 blocksave(f,newbase,sizeof(newbase[1])*nrraces);
 w:=0;
 blocksave(f,w,sizeof(w));{Minenfelder}
 close(f);
 racesave;
end;

procedure erasefiles;
var
 sr:searchrec;
 er:file;
begin
{$ifndef unix}
 findfirst('Master\*.*',anyfile,sr);
{$else}
 findfirst('Master/*.*',anyfile,sr);
{$endif}
 {$i-}
writeln(doserror);
 while doserror=0 do begin
  writeln(sr.name);
  if sr.attr and (volumeid or directory)=0 then begin
{$ifndef unix}
   assign(er,'Master\'+sr.name);
{$else}
   assign(er,'Master/'+sr.name);
{$endif}
   setfattr(er,0);
   if ioresult<>0 then;
   erase(er);
   if ioresult<>0 then;
  end;
  findnext(sr);
 end;
 {$i+}
end;

begin
 initplanets;
{$ifndef unix}
 path:='Master\';
{$else}
 path:='Master/';
{$endif}
 {$i-}
 mkdir('Master');
 if ioresult<>0 then erasefiles;
 {$i+}

 initb(o,0,0,80,30,$e,0);
 fillchar(syspos,sizeof(syspos),0);
 fillchar(sysmsg,sizeof(sysmsg),0);

 prandomize;
 writeg(o,#12'Startwert f'#129'r Zufallszahlengenerator:');
 gotoxy(1,2);
 prandseed:=getnr(prandseed,maxlongint,$f,$1e,$a,$e,$c,0,true,true,true);
 if escpressed then halt2;
 clearscreen(0);

 fillchar(racesa,sizeof(racesa),0);
 repeat
  writeg(o,#0'@'#0#0#0'C'#$f'Folgende Rassen nehmen am Spiel teil:'#10);
  for i:=0 to 15 do begin
   if racesa[i*2]
   then writeg(o,#13#10#0'C'#$c+az10[i*2+1]
                +':'#0'C'#$e+mkstring(rassen[i*2]))
   else writeg(o,#13#10#0'C'#$c+az10[i*2+1]
                +':'#0'C'#$7+mkstring(rassen[i*2]));
   if racesa[i*2+1]
   then writeg(o,#0'X'#40#0'C'#$c+az10[i*2+2]
                +':'#0'C'#$e+mkstring(rassen[i*2+1]))
   else writeg(o,#0'X'#40#0'C'#$c+az10[i*2+2]
                +':'#0'C'#$7+mkstring(rassen[i*2+1]));
  end;
  writeg(o,#0'C'#7#13#10#10#10'ESC = Abbruch     RETURN = Fertig');
  repeat
   c:=upcase(kbreadkey);
   if c=#0 then sc:=byte(kbreadkey) else sc:=kbscancode;
   case c of
    'A'..'V','0'..'9':begin
     i:=pos(c,az10)-1;
     racesa[i]:=not racesa[i];
     redraw:=1;
     showp(16,350,242+i);
    end;
    #27:halt2;
    #13:begin
     usedrassen:=0;
     for i:=0 to 31 do usedrassen:=usedrassen or (longint(racesa[i]) shl i);
     nrraces:=0;
     for i:=0 to 31 do inc(nrraces,byte(racesa[i]));
     if usedrassen<>0 then redraw:=2;
    end;
   end;
  until redraw>0;
 until redraw>1;


 j:=0;
 syspos[0]:=3;
 setstring(sysmsg[0,0],#0'C'#$f'Startwert des Zufallsgenerators: '#0'C'#$e+
	   strg(prandseed));
 setstring(sysmsg[0,2],#0'C'#$f'Teilnehmende Rassen:');
 for i:=0 to 31 do if racesa[i] then begin
  if j=0 then setstring(sysmsg[0,syspos[0]],#0'C'#$e+nstring(mkstring(rassen[i]),35))
  else begin
   setstring(sysmsg[0,syspos[0]],
	     getstring(sysmsg[0,syspos[0]])+mkstring(rassen[i]));
   inc(syspos[0]);
  end;
  j:=j xor 1;
 end;
 inc(syspos[0],j+1);

 setgenflags;

 syspos[1]:=4;
 setstring(sysmsg[1,0],#0'C'#$f'Form des Universums:');
 createuniverse;
 findplans;
 createplans;
 placeships;
 placebases;
 scancontact;
 writeraces;
 writeg(o,#0'C'#$a'Neues Spiel in Verzeichnis Master generiert. (Taste)');
 gotoxy(1,14);
 if(kbreadkey=#0)then kbreadkey;
{$ifndef unix}
 setvideomode(3);
{$else}
 clearscreen(0);
{$endif}
 textattr:=$a;
 writeln('Neues Spiel in Verzeichnis Master generiert'#10);
 textattr:=$7;
 writeln('Achtung: neugeschaffenes Spiel'#13#10
	+'wird beim n'#132'chsten Aufruf von Master �berschrieben!'#13#10#10
	+'Dateien in ein anderes Verzeichnis kopieren!');
{$ifdef unix}
 kbreadkey;
{$endif}
end.