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

interface

procedure WriteMenu(rasse,id,_x,_y,_z,location:longint);

implementation
uses
 utils,
 schedule,
 types,
 evgraph,
 grafik,
 data,
 kb,
 evbios,
 vbios;

{$ifdef unix}
uses xcrt;
{$endif}

function clength(s:string):byte;
var
 i,l:word;
begin
 l:=0;
 i:=1;
 while i<=length(s) do begin
  if s[i]=#0 then inc(i,3);
  inc(l);
  inc(i);
 end;
 clength:=l;
end;

function cpos(i:byte;s:string):byte;
var
 j,
 p:byte;
begin
 j:=i;
 if i>clength(s) then i:=clength(s);
 j:=j-i;
 if i=0 then p:=1
 else begin
  p:=1;
  for i:=1 to i do if s[p]=#0 then inc(p,4) else inc(p);
 end;
 cpos:=p+j;
end;

function setcolor(i,c:byte;s:string):string;
var
 p:byte;
begin
 if i<60 then begin
  p:=cpos(i,s);
  if p>length(s) then s:=s+spaces(p-length(s));
  if s[p]=#0 then s[p+2]:=char(c) else insert(#0'C'+char(c),s,p);
  for i:=p-1 downto 1 do if s[i]=#0 then begin
   if s[i+2]=char(c) then delete(s,p,3);
   break;
  end;
  for i:=p+4 to length(s) do if s[i]=#0 then begin
   if s[i+2]=char(c) then delete(s,i,3);
   break;
  end;
  setcolor:=s;
 end;
end;

function setchar(s:string;i:byte;c:char):string;
var
 p:byte;
 l:byte absolute s;
begin
 if i<60 then begin
  p:=cpos(i,s);
  if p>length(s) then s:=s+spaces(p-length(s));
  if p>l then inc(l)
  else if s[p]=#0 then inc(p,3);
  s[p]:=c;
 end;
 setchar:=s;
end;

function insertchar(s:string;i:byte;c:char):string;
var
 p:byte;
 l:byte absolute s;
begin
 if i<60 then begin
  if clength(s)>=60 then begin
   if s[l-3]=#0 then dec(l,4) else dec(l);
  end;
  p:=cpos(i,s);
  if p>length(s) then s:=s+spaces(p-length(s)-1);
  if s[p]=#0 then inc(p,3);
  insert(c,s,p);
 end;
 insertchar:=s;
end;

function deletechar(s:string;i:byte):string;
var
 p:byte;
 l:byte absolute s;
begin
 if i<60 then begin
  p:=cpos(i,s);
  if p<=length(s) then begin
   if s[p]=#0 then begin
    if (p+4<=l) then begin
     if (s[p+4]=#0) then delete(s,p,4)
     else delete(s,p+3,1)
    end else s[p+3]:=' ';
   end else delete(s,p,1);
  end;
 end;
 deletechar:=s;
end;


procedure WriteMenu(rasse,id,_x,_y,_z,location:longint);
var
 p,
 q,
 o,
 d,
 r,
 col:t_bdata;

 i:word;
 d1,
 y1,
 x2,
 y2,
 x3,
 y3,
 redraw:byte;
 s:string;

 CCode,
 c:char;
 sc:byte;
 msg:t_message;
 insert:boolean;

begin
 fillchar(msg,sizeof(msg),0);
 insert:=true;
 clearscreen(0);
 initb(d,0,16,19,29,0,0);
 initb(r,0,16,4,29,0,0);
 initb(o,20*8,16,60,29,0,0);
 initb(p,5*8,16,61,29,0,0);
 initb(q,67*8,16,13,29,0,0);
 initb(col,22*8,2*16,48,2,0,0);

 y1:=0;
 x2:=0;
 y2:=0;
 x3:=1;
 y3:=1;

 repeat
  writex(1,1,$1f,nstring('Nachricht schreiben - Position w„hlen',80));
  hline(0,639,15,$f);
  repeat
   msgoutread(y1,msg);
   writeg(r,#0'C'#$7#12);
   writeg(p,#0'C'#$7#12);
   writeg(q,#0'C'#$7#12);
   vline(4*8+3,16,479,$a,0);
   vline(4*8+4,16,479,$2,0);
   vline(4*8+2,16,479,$7,0);
   vline(4*8+5,16,479,$8,0);

   vline(66*8+3,16,479,$a,0);
   vline(66*8+4,16,479,$2,0);
   vline(66*8+2,16,479,$7,0);
   vline(66*8+5,16,479,$8,0);

   d1:=0;
   if y1>14 then d1:=y1-14;
   if d1>4 then d1:=4;
   for i:=d1 to d1+28 do begin
    if y1=i then begin
     if wmsgs[i].rassen=0 then writeg(r,#0'C'#$e''#0'C'#$7+w2s(i+1,2,false,false)+#13#10)
     else writeg(r,#0'C'#$e''#0'C'#$a+w2s(i+1,2,false,false)+#13#10);
    end else begin
     if wmsgs[i].rassen=0 then writeg(r,#0'C'#$7+w2s(i+1,3,false,false)+#13#10)
     else writeg(r,#0'C'#$a+w2s(i+1,3,false,false)+#13#10);
    end;
   end;

   msgoutread(y1,msg);

   writeg(p,#0'C'#$f#12'Nachricht an:'#13#10#10);
   for i:=0 to 15 do begin
    if longint(1) shl (2*i) and wmsgs[y1].rassen<>0
    then writeg(p,#0'C'#$a)
    else writeg(p,#0'C'#$c);
    writeg(p,nstring(rassen[i*2],31));
    if longint(1) shl (2*i+1) and wmsgs[y1].rassen<>0
    then writeg(p,#0'C'#$a)
    else writeg(p,#0'C'#$c);
    writeg(p,rassen[i*2+1]+#13#10);
   end;

   for i:=1 to 29 do writeg(q,#0'C'#$7+getstring(msg[i])+#13#10);

   repeat
    if redraw<>4 then begin
     kbreset;
     c:=kbreadkey;
     if kbkeypressed then sc:=byte(kbreadkey) else sc:=kbscancode;
    end else begin
     c:=#13;
     sc:=0;
    end;
    redraw:=0;
    case sc of
     $48,$4b:begin
      if y1>0 then dec(y1);
      redraw:=1;
     end;
     $4d,$50:begin
      if y1<32 then inc(y1);
      redraw:=1;
     end;
     $47,$49:begin
      y1:=0;
      redraw:=1;
     end;
     $4f,$51:begin
      y1:=32;
      redraw:=1;
     end;
    else
     case c of
      #27:redraw:=3;
      #10,#13:begin
       if c=#10 then redraw:=4 else redraw:=3;
       repeat
	if redraw=3 then begin
	 writex(1,1,$8f,nstring('Nachricht schreiben - Empf„nger w„hlen (Return f�r Editor)',80));
	 vline(4*8+3,16,479,$a,0);
	 vline(4*8+4,16,479,$2,0);
	 vline(4*8+2,16,479,$7,0);
	 vline(4*8+5,16,479,$8,0);

	 vline(66*8+3,16,479,$a,0);
	 vline(66*8+4,16,479,$2,0);
	 vline(66*8+2,16,479,$7,0);
	 vline(66*8+5,16,479,$8,0);

	 hline(0,639,15,$f);
	 writeg(r,#0'C'#$7#12);
	 d1:=0;
	 if y1>14 then d1:=y1-14;
	 if d1>4 then d1:=4;
	 for i:=d1 to d1+28 do begin
	  if y1=i then begin
	   if wmsgs[i].rassen=0 then writeg(r,#0'C'#$e''#0'C'#$7+w2s(i+1,2,false,false)+#13#10)
	   else writeg(r,#0'C'#$e''#0'C'#$a+w2s(i+1,2,false,false)+#13#10);
	  end else begin
	   if wmsgs[i].rassen=0 then writeg(r,#0'C'#$7+w2s(i+1,3,false,false)+#13#10)
	   else writeg(r,#0'C'#$a+w2s(i+1,3,false,false)+#13#10);
	  end;
	 end;
	end;
	writeg(p,#0'C'#$f#12#0'C'#$1f+nstring('Nachricht an:',61)+#13#10#10);
	for i:=0 to 15 do begin
	 if(x2=0)and(y2=i) then begin
	  if longint(1) shl (2*i) and wmsgs[y1].rassen<>0
	  then writeg(p,#0'C'#$2a)
	  else writeg(p,#0'C'#$2c);
	 end else begin
	  if longint(1) shl (2*i) and wmsgs[y1].rassen<>0
	  then writeg(p,#0'C'#$a)
	  else writeg(p,#0'C'#$c);
	 end;
	 writeg(p,nstring(rassen[i*2],31));
	 if(x2=1)and(y2=i) then begin
	  if longint(1) shl (2*i+1) and wmsgs[y1].rassen<>0
	  then writeg(p,#0'C'#$2a)
	  else writeg(p,#0'C'#$2c);
	 end else begin
	  if longint(1) shl (2*i+1) and wmsgs[y1].rassen<>0
	  then writeg(p,#0'C'#$a)
	  else writeg(p,#0'C'#$c);
	 end;
	 writeg(p,rassen[i*2+1]+#13#10);
	end;
	if wmsgs[y1].rassen and (longint(1) shl (y2*2+x2))<>0
	then filledrectangle(44,346,51+64,417,2)
	else filledrectangle(44,346,51+64,417,4);
	showp(48,350,242+y2*2+x2);
	writeg(p,#10#0'C'#$7'Leertaste zum Ausw„hlen');
	repeat
	 redraw:=0;
	 kbreset;
	 c:=kbreadkey;
	 if kbkeypressed then sc:=byte(kbreadkey) else sc:=kbscancode;
	 case sc of
	  $50:begin
	   if y2<15 then inc(y2);
	   redraw:=1;
	  end;
	  $48:begin
	   if y2>0 then dec(y2);
	   redraw:=1;
	  end;
	  $4b:begin
	   if x2=1 then begin
	    x2:=0;
	    redraw:=1;
	   end;
	  end;
	  $4d:begin
	   redraw:=1;
	   if x2=0 then x2:=1 else redraw:=4;
	  end;
	 else
	  case c of
	   #27:redraw:=2;
	   ' ':begin
	    with wmsgs[y1] do rassen:=rassen xor (longint(1) shl (y2*2+x2));
	    redraw:=3;
	   end;
	   #13:begin
	    with wmsgs[y1]
	    do if rassen=0
	    then rassen:=(longint(1) shl (y2*2+x2));
	    clearscreen(0);
	    x3:=0;
	    y3:=1;
	    writeg(d,#0'C'#$f#12);
	    writeg(o,#0'C'#$f#12);
	    vline(19*8+3,16,479,$a,0);
	    vline(19*8+4,16,479,$2,0);
	    vline(19*8+2,16,479,$7,0);
	    vline(19*8+5,16,479,$8,0);
	    writex(1,1,$1f,nstring('Nachricht schreiben - Editor',80));
	    hline(0,639,15,$f);
	    ccode:=#0;
	    writeg(d,#10'Editor-Befehle:'#0'C'#$7#13#10#10+
		'^Y : Zeile l”schen'#13#10+
		'^Q : nach Cursor'#13#10+
		'     l”schen'#13#10+
		'^I : Zeile einf�gen'#13#10+
		'^C : Farbe „ndern'#13#10#10+
		'^X : Abbruch'#13#10+
		'F10: Text sichern'#13#10);
	    with wmsgs[y1]
	    do for i:=0 to 7 do begin
	     if rassen and (longint(1) shl (i*4+0))<>0 then showph(08,200+i*32,242+i*4+0);
	     if rassen and (longint(1) shl (i*4+1))<>0 then showph(40,200+i*32,242+i*4+1);
	     if rassen and (longint(1) shl (i*4+2))<>0 then showph(72,200+i*32,242+i*4+2);
	     if rassen and (longint(1) shl (i*4+3))<>0 then showph(104,200+i*32,242+i*4+3);
	    end;

	    repeat
	     writeg(o,#0'C'#$7#12);
	     for i:=1 to 29 do writeg(o,#0'C'#$7+getstring(msg[i])+#13#10);
	     repeat
	      filledrectangle(20*8,y3*16,640,y3*16+15,0);
	      writeg(o,#0'C'#$7#0'@'#0+char(y3-1)+getstring(msg[y3]));
	      setcursorxy(x3+20,y3,0);
	      if not insert then writeca(#$db,$8f,1,0)
	      else writeca(#$dd,$8f,1,0);
	      repeat
	       c:=kbreadkey;
	       if c=#0 then sc:=byte(kbreadkey) else sc:=kbscancode;
	       redraw:=1;
	       case c of
		#0:case sc of
		 $44:{F10}begin
		  s:='';
		  redraw:=255;
		  for i:=0 to 31 do begin
		   if i=rasse then begin
		    s:=s+#0'C'#$09;
		    redraw:=255;
		   end else if ((longint(1)shl i)and wmsgs[y1].rassen)=0
		   then begin
		    if redraw<>0 then begin
		     s:=s+#0'C'#$04;
		     redraw:=0;
		    end;
		   end else begin
		    if redraw<>1 then begin
		     s:=s+#0'C'#$a0;
		     redraw:=1;
		    end;
		   end;
		   s:=s+az10[i+1];
		  end;
		  setstring(msg[0],s);
		  msgoutwrite(y1,msg);
		  redraw:=3;
		 end;
		 $48:{UP}begin redraw:=2;if y3>1 then dec(y3);end;
		 $4b:{LEFT}if x3>0 then dec(x3);
		 $4d:{RIGHT}if x3<59 then inc(x3);
		 $50:{DOWN}begin redraw:=2;if y3<29 then inc(y3);end;
		 $52:insert:=not insert;
		 $53:setstring(msg[y3],deletechar(getstring(msg[y3]),x3));
		else
		 redraw:=0;
		end;
		#7:setstring(msg[y3],deletechar(getstring(msg[y3]),x3));
		#8:if x3<>0 then begin
		 setstring(msg[y3],deletechar(getstring(msg[y3]),x3-1));
		 dec(x3);
		end;
		#13:begin
		 if y3<29 then inc(y3);
		 x3:=0;
		 redraw:=2;
		end;
		#9:begin
		 setstring(msg[29],'');
		 for i:=29 downto y3+1 do msg[i]:=msg[i-1];
		 msg[y3]:=nil;
		 redraw:=2;
		end;
		'':{^q}for i:=0 to 59 do setstring(msg[y3],deletechar(getstring(msg[y3]),x3));
		'':{^y}begin
		 setstring(msg[y3],'');
		 for i:=y3 to 28 do msg[i]:=msg[i+1];
		 msg[29]:=nil;
		 redraw:=2;
		end;
		'':{^c}begin
		 window(22*8-4,2*16-4,(22+48)*8+3,4*16+3);
		 writeg(col,#0'C'#$b#12'Farbe w„hlen:'#13#10);
		 for i:=0 to 9 do writeg(col,#0'C'#$7+char(i+48)+#0'C'+char(i)+'Û ');
		 for i:=10 to 15 do writeg(col,#0'C'#$7+char(i+55)+#0'C'+char(i)+'Û ');
		 repeat
		  c:=upcase(kbreadkey);
		  if c=#0 then kbreadkey;
		 until c in ['0'..'9','A'..'F'];
		 if c<='9' then i:=byte(c)-48 else i:=byte(c)-55;
		 writeg(col,#0'@'#0#0#0'C'#$70+nstring('Hintergrund w„hlen:',48));
		 repeat
		  c:=upcase(kbreadkey);
		  if c=#0 then kbreadkey;
		 until c in ['0'..'9','A'..'F'];
		 if c<='9' then i:=i or (byte(c)-48) shl 4
		 else i:=i or (byte(c)-55) shl 4;
		 redraw:=2;
		 setstring(msg[y3],setcolor(x3,i,getstring(msg[y3])));
		end;
		'':{^x}redraw:=3;
		'',' '..#255:begin
		 if insert then begin
		  setstring(msg[y3],insertchar(getstring(msg[y3]),x3,c));
		 end else begin
		  setstring(msg[y3],setchar(getstring(msg[y3]),x3,c));
		 end;
		 if x3<59 then inc(x3);
		end;
	       else
		redraw:=0;
	       end;
	      until redraw>0;
	     until redraw>1;
	    until redraw>2;

	    clearscreen(0);
	    redraw:=2;
	   end;
	  end;
	 end;
	until redraw>0;
       until (redraw>1)and(redraw<3);
      end;
     end;
    end;
   until redraw>0;
  until redraw>1;
 until redraw>2;
 oldmenu;
end;

end.