{$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 Grafik;

interface
uses
 tstring,
 types;

procedure initgrafik;

procedure write(s:string);
procedure writes(a:byte;s:string);
procedure writex(x,y:byte;a:byte;s:string);

Procedure writeg(var b:t_bdata;s:string);
procedure initb(var b:t_bdata;x1,y1:word;x,y,c,h:byte);
procedure window(x1,y1,x2,y2:word);
procedure NeuerName(var s{$ifndef unix}:string{$endif};len:byte);
Procedure Eingabe(x,y,len:byte;titel:string;var s:string);
Procedure Eingabep(x,y,len:byte;titel:string;var s:string);
function Eingabenr(x,y:byte;maxx,def:longint;titel:string):longint;

procedure showp(x,y,n:word);
procedure showph(x,y,n:word);

implementation

uses
 utils,
 kb,
 evgraph,
 evbios,
 vbios,
{$ifndef unix}
 crt,
{$else}
 xcrt,
{$endif}
 data;

type
 tp=array[0..3,0..63,0..7] of byte;
 tph=array[0..3,0..31,0..3] of byte;

var
 f:file of tp;
 g:file of tph;

procedure writes(a:byte;s:string);
var
 i:byte;
begin
 textattr:=a;
 gwritesa(length(s),@s[1],a,(wherex-1)*8,(wherey-1)*(charsize+1));
 gotoxy(wherex+length(s),wherey);
end;

{$ifdef unix}
procedure showp(x,y,n:word);
var
 p:tp;
 i,j,o:word;
begin
 if n<=312 then begin
  seek(f,n);
  read(f,p);
  
{  
  o:=y*80+x div 8;
  for i:=0 to 3 do begin
   port[$3c4]:=2;
   port[$3c5]:=1 shl i;
   for j:=0 to 63
   do move(p[i,j],mem[sega000:o+j*80],8);
  end;
  port[$3c4]:=2;
  port[$3c5]:=$f;
}
 end else beep;
end;

procedure showph(x,y,n:word);
var
 ph:tph;
 i,j,o:word;
begin
 if n<=312 then begin
  seek(g,n);
  read(g,ph);
{
  o:=y*80+x div 8;
  for i:=0 to 3 do begin
   port[$3c4]:=2;
   port[$3c5]:=1 shl i;
   for j:=0 to 31
   do move(ph[i,j],mem[sega000:o+j*80],4);
  end;
  port[$3c4]:=2;
  port[$3c5]:=$f;
}
 end else beep;
end;

{$else}

procedure writes(a:byte;s:string);
var
 i:byte;
begin
 for i:=1 to length(s) do begin
  writechar(s[i],(wherex-1)*8,(wherey-1)*(charsize+1),a and $f,a shr 4);
  gotoxy(wherex+1,wherey);
 end;
end;

procedure showp(x,y,n:word);
var
 p:tp;
 i,j,o:word;
begin
 if n<=312 then begin
  seek(f,n);
  read(f,p);
  o:=y*80+x div 8;
  for i:=0 to 3 do begin
   port[$3c4]:=2;
   port[$3c5]:=1 shl i;
   for j:=0 to 63
   do move(p[i,j],mem[sega000:o+j*80],8);
  end;
  port[$3c4]:=2;
  port[$3c5]:=$f;
 end else beep;
end;

procedure showph(x,y,n:word);
var
 ph:tph;
 i,j,o:word;
begin
 if n<=312 then begin
  seek(g,n);
  read(g,ph);
  o:=y*80+x div 8;
  for i:=0 to 3 do begin
   port[$3c4]:=2;
   port[$3c5]:=1 shl i;
   for j:=0 to 31
   do move(ph[i,j],mem[sega000:o+j*80],4);
  end;
  port[$3c4]:=2;
  port[$3c5]:=$f;
 end else beep;
end;

{$endif}

procedure write(s:string);
begin
 writes(textattr,s);
end;

procedure writex(x,y:byte;a:byte;s:string);
begin
 gotoxy(x,y);
 writes(a,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*(charsize+1)-2,1+8*(min(max(length(titel),len),78)+x),y*(charsize+1)+33);
 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,1,0);
  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 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[3]);
     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*(charsize+1)-1,h);
   px:=0;
   py:=0;
  end;
  #13:px:=0;
  else
   if px<x then begin
    WriteChar(s[1],x1+px*8,y1+py*(charsize+1),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-4,y1-4,x2+4,y2+4,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);
var
 l:byte;
begin
 Window(x*8-2,y*(charsize+1)-2,1+8*(min(max(length(titel),len),78)+x),y*(charsize+1)+33);
 writex(x+1,y+1,$f,titel);
 if len<length(titel) then inc(x,(length(titel)-len) div 2);
 l:=len;
 if l>78 then begin
  inc(x);
  l:=78;
 end;
 Editstr(x+1,y+2,len,l,s,textchar,0,$5,$1f,$f,0,false,false,false,#255,$8,$a);
end;

Procedure Eingabep(x,y,len:byte;titel:string;var s:string);
var
 l:byte;
begin
 Window(x*8-2,y*(charsize+1)-2,1+8*(min(max(length(titel),len),78)+x),y*(charsize+1)+33);
 writex(x+1,y+1,$f,titel);
 if len<length(titel) then inc(x,(length(titel)-len) div 2);
 l:=len;
 if l>78 then begin
  inc(x);
  l:=78;
 end;
 Editstr(x+1,y+2,len,l,s,textchar,0,$5,$11,$88,0,false,false,true,'«',$8,$a);
end;

{$ifndef unix}
procedure NeuerName(var s:string;len:byte);
begin
 Eingabe(2,1,len,'Neuer Name:',s);
{$else}
procedure NeuerName(var s;len:byte);
var
	t:string;
	u:string255 absolute s;
begin
	t:=substr(u,2,byte(u[0]));
	Eingabe(2,1,len,'Neuer Name:',t);
	u[0]:=char(length(t));
	move(t[1],u[1],length(t));
{$endif}
end;

procedure initgrafik;
begin
 setvideomode($12);
 Directvideo:=false;
 windmax:=30*256+80;{ no auto-scroll }
 assign(f,'graphic.dbg');
 assign(g,'graphic.dbh');
 {$i-}
 filemode:=0;
 if ioresult<>0 then;
 reset(f);
 if ioresult<>0 then begin
  setvideomode(3);
  writeln('graphic.dbg kann nicht geöffnet werden');
  halt;
 end;
 reset(g);
 if ioresult<>0 then begin
  setvideomode(3);
  writeln('graphic.dbh kann nicht geöffnet werden');
  halt;
 end;
end;

end.