{$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
 system.writeln(lst,spaces(25),'m    s    h maxM   cr   mo   du   tr tl be to ba');
 for i:=0 to 159 do with hulls[i] do begin
  typnr:=i;
  bild :=i;
  missionflags:=missionflags or 3;
  system.writeln(lst,nstring(name,20),':',masse:5,schild:5,Huelle:5,maxmasse:5,CostCred:5,CostMolyb:5,costDura:5,CostTrit:5,
	       techlvl:3,maxbeams:3,maxtorps:3,maxbays:3);
 end;
 writeln(lst,#10#10#10#10#10#10#10#10);
 for i:=0 to 159 do with hulls[i] do begin
  for y:=0 to 31
  do if longint(1) shl y and rassenflags<>0
  then system.write(lst,'þ³') else system.write(lst,'ù³');
  system.writeln(lst,strings(#8,64)+strings('_',64));
 end;
end.