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

var
 x,
 y,
 redraw:byte;
 o:t_bdata;
 i,j:word;
 c:char;
 cs:byte;

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 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;

function Eingabenr(x,y:byte;maxx,def:longint;titel:string):longint;
var
 len:byte;
 t:longint;
 c:char;
begin
 eingabenr:=def;
 len:=digits(maxx);
 Window(x*8-2,y*8-2,1+8*(min(max(length(titel),len),78)+x),y*8+17);
 writex(x+1,y+1,$f,titel);
 if len<length(titel) then inc(x,(length(titel)-len) div 2);
 gotoxy(x+1,y+2);
 if (maxx>=0)and(maxx<10) then begin
  writeca(char(def+48),$1f,0,1);
  repeat
   c:=kbreadkey;
   case c of
    #13,#27:exit;
    '0'..'9':if byte(c)-48<=maxx then begin
     eingabenr:=byte(c)-48;
     exit;
    end else beep;
    #0:if kbreadkey<>#0 then beep;
   else
    beep;
   end;
  until false;
 end else begin
  t:=getnr(def,maxx,0,$1f,$a,$e,$c,0,true,maxx<0,false);
  if t<>NotANumber then eingabenr:=t;
 end;
end;

procedure racesel(y:byte);
var
 i,x:byte;
begin
 x:=0;
 with hulls[y] do repeat
  writeg(o,#0'C'#$8f#12+name+#10);
  for i:=0 to 31 do begin
   if x<>i then begin
    if rassenflags and (longint(1) shl i)<>0
    then writeg(o,#13#10#0'C'#$a)
    else writeg(o,#13#10#0'C'#$c);
   end else begin
    if rassenflags and (longint(1) shl i)<>0
    then writeg(o,#13#10#0'C'#$1a)
    else writeg(o,#13#10#0'C'#$1c);
   end;
   writeg(o,rassen[i]);
  end;
  c:=upcase(kbreadkey);
  if c=#0 then cs:=byte(kbreadkey);
  case c of
   #0:begin
    case cs of
     $48,$4b:if x>0  then dec(x);
     $50,$4d:if x<31 then inc(x);
    end;
   end;
   #27:redraw:=1;
   ' ',#13:rassenflags:=rassenflags xor (longint(1) shl x);
  end;
 until redraw=1;
end;

procedure missel(y:byte);
var
 i,x:byte;
begin
 x:=0;
 with hulls[y] do repeat
  writeg(o,#0'C'#$8f#12+name+#10);
  for i:=0 to 31 do begin
   if x<>i then begin
    if missionflags and (longint(1) shl i)<>0
    then writeg(o,#13#10#0'C'#$a)
    else writeg(o,#13#10#0'C'#$c);
   end else begin
    if missionflags and (longint(1) shl i)<>0
    then writeg(o,#13#10#0'C'#$1a)
    else writeg(o,#13#10#0'C'#$1c);
   end;
   writeg(o,missions[i]);
  end;
  c:=upcase(kbreadkey);
  if c=#0 then cs:=byte(kbreadkey);
  case c of
   #0:begin
    case cs of
     $48,$4b:if x>0  then dec(x);
     $50,$4d:if x<31 then inc(x);
    end;
   end;
   #27:redraw:=1;
   ' ',#13:missionflags:=missionflags xor (longint(1) shl x);
  end;
 until redraw=1;
end;

procedure writeflags(f:longint;sel:boolean);
var
 i:byte;
begin
 if sel then for i:=0 to 31 do begin
  if f and 1=1 then writeg(o,#0'C'#$1a'û') else writeg(o,#0'C'#$1c#9);
  f:=f shr 1;
 end else for i:=0 to 31 do begin
  if f and 1=1 then writeg(o,#0'C'#$0a'û') else writeg(o,#0'C'#$0c#9);
  f:=f shr 1;
 end;
end;

begin
{ assign(lst,'Con');
 rewrite(lst);
 asm
  mov ax,$3
  int $10
 end;}
 for y:=0 to 31 do begin
  writeln(lst,#10,strings('_',length(rassen[y])),':'#13,
	rassen[y]);
  writeln(lst,'____________________________________________________________________________'#13+
	    'Name:                tl|be to ba mi|dr|Mass MaxM Shld Hull|MaxF Crew|Cred Rs');
  for j:=0 to 12 
  do for i:=0 to 159
  do with hulls[i]
  do if (techlvl=j)and(rassenflags and (longint(1) shl y)<>0)then begin
   writeln(lst,nstring(name,20),':',techlvl:2,'|',
	maxbeams:2,maxtorps:3,maxbays:3,maxmines:3,'|',
	enganz:2,'|',masse:4,maxmasse:5,Schild:5,huelle:5,'|',
	maxfuel:4,maxcrew:5,'|',costcred:4,costmolyb+costdura+costtrit:5);

  end;
 end;
end.