{$A+,B-,D+,E-,F-,G+,I+,L+,N+,O-,P+,Q-,R-,S+,T-,V-,X+,Y+}
{$M 10240,400000,655360}
{$define raceedit}
uses
 tstring,
 types,
 utils,
 kb,
 evgraph,
 vbios,
{$ifndef unix}
 crt,
{$else}
 xcrt,
{$endif}
 data;

type MenuProc=procedure(a,b,c,d,e,f:longint);

type
 tp_shiplist=^t_shiplist;
 t_shiplist=record
  s:array[0..31] of tp_schiff;
  n:tp_shiplist;
 end;
 t_Ships=record
  NrOfShips:longint;
  ships:tp_shiplist;
 end;
 tp_planets1=^t_planets1;
 tp_planets2=^t_planets2;
 t_planets1=array[0..499] of t_planet;
 t_planets2=array[500..999] of t_planet;
 tp_bases1=^t_bases1;
 tp_bases2=^t_bases2;
 t_bases1=array[0..149] of t_starbase;
 t_bases2=array[150..299] of t_starbase;
 t_engines=array[0..9] of t_engine;
 t_Beams=array[0..10] of t_BeamWeapon;
 t_Mines=array[0..10] of t_mine;
 t_Torps=array[0..10] of t_torpedo;
 t_Torprohre=array[0..10] of t_torprohr;

 t_bdata=record
  x1,y1:word;
  px,py,x,y,c,h:byte;
 end;
 t_rassen=array[0..31] of string30;
 longarr=array[0..31] of longint;

const

 missions:array[0..35] of string22=
 ('Erkundung Weltraum',
  'Erkundung Planet',
  'Kolonisieren',
  'Minen legen',	(*Minenwerfer*)
  'Minen r„umen',	(*Strahlenwaffen*)
  'Attackieren',
  'Tarnen',
  'Entern',		(*Piraten: auch im WR verf�gbar*)
  'Verfolgen',		(*Masse/100kT:Chanche, entdeckt zu werden*)
  'Getarnt verfolgen',
  'Abfangen',
  'Schnellflug',	(*n. Schiff*)
  'Abschleppen',
  'mit Abschleppen',	(*Piraten*)
  'Selbstreperatur',	(*Cyborg*)
  'Bodenangriff',	(*Faschisten*)
  'Bodenangriff Natives',
  'Unruhen unterdr�cken',(*Lizards*)
  'Planet pl�ndern',	(*Faschisten*)
  'Planet ausspionieren',(*Bird Men*)
  'Planet Sabotieren',	(*Rebels*)
  'Klima ver„ndern',
  'Kolonie aufsp�ren',  (*Imperium*)
  'Zerlegen lassen',	(*SB*)
  'Aufr�sten lasen',	(*Sonnenbund*)
  'Fremdes Kommando',	(*abschaltbar*)
  'Aush„ndigen an',	(*gegnerisches Schiff/planet/SB*)
  'Selbstzerst”rung',	(*n. Schiff*)
  'Sternenbasis gr�nden',(*mobile SB*)
  'Sternenbasis zerst”ren',(*Kanpfschiff*)
  'Analyse des Schiffes',(*SB, unbekannter Schiffstyp*)
  'Crew auff�llen',	(*Syreen*)
  'Neutronium aufnehmen',(*Planet*)
  'Molybdenium aufnehmen',(*Planet*)
  'Duranium aufnehmen',(*Planet*)
  'Tritanium aufnehmen');(*Planet*)

 rassen2:t_rassen=
 ('Sonnenbund',
  'Echsenmenschen',
  'Vogelmenschen',
  'Faschisten',
  'Piraten',
  'Cyborgs',
  'Kristallmenschen',
  'Das Imperium',
  'Robotter',
  'Rebellen',
  'verlorenen Kolonien',
  'Kardasianer',
  'Bajoraner',
  'Menschen',
  'Vulkanier',
  'Klingonen',
  'Ferrengi',
  'Sirenen',
  'Judaeische Volksfront',
  'Volksfront von Judaea',
  'Ur-Quan',
  'Mycon',
  'Ilwrath',
  'VUX',
  'Androsynth',
  'Spathi',
  'Umgah',
  'Chenjesu',
  'Yeheat',
  'Ariloulaleelay',
  'Sofixti',
  'Mmrnmhrm');

GMissionFlags2:longarr=
 ($7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff,
  $7ea11fff);

 AZ10:string63='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';

{
var
 PrevFunc,
 NextFunc:MenuProc;
 mp,mo:array[1..6] of longint;
 ships:t_ships;
 UsedRassen:longint;
 GlobalFlags:longint;
 Planetsanz:word;
 Planets1:tp_planets1;
 planets2:tp_planets2;
 BasesAnz:word;
 Bases1:tp_bases1;
 Bases2:tp_bases1;
 rassen:t_rassen;
 gmissionflags:longarr;
 path:string63;

 engines:t_engines;
 beams:t_beams;
 mines:t_mines;
 torps:t_torps;
 torprohre:t_torprohre;
 hulls:t_hulls;
}
Procedure writeg(var b:t_bdata;s:string);
var
 i:word;
begin
 with b do while s<>'' do begin
  case s[1] of
   #0:case s[2] of
    'C':begin
     c:=byte(s[3]) and $f;
     h:=byte(s[3]) shr 4;
     delete(s,1,2);
    end;
    '@':begin
     px:=byte(s[3]);
     py:=byte(s[4]);
     delete(s,1,3);
    end;
    'X':begin
     px:=byte(s[3]);
     delete(s,1,2);
    end;
    'Y':begin
     py:=byte(s[4]);
     delete(s,1,2);
    end;
   else
    delete(s,1,1);
   end;
  #8:if px>0 then dec(px);
  #10:if py<y-1 then inc(py);
  #11:if py<>0 then dec(py);
  #12:begin
   FilledRectangle(x1,y1,x1+x*8-1,y1+y*8-1,h);
   px:=0;
   py:=0;
  end;
  #13:px:=0;
  else
   if px<x then begin
    WriteChar(s[1],x1+px*8,y1+py*8,c,h);
    inc(px);
   end;
  end;
  delete(s,1,1);
 end;
end;

procedure initb(var b:t_bdata;x1,y1:word;x,y,c,h:byte);
begin
 b.x1:=x1;
 b.y1:=y1;
 b.px:=0;
 b.py:=0;
 b.x:=x;
 b.y:=y;
 b.c:=c;
 b.h:=h;
end;

procedure window(x1,y1,x2,y2:word);
var
 i:word;
begin
 filledrectangle(x1+1,y1+1,x2-1,y2-1,0);
 Rectangle(x1,y1,x2,y2,$f);
 for i:=1 to 3 do begin
  VLine(x2+i,y1-i,y2+i,8,0);
  VLine(x1-i,y1-i,y2+i,7,0);
  hline(x1-i,x2+i,y1-i,7);
  hline(x1-i,x2+i,y2+i,8);
  plot(x1-i,y1-i,15);
  plot(x2+i,y2+i,7);
 end;
end;

procedure writex(x,y,a:byte;s:string);
begin
 gotoxy(x,y);
 textattr:=a;
 write(s);
end;

Procedure Eingabe(x,y,len:byte;titel:string;var s:string);
begin
 Window(x*8-2,y*8-2,1+8*(min(max(length(titel),len),78)+x),y*8+17);
 writex(x+1,y+1,$0f,titel);
 Editstr(x+1,y+2,len,min(len,78)-byte(len>78)*2,s,textchar,0,$5,$1f,$f,0,false,false,false,'ú',$8,$a);
end;

procedure NeuerName(var s:string;len:byte);
begin
 Eingabe(1,1,len,'Neuer Name:',s);
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
  move(gmissionFlags2,gmissionFlags,sizeof(gmissionFlags));
  move(rassen2,rassen,sizeof(rassen));
 end else begin
  blockread(f,rassen,sizeof(rassen));
  blockread(f,GMissionFlags,sizeof(gmissionflags));
  blockread(f,missions,sizeof(missions));
  blockread(f,engines,sizeof(engines));
  blockread(f,beams,sizeof(beams));
  blockread(f,mines,sizeof(mines));
  blockread(f,torps,sizeof(torps));
  blockread(f,torprohre,sizeof(torprohre));
  blockread(f,hulls,sizeof(hulls));
  close(f);
 end;
 {$i+}
end;

var
 mdata:t_bdata;
 redraw:boolean;
 i,j,x,y,t:word;


begin
 path:=paramstr(1);
 if (path<>'')and(path[byte(path[0])]<>'\') then path:=path+'\';
 setvideomode($12);
 asm
  mov ax,$1123
  xor bx,bx
  mov dl,60
  int $10
 end;
 windmax:=79+60*256;
 directvideo:=false;
 initb(mdata,8,8,78,58,$f,8);
 x:=0;
 y:=1;
 raceload;
 window(6,6,633,473);
 writeg(mdata,#0'C'#$f#12#10' Rassen-Editor');
 writeg(mdata,#0'C'#$7#13#10#10' F10=Speichern  ESC=Ende');
 repeat
  writeg(mdata,#0'C'#$f#12#10' Rassen-Editor');
  writeg(mdata,#0'C'#$7#13#10#10' F10=Speichern  ESC=Ende');
  for i:=0 to 31 do begin
   writeg(mdata,#0'@'#1+char(i+25));
   if (x=0)and(y=i+1) then writeg(mdata,#0'C'#$2f)
   else if y=i+1 then writeg(mdata,#0'C'#$1f)
   else writeg(mdata,#0'C'#$0f);
   writeg(mdata,nstring(rassen[i],30));
   if x>16 then t:=16 else t:=0;;
   for j:=0 to 15 do begin
    if length(missions[j+t])>i-1 then begin
     if j+1+t=x then begin
      if y=0 then writeg(mdata,#0'C'#$2f)
      else writeg(mdata,#0'C'#$1f)
     end else writeg(mdata,#0'C'#$0f);
     writeg(mdata,#0'@'+char(j*2+32)+char(i+2)+missions[j+t,i]);
    end else if i<=22 then begin
     if j+1+t=x then begin
      if y=0 then writeg(mdata,#0'C'#$2f)
      else writeg(mdata,#0'C'#$1f)
     end else writeg(mdata,#0'C'#$0f);
     writeg(mdata,#0'@'+char(j*2+32)+char(i+2)+' ');
    end;
    writeg(mdata,#0'@'+char(32+j*2)+char(i+25));
    if (gmissionflags[i] and (longint(1) shl (t+j))<>0)
    then begin
     if (i+1=y)and(j+1+t=x) then writeg(mdata,#0'C'#$2a'û')
     else if (i+1=y)or(j+1+t=x) then writeg(mdata,#0'C'#$1a'û')
     else writeg(mdata,#0'C'#$0a'û')
    end Else begin
     if (i+1=y)and(j+1+t=x) then writeg(mdata,#0'C'#$2c'X')
     else if (i+1=y)or(j+1+t=x) then writeg(mdata,#0'C'#$1c'X')
     else writeg(mdata,#0'C'#$0c'X')
    end;
   end;
  end;
  repeat
   redraw:=false;
   case upcase(kbreadkey) of
    #0:case byte(kbreadkey) of
     $48:begin
      if (y>1)or(x<>0)and(y>0) then dec(y);
      redraw:=true;
     end;
     $50:begin
      if y<32 then inc(y);
      redraw:=true;
     end;
     $4b:begin
      if (x>1)or(y<>0)and(x>0) then dec(x);
      redraw:=true;
     end;
     $4d:begin
      if x<32 then inc(x);
      redraw:=true;
     end;
     $44:begin
      racesave;
      setvideomode(co80);
      exit;
     end;
    end;
    #13,' ':begin
     if x=0 then eingabe(2,y+24,30,'Neue Rassenbezeichnung',rassen[y-1])
     else if y=0 then eingabe(24,2,22,'Neue Missionsbezeichnung',missions[x-1]);
     redraw:=true;
    end;
    #24:if y<>0 then begin
     gmissionflags[y-1]:=1;
     redraw:=true;
    end;
    'X':if y<>0 then begin
     gmissionflags[y-1]:= not gmissionflags[y-1];
     redraw:=true;
    end;
    'Y':if x>1 then begin
     for i:=0 to 31 do gmissionflags[i]:=gmissionflags[i] xor (longint(1) shl (x-1));
     redraw:=true;
    end;
    #25:if x>1 then begin
     for i:=0 to 31 do gmissionflags[i]:=gmissionflags[i] and not (longint(1) shl (x-1));
     redraw:=true;
    end;
    #27:begin
     setvideomode(co80);
     exit;
    end;
   end;
  until redraw;
 until false;
end.