{$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 menus6;
interface

procedure MineMenu(rasse,_id,_x,_y,_z,location:longint);

implementation
uses
 kb,
{$ifndef unix}
 crt,
{$else}
 xcrt,
{$endif}
 utils,
 schedule,
 evgraph,
 data,
 types,
 grafik,
 listen,
 menus1,
 menus2,
 menus3;

procedure xyz2(x,y,z,px,py,pz:sint;rotate:integer;var x1,y1,d:word);
var
 t:integer;
begin
 x:=x-px;
 y:=y-py;
 z:=z-pz;
 turnxyz(x,y,z,rotate);
 x1:=319+x+(z+1) div 2;
 y1:=233-y-(z+3) div 4;
 d:=trunc((-z+184)/73.6+0.5);
 if d=5 then d:=4;
end;

procedure MineMenu(rasse,_id,_x,_y,_z,location:longint);
var
 ax,ay,az,
 x,y,z:sint;
 x1,y1,
 x2,y2,
 x4,y4,
 d:word;
 fid,id,pid,t:longint;
 ship:tp_schiff;
 plan:tp_planet;
 base:tp_starbase;
 px,py,pz:sint;
 x3,y3,
 mcursor,ncursor,
 i:integer;
 c:char;
 sc,
 redraw,
 co:byte;

 p,b,s,e:boolean;
 o:t_bdata;

const
 ms:boolean=true;

begin
 initb(o,0,463,80,1,0,0);
 x:=_x;
 y:=_y;
 z:=_z;
 repeat
  ax:=x;
  ay:=y;
  az:=z;
  turnxyz(ax,ay,az,direct);
  clearscreen(0);
  writex(1,1,$e,#203' Minenfeldkarte');
  vline(184,000    ,370,$7,0);
  hline(184,    639,370,$7);
  line (000,462,184,370,$7,0);

  hline(184,    639,000,$f);
  line (000,092,184,000,$f,0);
  line (454,092,639,000,$f,0);
  begin
   xyz2(227,-184,-184,0,0,0,0,x1,y1,d);
   xyz2(227,-184,-110,0,0,0,0,x2,y2,d);
   line(x1,y1,x2,y2,starcols[0,d],0);
   xyz2(227,-184,-36,0,0,0,0,x1,y1,d);
   line(x1,y1,x2,y2,starcols[0,d],0);
   xyz2(227,-184,37,0,0,0,0,x2,y2,d);
   line(x1,y1,x2,y2,starcols[0,d],0);
   xyz2(227,-184,111,0,0,0,0,x1,y1,d);
   line(x1-1,y1,x2-1,y2,starcols[0,d],0);
   xyz2(227,-184,184,0,0,0,0,x2,y2,d);
   line(x1,y1,x2,y2,starcols[0,d],0);
  end;
  vline(639,000,    370,$f,0);
  rectangle(000,092,454,462,$f);

  writex(73,28,$c,'X');
  writes($e,'Y');
  writes($a,'Z');
  xyz2(0,0,0,0,0,0,0,x2,y2,d);
  x3:=620-x2;
  y3:=440-y2;
  xyz2(15,0,0,0,0,0,direct,x2,y2,d);
  line(620,440,x2+x3,y2+y3,$c,0);

  xyz2(0,15,0,0,0,0,direct,x2,y2,d);
  line(620,440,x2+x3,y2+y3,$e,0);

  xyz2(0,0,15,0,0,0,direct,x2,y2,d);
  line(620,440,x2+x3,y2+y3,$a,0);

  xyz2(226,-184,0,0,0,0,0,x2,y2,d);
  rectangle(x2-1,y2-1,x2+1,y2+1,$e);

  mcursor:=-1;
  ncursor:=0;
  if (mfeldanz<>0)then for i:=0 to mfeldanz-1 do with mfelder[i] do begin
   x2:=trunc(exp((1/3)*ln(anz))+0.5);
   if (abs(posx-x)<x2+226)and(abs(posy-y)<x2+184)and(abs(posz-z)<x2+184)
   then begin
    case direct of
     00..04:if posz<z then co:=4
      else  if posz>z then co:=6
      else		   co:=2;
     05..08:if posz>z then co:=4
      else  if posz<z then co:=6
      else		   co:=2;
     09..12:if posx>x then co:=4
      else  if posx<x then co:=6
      else		   co:=2;
     13..16:if posx<x then co:=4
      else  if posx>x then co:=6
      else		   co:=2;
     17..20:if posy<y then co:=4
      else  if posy>y then co:=6
      else		   co:=2;
     21..24:if posy>y then co:=4
      else  if posy<y then co:=6
      else		   co:=2;
    end;
    if ms then begin
     px:=posx;
     py:=posy;
     pz:=posz;
     case direct of
      00..08:begin
       if abs(pz-z)>184 then begin
	if pz<z then begin
	 pz:=z-184;
	 if z=posz then x2:=1
	 else x2:=trunc(exp((1/3)*ln(anz))*sqrt(1-sqr((pz-posz)/(x2)))+0.5);
	end else begin
	 pz:=z+184;
	 if z=posz then x2:=1
	 else x2:=trunc(exp((1/3)*ln(anz))*sqrt(1-sqr((posz-pz)/(x2)))+0.5);
	end;
	inc(co);
       end;
       xyz2(px,py,0,x,y,0,direct,x4,y4,d);{z->ñz}
      end;
      09..16:begin
       if abs(px-x)>184 then begin
	if px<x then begin
	 px:=x-184;
	 if x=posx then x2:=1
	 else x2:=trunc(exp((1/3)*ln(anz))*sqrt(1-sqr((px-x)/(x-posx)))+0.5);
	end else begin
	 px:=z+184;
	 if x=posx then x2:=1
	 else x2:=trunc(exp((1/3)*ln(anz))*sqrt(1-sqr((x-px)/(posx-x)))+0.5);
	end;
	inc(co);
       end;
       xyz2(0,py,pz,0,y,z,direct,x4,y4,d);{x->ñz}
      end;
      17..24:begin
       if abs(py-y)>184 then begin
	if py<y then begin
	 py:=y-184;
	 if y=posy then x2:=1
	 else x2:=trunc(exp((1/3)*ln(anz))*sqrt(1-sqr((py-y)/(y-posy)))+0.5);
	end else begin
	 py:=z+184;
	 if y=posy then x2:=1
	 else x2:=trunc(exp((1/3)*ln(anz))*sqrt(1-sqr((y-py)/(posy-y)))+0.5);
	end;
	inc(co);
       end;
       xyz2(px,0,pz,x,0,z,direct,x4,y4,d);{y->ñz}
      end;
     end;
     xyz2(px,py,pz,x,y,z,direct,x1,y1,d);
     x3:=integer(x1)-x4+92;
     if x3>226 then x3:=226;
     if x3<-226 then x3:=-226;
     y3:=integer(y1)-y4-46;
     if y3>184 then y3:=184;
     if y3<-184 then y3:=-184;
     dec(x1,x3);
     dec(y1,y3);
     if (ncursor=0)and(dist(posx,posy,posz,x,y,z)<=x2)
     then begin
      circle3(integer(x1)-1,integer(y1)-93,1+x3,93+y3,453,369,x2,co+8,0)
     end else begin
      circle3(integer(x1)-1,integer(y1)-93,1+x3,93+y3,453,369,x2,co,0);
     end;
    end;
    if dist(posx,posy,posz,x,y,z)<=x2 then begin
     inc(ncursor);
     if mcursor=-1 then mcursor:=i;
    end;
   end;
  end;

  p:=false;
  b:=false;
  e:=false;
  s:=false;

  fid:=firstplan(rasse,x,y,z,0);
  id:=fid;
  if id<>-1 then repeat
   plan:=getplan(id);
   with plan^ do begin
    if (posx=x)and(posy=y)and(posz=z) then p:=true;
    px:=posx;
    py:=posy;
    pz:=posz;
    turnxyz(px,py,pz,direct);
    if (abs(px-ax)<227)and(abs(py-ay)<185)and(abs(pz-az)<185)
    then begin
     xyz2(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=az then rrectangle(x1-2,y1-2,x1+2,y1+2,$7,0)
     else if pz<az then rrectangle(x1-2,y1-2,x1+2,y1+2,$8,0)
    end;
    id:=nextplan(id,rasse,x,y,z,0);
   end;
  until fid=id;

  fid:=firstbase(rasse,x,y,z,0);
  id:=fid;
  if id<>-1 then repeat
   base:=getbase(id);
   with base^ do begin
    if (posx=x)and(posy=y)and(posz=z) then b:=true;
    px:=posx;
    py:=posy;
    pz:=posz;
    turnxyz(px,py,pz,direct);
    if (abs(px-ax)<227)and(abs(py-ay)<185)and(abs(pz-az)<185)
    then begin
     xyz2(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=az then rrectangle(x1-2,y1-2,x1+2,y1+2,$7,0)
     else if pz<az then rrectangle(x1-2,y1-2,x1+2,y1+1,$8,0)
    end;
   end;
   id:=nextbase(id,rasse,x,y,z,0);
  until fid=id;

  fid:=firstship(rasse,x,y,z,0);
  id:=fid;
  if id<>-1 then repeat
   ship:=getship(id);
   with ship^ do begin
    if (posx=x)and(posy=y)and(posz=z) then begin
     if (owner=rasse)or(mission1=25)and(mission2=rasse) then s:=true else e:=true;
    end;
    px:=posx;
    py:=posy;
    pz:=posz;
    turnxyz(px,py,pz,direct);
    if (abs(px-ax)<227)and(abs(py-ay)<185)and(abs(pz-az)<185)
    then begin
     pid:=planid(posx,posy,posz);
     xyz2(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=az then rrectangle(x1-2,y1-2,x1+2,y1+2,$7,0)
     else if pz<az then rrectangle(x1-2,y1-2,x1+2,y1+2,$8,0)
    end;
   end;
   id:=nextship(id,rasse,x,y,z,0);
  until fid=id;

  xyz2(0,0,0,0,0,0,0,x1,y1,d);
  hline2(x1-10,x1+10,y1,$b,3);
  vline(x1,y1-10,y1+10,$b,3);

  writeg(o,#0'C'#$8e#12'X:'#0'C'#$8a+l2s(x,5,true,false,false)+
	#0'C'#$8e' Y:'#0'C'#$8a+l2s(y,5,true,false,false)+
	#0'C'#$8e' Z:'#0'C'#$8a+l2s(z,5,true,false,false)+' '#0'C'#$87);
  if p then writeg(o,#0'C'#$8e'P'#0'C'#$87) else writeg(o,'P'#0'C'#$87);
  if b then writeg(o,#0'C'#$8e'B'#0'C'#$87) else writeg(o,'B');
  if s then writeg(o,#0'C'#$8e'S'#0'C'#$87) else writeg(o,'S');
  if e then writeg(o,#0'C'#$8c'G') else writeg(o,'G');
  if ms then begin
   writeg(o,#0'C'#$8c' M'#0'C'#$8e'inenfelder: '#0'C'#$8a);
   if ncursor>1 then writeg(o,'1+'+strg(ncursor-1))
   else writeg(o,strg(ncursor));
   if ncursor>0 then with mfelder[mcursor] do begin
    writeg(o,' '#0'C'#$8e+mines[typid].name+
    ': '#0'C'#$8a+strg(anz)+' (r='+strg(trunc(exp((1/3)*ln(anz))+0.5))+')');
   end;
  end else begin
   writeg(o,#0'C'#$8c' M'#0'C'#$87'inenfelder...');
  end;

  if p or b or s or e then begin
   sound(1000);
   delay(100);
   nosound;
  end;

  repeat
   c:=upcase(kbreadkey);
   if c=#0 then sc:=byte(kbreadkey) else sc:=kbscancode;
   if c=#27 then begin
    oldmenu;
    exit;
   end;
   if not keyhandle(c,sc,rasse,x,y,z,x,y,z,redraw)
   then begin
    case c of
     'M':begin
      ms:=not ms;
      redraw:=2;
     end;
     'S':if s then begin
      t:=shiplist(rasse,x,y,z,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;
     'P':if p then begin
      t:=planid(x,y,z);
      if (t<>-1)and(getplan(t)^.racetyp=rasse)then begin
       runmenu(planmenu,rasse,t,0,0,0,0);
       redraw:=4;
      end else begin
       redraw:=3;
      end;
     end;
     'B':if b then begin
      t:=baseid(x,y,z);
      if (t<>-1)and(getbase(t)^.owner=rasse)then begin
       runmenu(basemenu,rasse,t,0,0,0,0);
       redraw:=4;
      end else begin
       redraw:=3;
      end;
     end;
     'G':if e then begin
      shiplist(rasse,x,y,z,7,-1,'Schiffe auf ('+strg(x)+','+strg(y)+','+strg(z)+')',0);
     end;
    else
     redraw:=0;
    end;
   end;
  until redraw>0;
 until redraw>2;
 mp[3]:=x;
 mp[4]:=y;
 mp[5]:=z;
end;

end.