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

interface

uses
 evbios,
 evtext,
 tstring;

type
 helpproc=procedure(s:string78);
 { Prozedur, die einen Hilfetext ausgibt.
   Diese Prozedur muß die Cursorposition,
   textattr windmin und windmax wiederherstellen. }
 daterec=record
  day,
  month:byte;
  year:integer;
 end;
 tp_bstatus=^t_bstatus;
 t_bstatus=record
  windmin,
  windmax:word;
  textattr,
  x,
  y:byte;
 end;


const
 filechars:soc=['!','#'..')','-','.','0'..':',
		'@'..'Z','\','^'..'{','}','~',#128..#255];
 textchar:soc=['§',' '..#255];
 anychar:soc=[#0..#255];
 { Mengen erlaubter Zeichen }
 NotANumber=-2147483647-1;
 { Rückgabewert GetNr bei ESC
   Achtung: Bei Zuweisung an eine Integer- Word- Shortint- oder
   Byte- Variable wird diese auf 0 gesetzt! }
 cursorsize:byte=1; { Cursorzustand, siehe Cursor }
 ESCPressed:boolean=false;
 { Beendigung der Eingabe durch ESC nach JaNein, EditStr, GetNr, EditDate }
 usehelp:boolean=false;    { Hilfebalken darstellen }
 e:array[0..9]of longint=
  (          1,
	    10,
	   100,
	  1000,
	 10000,
	100000,
       1000000,
      10000000,
     100000000,
    1000000000 );
 months:array[1..2,0..12] of string9=
  (('   ',
    'Jan',
    'Feb',
    'Mrz',
    'Apr',
    'Mai',
    'Jun',
    'Jul',
    'Aug',
    'Sep',
    'Okt',
    'Nov',
    'Dez'),
   ('         ',
    '   Januar',
    '  Februar',
    '     März',
    '    April',
    '      Mai',
    '     Juni',
    '     Juli',
    '   August',
    'September',
    '  Oktober',
    ' November',
    ' Dezember'));

function bhex(x:byte):string;
function whex(x:word):string;
function lhex(x:longint):string;
function phex(x:word):string;
{ Hex-String zu x (b:2,p:3,w:4 Stellen }

function bswap(x:word):word;
{ tauscht high/low-Bit }

function min(a,b:longint):longint;
function max(a,b:longint):longint;

function inrange(a,b,c:longint):boolean;
{<=>b>=a>=c}

procedure cursor(size:byte);
{ 0:Aus 1:_ 2:Û }

function spaces(n:byte):string;
{ n Leerzeichen }

function strings(c:char;n:byte):string;
{ n Zeichen }

function nstring(s:string;n:byte):string;
{ formatiert String auf n Zeichen }

procedure beep;
{ beep }

function digits(n:longint):byte;
{ Dezimalstellen }

function JaNein(ESCAbort:Boolean):Boolean;
{ Gibt ' [J/n] '..'Ja'/'Nein' aus und wartet auf Eingabe:
   'j',<-'=True, 'n',ESC=false
  Nur für Hilfetext:
   Ist ESCAbort=True, wird ESC = Abbruch ausgegeben,
   ansonsten ESC = Nein }

procedure writec(y,attr:byte;s:string);
{ Stringausgabe zentriert in y }

procedure writeall(s:string);
{ schreibt alle Zeichen in s auf den Bildschirm (auch #7... ) }

function getnr(preset,max:longint;col0,col1,colp,colz,coln,col3:byte;zero,
	       subzero,maxshow:boolean):longint;
{ Eingabe einer posotiven Zahl, ESC = -2147483648
  preset:Vorgabewert
   (ist subzero=false und preset<0 wird der negative
    eingegebene Wert zurückgeliefert, jedoch der
    positive wert angezeigt)
  max	:Maximalwert für positive und negative Grenzen
  col0	:Farbe (bis ...)
  col1	:Farbe ##### markiert
  colp	:Farbe ##### positiv
  colz	:Farbe ##### 0
  coln	:Farbe ##### negativ
  col3	:Farbe, mit der das Eingabefeld nach dem Ende überschrieben wird
  zero	:0 erlaubt
  subzero:negative Werte erlaubt
  maxshow:Anzeigen 'Max.:...' }

procedure editstr(x,y,max,inputsize:byte;var s:string;chars:soc;
		  col0,col1,col2,col3,col4:byte;
		  writelen,bounds,zstring:boolean;
		  dotchar:char;dotcol:byte;
		  arrcol:byte);
{ String s eingeben an x,y in Länge max
  chars		: erlaubte Zeichen
  col0		: Farbe (Länge 1-...): / (Länge -...):
  col1		: Farbe >   <
  col2		: Farbe String markiert
  col3		: Farbe String
  col4		: Farbe, mit der das Eingabefeld nach dem
		  Ende überschrieben wird
  writelen	: (Länge: 1-...) ausgeben
  bounds	: >   < ausgeben
  zstring	: leerer String erlaubt
  dotchar	: Zeichen für nicht vom String belegte Fläche
  dotcol	: Farbe    "	"    "	  "	  "	 "
  arrcol	: Farbe Pfeile }

procedure editdate(x,y:byte;var d:daterec;
		  feld1,feld2,feld3:byte;
		  longyear,subzero:boolean;
		  col0,col1,cold,colm,coly,col3:byte;
		  separator:char);
{ Editiert Datum d an x,y
  Feld_		: 0=Tag 1=Monat 2=Jahr
  longyear	: Langes Datum
  subzero	: Daten vor Christi erlaubt
  col0		: Farbe Trennzeichen
  col1		: Farbe Markierung
  cold/m/y	: Farbe Tag Monat Jahr
  col3		: Farbe, mit der das Eingabefeld nach dem
		  Ende überschrieben wird
  separator	: Trennzeichen }

function upstr(var s:string):string;
{ GROSSBUCHSTABEN }

{$ifndef unix}
procedure writedebug(s:string;sonderzeichen:byte);
{ gibt s auf zusätzlichem Mono-Monitor aus
  sonderzeichen gibt an, ob sonderzeichen
  wie #13 ausgegeben oder interpretiert werden
  0:ignorieren
  1:interpretieren
  2:ausgeben
  3:ausgeben und interpretieren

  NUR AUF SYSTEMEN MIT ZUSÄTZLICHEM MONO-MONITOR EINSETZEN!!! }
{$endif}

function w2s(w:word;n:byte;zfill,min:boolean):string;
{ wandelt w in einen String um
  n	:Anzahl stellen
  zfill	:true=führende nullen, false=führende Leerzeichen
  min	:minimale Länge benutzen (n ignorieren) }

function l2s(l:longint;n:byte;signed,zfill,min:boolean):string;
{ wandelt l in einen String um
  n	:Anzahl stellen
  zfill	:true=führende nullen, false=führende Leerzeichen
  min	:minimale Länge benutzen (n ignorieren) }

procedure standardhelp(s:string78);
{ Standard-Hilfeprozedur, gibt s invers
  in der untersten Bildschirmzeile aus }

procedure getbstatus(var p:t_bstatus);
{ sichert aktuelle Bildschirmparameter in p }

procedure setbstatus(p:t_bstatus);
{ stelli in p gesicherte Bildschirmparameter wieder her }

procedure win(b,h,col,bkcol:byte;var save:t_bstatus);
{ öffnet Fenster zentriert in Höhe h und Breite b
  mit Ramenfarbe col und Hintergrundfarbe bkcol
  Maximal 7 Fenster verschachtelt öffnen (CGA:3)
  Bildparameter werden in save gespeichert }

procedure winclose(save:t_bstatus);
{ schließt zuletzt geöffnetes Fenster
  Bildparameter werden aus save restauriert }

procedure ok;
{ Ton Bestätigung }

function upcase2(c:char):char;
{ wandelt kleinbuchstaben in GROSSBUCHSTABEN un. }

procedure setstring(var p:pstring;s:string);
{ schreibt einen String in eine PString-Variable }

function getstring(p:pstring):string;
{ schreibt einen String in eine PString-Variable }

procedure FillWord(var Dest; Count: Word;Data: Word);
{ Füllt Speicher Wortweise }

function strg(l:longint):string;
{ Umwandlung Zahl->String }

const
 help:helpproc=standardhelp; { Hilfsroutine }
 helpline:byte=25; { Zeile, in der die Hilfe ausgegeben wird }

implementation

uses kb,
{$ifndef unix}
crt,
{$else}
xcrt,
{$endif}
grafik,vbios;

const
 hex:array[0..$f]of char
  =('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');

function inrange(a,b,c:longint):boolean;
{<=>b>=a>=c}
begin
 inrange:=(a>=b)and(a<=c);
end;

function min(a,b:longint):longint;
begin
 if a>b then min:=b else min:=a;
end;

function max(a,b:longint):longint;
begin
 if a<b then max:=b else max:=a;
end;

function digits(n:longint):byte;
var
 d:byte;
begin
 d:=0;
 if n=NotANumber then digits:=1 else begin
  if n<0 then begin
   inc(d);
   n:=-n;
  end;
  if n>=100000 then begin
   inc(d,6);
   n:=n div 1000000
  end;
  if n>=100 then begin
   inc(d,3);
   n:=n div 1000
  end;
  if n>=10 then begin
   inc(d,2);
   n:=n div 100
  end;
  if n>=1 then begin
   inc(d);
  end;
 end;
 digits:=d;
end;

function nstring(s:string;n:byte):string;
begin
 if length(s)<n then nstring:=s+spaces(n-length(s))
 else nstring:=copy(s,1,n);
end;

{$ifndef unix}
function bswap(x:word):word;
assembler;
asm
 mov ax,x
 xchg ah,al
end;
{$else}
function bswap(x:word):word;
begin
	bswap:=(x shl 8) or ((x shr 8) and $ff);
end;

function hi(x:word):byte;
begin
	hi:=((x shr 8) and $ff);
end;
{$endif}

function bhex(x:byte):string;
begin
 bhex:=hex[x shr 4]+hex[x and $f];
end;

function whex(x:word):string;
begin
 whex:=bhex(hi(x))+bhex(x);
end;

function lhex(x:longint):string;
begin
 lhex:=whex(x shr 16)+whex(x);
end;

function phex(x:word):string;
var s:string;
begin
{$ifndef unix}
 s:=whex(x shl 4);
 dec(byte(s[0]));
 phex:=s;
{$else}
 s:=whex(x);
 phex:=substr(s,2);
{$endif}
end;

function strg(l:longint):string;
{ Umwandlung Zahl->String }
var
 s:string[11];
begin
 s:=l2s(l,11,true,false,true);
 while s[1]=' ' do delete(s,1,1);
 strg:=s;
end;

procedure FillWord(var Dest; Count: Word;Data: Word);
{$ifndef unix}
begin
  inline(
    $C4/$7E/<Dest/   { LES   DI,Dest[BP]  }
    $8B/$4E/<Count/  { MOV   CX,Count[BP] }
    $8B/$46/<Data/   { MOV   AX,Data[BP]  }
    $FC/             { CLD                }
    $F3/$AB);        { REP   STOSW        }
{$else}
var
	d:^aword;
	i:integer;
begin
	d:=@Dest;
	for i:=1 to count do d^[i-1]:=Data;
{$endif}
end;

function getstring(p:pstring):string;
begin
 if p=nil then getstring:='' else getstring:=p^;
end;

procedure setstring(var p:pstring;s:string);
begin
 if p<>nil then freemem(p,byte(p^[0])+1);
 if s='' then p:=nil else begin
  getmem(p,byte(s[0])+1);
  move(s,p^,byte(s[0])+1);
 end;
end;

function upcase2(c:char):char;
{$ifndef unix}
assembler;
asm
 mov al,c
 cmp al,'z'
 jnbe @no_abc
 cmp al,'a'
 jnge @change_end
 and al,$5f
 jmp @change_end
@no_abc:
 cmp al,'ü'
 jne @no_ue
 mov al,'Ü'
 jmp @change_end
@no_ue:
 cmp al,'ö'
 jne @no_oe
 mov al,'Ö'
 jmp @change_end
@no_oe:
 cmp al,'ä'
 jne @change_end
 mov al,'Ä'
@change_end:
{$else}
begin
	if c<#128 then upcase2:=upcase(c)
	else if c=#132 then upcase2:=#142
	else if c=#148 then upcase2:=#153
	else if c=#129 then upcase2:=#154
	else upcase2:=c;
{$endif}
end;

procedure ok;
begin
{$ifndef unix}
 sound(1000);
 kbdelay(250000);
 sound(2000);
 kbdelay(400000);
 nosound;
{$else}
{$endif}
end;

procedure win(b,h,col,bkcol:byte;var save:t_bstatus);
var
 x,
 y:byte;
begin
 getbstatus(save);
 x:=40-b shr 1;
 y:=12-h shr 1;
{fixme
 openwindow(singleframe,x-2,y-1,x+b+1,y+h,col,bkcol);
}
 window(x,y,x+b,y+h-1);
 textattr:=bkcol;
end;

procedure winclose(save:t_bstatus);
begin
{fixme
 closewindow;
}
 setbstatus(save);
end;

procedure getbstatus(var p:t_bstatus);
begin
 p.windmin	:=windmin;
 p.windmax	:=windmax;
 p.textattr	:=textattr;
 p.x		:=wherex;
 p.y		:=wherey;
end;

procedure setbstatus(p:t_bstatus);
begin
 windmin	:=p.windmin;
 windmax	:=p.windmax;
 textattr	:=p.textattr;
 gotoxy(p.x,p.y);
end;

procedure cursor(size:byte);
begin
 case size of
  0:setcursorsize(15,0);
  1:if isegavga or (videomode<7)
    then setcursorsize(6,7)
    else setcursorsize(11,12);
  2:if isegavga or (videomode<7)
    then setcursorsize(1,7)
    else setcursorsize(1,12);
 end;
 cursorsize:=size;
end;

function spaces(n:byte):string;
var s:string;
begin
{$ifndef unix}
 s[0]:=char(n);
{$else}
 SetLength(s,n);
{$endif}
 spaces:=s;
 fillchar(s[1],n,' ');
end;

function strings(c:char;n:byte):string;
var s:string;
begin
 fillchar(s[1],n,c);
{$ifndef unix}
 s[0]:=char(n);
{$else}
 SetLength(s,n);
{$endif}
 strings:=s;
end;

procedure beep;
begin
 while kbkeypressed do kbreadkey;
{$ifndef unix}
 asm
  mov ax,$0e07
  int $10
 end;
{$endif}
end;

function JaNein(ESCAbort:Boolean):Boolean;
var c:char;
begin
 write(' [J/n] ');
 if usehelp then begin
  if escabort then help('J oder RETURN=Ja, N=Nein, ESC=Abbruch')
  else help('J oder RETURN=Ja, N oder ESC=Nein');
 end;
 repeat
  c:=upcase2(kbreadkey);
  if c in ['J','N',#13,#27] then break else beep;
  if c=#0 then kbreadkey;
 until false;
 if c IN ['J',#13] then begin
  JaNein:=true;
  write('Ja');
 end else begin
  janein:=false;
  if escabort and (c=#27) then write('Abbruch') else write('Nein');
  if c=#27 then ESCPressed:=true;
 end;
 ESCPressed:=c=#27;
end;

procedure writec(y,attr:byte;s:string);
begin
 writex(40-(length(s)+1)shr 1, y, attr, s);
end;

procedure writeall(s:string);
var
 x,
 y,
 i:byte;
begin
 x:=wherex;
 y:=wherey;
 for i:=1 to byte(s[0]) do begin
  gotoxy(x,y);
  {$ifndef unix}
  if (mem[seg0040:$49]<4)or(mem[seg0040:$49]=7)or(mem[seg0040:$49]>$12)
  then
  {$endif}
  writeca(s[i],textattr,1,0)
  {$ifndef unix}
  else begin
   writeca(#$db,textattr shr 4,1,0);
   writeca(s[i],(textattr and $f xor textattr shr 4) or $80,1,0)
  end
  {$endif};
  inc(x);
 end;
end;

function getnr(preset,max:longint;col0,col1,colp,colz,coln,col3:byte;zero,subzero,maxshow:boolean):longint;
var
 i,j:longint;
 c:char;
 s,t:string[10];
 x,
 x0,
 y,
 d,
 pos,
 col2:byte;
 changed:boolean;
 sign:shortint;
 insert:boolean;
 len:byte;

	procedure ifgmodecursor;
	begin
		if (videomode>4)and(videomode<>7)and(videomode<$13) then begin
			if not insert
			then writeca(#$db,$8f,1,0)
			else writeca(#$dd,$8f,1,0);
		end;
	end;

begin
 max:=abs(max);
 insert:=max>9;
 if preset<0 then sign:=-1 else sign:=1;
 str(max,s);
 x0:=wherex;
 if maxshow then writes(col0,'(bis '+s+'):');
 x:=wherex+byte(subzero);
 y:=wherey;
 i:=abs(preset);
 if i>max then i:=max;
 d:=10-length(s);
 changed:=false;
 pos:=0;
 cursor(2-byte(insert));
 if usehelp then begin
  if subzero then help(#27#26'=Cursor bewegen, <ŽÙ=Bestätigen, ESC=Abbruch, - =Vorzeichenwechsel')
  else help(#27#26'=Cursor bewegen, INS=Einfügen/Überschreiben, <ŽÙ=Bestätigen, ESC=Abbruch');
 end;
 repeat
  if i=0 then col2:=colz
  else if (sign=1)or not subzero then col2:=colp
  else col2:=coln;
  if subzero then begin
   if changed then begin
    if sign>0 then writex(x-1,y,col2,'+')
    else writex(x-1,y,col2,'-');
   end else begin
    if sign>0 then writex(x-1,y,col1,'+')
    else writex(x-1,y,col1,'-');
   end;
  end;
  str(i:10,s);
  delete(s,1,d);
  if changed then writex(x,y,col2,s) else writex(x,y,col1,s);
  gotoxy(x+10-d-pos-1+byte(insert),y);
  ifgmodecursor;
  c:=kbreadkey;
  ifgmodecursor;
  case c of
   #0,#$e0:if kbscancode<>0 then case kbreadkey of
    #$4d:begin if pos>0 then dec(pos)else beep; changed:=true; end;
    #$4b:begin if pos+d<9 then inc(pos) else beep; changed:=true; end;
    #$53:if pos=0 then beep else begin
     if pos=1 then i:=i div 10 else begin
      j:=i div 10;
      i:=j-j mod e[pos-1]+i mod e[pos-1];
     end;
     dec(pos);
    end;
    #$8e:i:=max-i;
    #$47,#$48:begin pos:=9-d;changed:=true;end;
    #$4f,#$50:begin pos:=0;changed:=true;end;
    #$52:begin
     if not insert then begin
      if pos+d<>9 then inc(pos);
     end else if pos<>0 then dec(pos);
     insert:=not insert;
     cursor(2-byte(insert));
     changed:=true;
    end;
    #$0e:begin
     changed:=false;
     pos:=0;
     i:=abs(preset);
     if preset<0 then sign:=-1 else sign:=1;
    end;
   else
    beep;
   end else beep;
   '':begin if pos>0 then dec(pos) else beep; changed:=true; end;
   '':begin if pos+d<9 then inc(pos) else beep; changed:=true; end;
   '':begin
    if not insert then begin
     if pos+d<>9 then inc(pos);
    end else if pos<>0 then dec(pos);
    insert:=not insert;
    cursor(2-byte(insert));
    changed:=true;
   end;
   '':begin pos:=9-d;changed:=true;end;
   '':begin pos:=0;changed:=true;end;
   #13:if not (kbscancode in [$1c,$e0]) then beep else begin
    if zero or (i<>0) then begin
     gotoxy(x0,y);
     textattr:=col3;
     for d:=1 to length(s)+byte(maxshow)*(7+length(s))+byte(subzero) do write(' ');
     gotoxy(x0,y);
     getnr:=i*sign;
     ESCPressed:=false;
     exit;
    end else beep;
   end;
   #27:if kbscancode<>1 then beep else begin
    gotoxy(x0,y);
    textattr:=col3;
    for d:=1 to length(s)+byte(maxshow)*(7+length(s))+byte(subzero) do write(' ');
    gotoxy(x0,y);
    getnr:=-2147483647-1;
    ESCPressed:=true;
    exit;
   end;
   #$7f:if kbscancode<>$e then beep else begin
    changed:=true;
    i:=0;
    pos:=0;
    if subzero then sign:=1;
   end;
   '+':if subzero and (sign=-1) then begin
    if i>=e[pos] then begin
     dec(i,e[pos]);
     changed:=true;
    end else begin
     i:=e[pos]-i;
     sign:=-sign;
    end;
   end else if i<=max-e[pos] then begin
    inc(i,e[pos]); changed:=true
   end else beep;
   '-':if subzero then begin
    sign:=-sign;
    if not changed then begin
     i:=0;
     sign:=-1;
     changed:=true;
    end;
   end else if i>=e[pos] then begin
    dec(i,e[pos]);
    changed:=true;
   end else if subzero then begin
    i:=e[pos]-i;
    sign:=-sign;
   end else beep;
   '0'..'9':if insert then begin
    if changed then begin
     if pos=9 then begin
      if (i>e[9]-1)
      or (byte(c)-48>max div e[9])
      or ((byte(c)-48=max div e[9])and(i>max mod e[9]))
      then beep
      else i:=i mod e[9]+(byte(c)-48)*e[9];
     end else begin
      if ((i-i mod e[pos])>(max- max mod e[pos+1]) div 10)
      or ((i-i mod e[pos])=(max- max mod e[pos+1]) div 10)
      and((byte(c)-48>(max div e[pos])mod 10)
	  or (byte(c)-48=(max div e[pos])mod 10)
	  and(i mod e[pos]>max mod e[pos]))
      then beep
      else i:=(i- i mod e[pos])*10+i mod e[pos]+(byte(c)-48)*e[pos];
     end;
    end else begin { not changed }
     if max<byte(c)-48 then beep else begin
      i:=byte(c)-48;
      sign:=1;
     end;
    end;
    changed:=true;
   end else begin { not insert: }
    if changed then begin
     if pos=0 then begin
      if (i>2147483639)and(c>'7')
      or ((i div 10=max div 10)and(byte(c)-48>max mod 10))
      then beep
      else i:=i-i mod 10+byte(c)-48
     end else if pos=9 then begin
      if (byte(c)-48>max div e[9])
      or((byte(c)-48=max div e[9])and(i mod e[9]>max mod e[9]))
      then beep
      else i:=i mod e[9]+(byte(c)-48)*e[9];
     end else begin
      if(i-i mod e[pos+1]=max-max mod e[pos+1])
      and(  (byte(c)-48>(max div e[pos])mod 10)
	  or(byte(c)-48=(max div e[pos])mod 10)
	  and(i mod e[pos]>max mod e[pos]))
      then beep
      else i:=i-i mod e[pos+1]+i mod e[pos]+(byte(c)-48)*e[pos];
     end;
    end else begin { not changed }
     if max+48<byte(c) then beep else begin
      i:=byte(c)-48;
      sign:=1;
     end;
    end;
    if pos<>0 then dec(pos);
    changed:=true;
   end;
   #8:begin
    changed:=true;
    if pos=0 then i:=i div 10 else begin
     j:=i div 10;
     i:=j-j mod e[pos]+i mod e[pos];
    end;
   end;
  end;
 until false;
end;

procedure editstr(x,y,max,inputsize:byte;var s:string;chars:soc;
		  col0,col1,col2,col3,col4:byte;
		  writelen,bounds,zstring:boolean;
		  dotchar:char;dotcol:byte;
		  arrcol:byte);

const
 ftype	 =  0;
 fbeep	 =  1;
 frestore=  2;
 fhome	 =  3;
 fend	 =  4;
 fclear	 =  5;
 fleft	 =  6;
 fright	 =  7;
 fwleft	 =  8;
 fwright =  9;
 finsert = 10;
 fdelete = 11;
 fbackspace=12;
 fesc	 =$fe;
 fok	 =$ff;
var
 c:char;
 t:string;
 changed,
 ins:boolean;
 x0,
 pos,
 spos,
 func:byte;

	procedure ifgmodecursor;
	begin
		if (videomode>4)and(videomode<>7)and(videomode<$13) then begin
			if not ins
			then writeca(#$db,$8f,1,0)
			else writeca(#$dd,$8f,1,0);
		end;
	end;

begin
 if max=0 then begin
  s:='';
  exit;
 end;
 if inputsize=0 then inputsize:=1;
 if inputsize>max then inputsize:=max;
 if max>inputsize then bounds:=true;
 x0:=x;
 if writelen then begin
  writex(x,y,col0,'(Länge ');
  if not zstring then write('1-');
  write(strg(max)+'):');
  x:=wherex;
 end;
 if x+inputsize>80 then begin
  inputsize:=79-x;
  bounds:=true;
 end;
 if bounds then inc(x);
 if x+inputsize>80 then inputsize:=79-x;
 ins:=true;

 t:=s;
 changed:=false;
 pos:=length(t);
 if pos>inputsize then begin
  spos:=pos-inputsize;
  pos:=inputsize;
 end else spos:=0;

 if usehelp then help(#27#26'=Cursor bewegen, INS=Einfügen/Überschreiben, <ŽÙ=Bestätigen, ESC=Abbruch');

 repeat
  if bounds then begin
   if spos=0 then writex(x-1,y,col1,#16) else writex(x-1,y,arrcol,#27);
   if length(t)<=spos+inputsize
   then writex(x+inputsize,y,col1,#17)
   else writex(x+inputsize,y,arrcol,#26);
  end;
  writex(x,y,dotcol,strings(dotchar,inputsize));
  if changed then textattr:=col3 else textattr:=col2;
  writex(x,y,textattr,copy(t,spos+1,inputsize));
  gotoxy(x+pos,y);
  cursor(2-byte(ins));
  ifgmodecursor;
  c:=kbreadkey;
  ifgmodecursor;
  if kbscancode=0 then begin
   if c in chars then func:=ftype else func:=fbeep;
  end else if (c=#13)
	   and (kbscancode in [$e0,$1c]) then func:=fok
  else if (c=#27)and(kbscancode=1) then func:=fesc
  else case c of
   #0,#$e0:begin
    c:=kbreadkey;
    case c of
     #$0e:func:=frestore;
     #$03:if #0 in chars then begin
      c:=#0;
      func:=ftype;
     end else func:=fbeep;
     #$48,#$47:func:=fhome;
     #$50,#$4f:func:=fend;
     #$4b:func:=fleft;
     #$4d:func:=fright;
     #$73:func:=fwleft;
     #$74:func:=fwright;
     #$52:func:=finsert;
     #$53:func:=fdelete;
    else
     func:=fbeep;
    end;
   end;
   #8:if(kbscancode=$0e)or not (c in chars)
      then func:=fbackspace else func:=ftype;
   #$7f:func:=fclear;
   #$01:if c in chars then func:=ftype else func:=fwleft;
   #$13:if c in chars then func:=ftype else func:=fleft;
   #$04:if c in chars then func:=ftype else func:=fright;
   #$06:if c in chars then func:=ftype else func:=fwright;
   #$05:if c in chars then func:=ftype else func:=fhome;
   #$18:if c in chars then func:=ftype else func:=fend;
   #$07:if c in chars then func:=ftype else func:=fdelete;
   #$16:if c in chars then func:=ftype else func:=finsert;
  else
   if c in chars then func:=ftype else func:=fbeep;
  end;
  case func of
   fbeep:beep;
   fok,fesc:if (func<>fok) or zstring or (t<>'') then begin
    writex(x0,y,col4,spaces(inputsize+byte(bounds)*2+
	   byte(writelen)*(10+byte(not zstring)*2+byte(max>10)+byte(max>100))));
    gotoxy(x0,y);
    if func=fok then move(t,s,length(t)+1);
    ESCPressed:=func=fesc;
    exit;
   end else beep;
   frestore:begin
    t:=s;
    changed:=false;
    pos:=length(t);
    if pos>inputsize then begin
     spos:=pos-inputsize;
     pos:=inputsize;
    end else spos:=0;
   end;
   finsert:begin
    ins:=not ins;
    changed:=true;
   end;
   fclear:begin
    t:='';
    changed:=true;
    pos:=0;
    spos:=0;
   end;
   fend:begin
    changed:=true;
    pos:=length(t);
    if pos>inputsize then begin
     spos:=pos-inputsize;
     pos:=inputsize;
    end else spos:=0;
   end;
   fleft:begin
    changed:=true;
    if pos=0 then begin
     if spos<>0 then begin
      if spos>inputsize div 2+1 then begin
       dec(spos,inputsize div 2+1);
       pos:=inputsize div 2;
      end else begin
       pos:=spos-1;
       spos:=0;
      end;
     end else beep;
    end else dec(pos);
   end;
   fhome:begin
    changed:=true;
    pos:=0;
    spos:=0;
   end;
   fright:begin
    changed:=true;
    if pos+spos=length(t) then beep else begin
     if pos=inputsize then begin
      spos:=spos+inputsize div 2+1;
      pos:=pos-inputsize div 2;
     end else inc(pos);
    end;
    if spos+inputsize>max then begin
     spos:=max-inputsize;
     pos:=inputsize;
    end;
   end;
   fwleft:begin
    changed:=true;
    if pos+spos=0 then beep else begin
     while (pos+spos<>0)
     and (pos+spos=length(t))or not(t[pos+spos+2] in [' ','!','"','§','$','%','&','/','(',')','=','?',
			 '`','''','\','}',']','[','{','^','°','+','*','~',
			 '#',',',';','.',':','-','_','<','>','|'])
     do begin
      if pos=0 then begin
       if spos<>0 then begin
	if spos>inputsize div 2+1 then begin
	 dec(spos,inputsize div 2+1);
	 pos:=inputsize div 2;
	end else begin
	 pos:=spos-1;
	 spos:=0;
	end;
       end else break;
      end else dec(pos);
     end;
     while (pos+spos<>0)
     and(t[pos+spos+1] in [' ','!','"','§','$','%','&','/','(',')','=','?',
			 '`','''','\','}',']','[','{','^','°','+','*','~',
			 '#',',',';','.',':','-','_','<','>','|'])
     do begin
      if pos=0 then begin
       if spos<>0 then begin
	if spos>inputsize then begin
	 dec(spos,inputsize div 2+1);
	 pos:=inputsize div 2;
	end else begin
	 pos:=spos-1;
	 spos:=0;
	end;
       end;
      end else dec(pos);
     end;
     repeat
      if pos=0 then begin
       if spos<>0 then begin
	if spos>inputsize then begin
	 dec(spos,inputsize div 2+1);
	 pos:=inputsize div 2;
	end else begin
	 pos:=spos-1;
	 spos:=0;
	end;
       end;
      end else dec(pos);
     until (pos+spos=0)
       or(t[pos+spos] in [' ','!','"','§','$','%','&','/','(',')','=','?',
			    '`','''','\','}',']','[','{','^','°','+','*','~',
			    '#',',',';','.',':','-','_','<','>','|']);
    end;
   end;
   fwright:begin
    changed:=true;
    if pos+spos=length(t) then beep else begin
     while not (pos+spos<>length(t))
     and(t[pos+spos+1] in [' ','!','"','§','$','%','&','/','(',')','=','?',
			 '`','''','\','}',']','[','{','^','°','+','*','~',
			 '#',',',';','.',':','-','_','<','>','|'])
     do begin
      if pos+spos=length(t) then beep else begin
       if pos=inputsize then begin
	spos:=spos+inputsize div 2+1;
	pos:=pos-inputsize div 2;
       end else inc(pos);
      end;
     end;
     while (pos+spos<>length(t))
     and(t[pos+spos+1] in [' ','!','"','§','$','%','&','/','(',')','=','?',
			 '`','''','\','}',']','[','{','^','°','+','*','~',
			 '#',',',';','.',':','-','_','<','>','|'])
     do begin
      if pos+spos=length(t) then beep else begin
       if pos=inputsize then begin
	spos:=spos+inputsize div 2+1;
	pos:=pos-inputsize div 2;
       end else inc(pos);
      end;
     end;
     repeat
      if pos+spos<>length(t) then begin
       if pos=inputsize then begin
	spos:=spos+inputsize div 2+1;
	pos:=pos-inputsize div 2;
       end else inc(pos);
      end;
     until (pos+spos=length(t))
      or(t[pos+spos] in [' ','!','"','§','$','%','&','/','(',')','=','?',
			   '`','''','\','}',']','[','{','^','°','+','*','~',
			   '#',',',';','.',':','-','_','<','>','|']);
    end;
    if spos+inputsize>max then begin
     spos:=max-inputsize;
     pos:=inputsize;
    end;
   end;
   ftype:if changed then begin
    if (length(t)=max)and not(not ins and (pos+spos<>length(t)))
    then beep else begin
     if pos+spos=length(t) then begin
      t:=t+c;
     end else if ins then begin
      insert(c,t,pos+spos+1);
     end else begin
      t[pos+spos+1]:=c;
     end;
     if pos=inputsize then begin
      spos:=spos+inputsize div 2+1;
      pos:=pos-inputsize div 2;
     end else inc(pos);
     if spos+inputsize>max then begin
      pos:=inputsize;
      spos:=max-inputsize;
     end;
    end;
   end else begin
    t:=c;
    changed:=true;
    spos:=0;
    pos:=1;
   end;
   fdelete:if pos+spos=length(t) then beep else begin
    delete(t,pos+spos+1,1);
   end;
   fbackspace:if pos+spos=0 then beep else begin
    changed:=true;
    delete(t,pos+spos,1);
    if pos=0 then begin
     if spos<>0 then begin
      if spos>inputsize then begin
       dec(spos,inputsize div 2+1);
       pos:=inputsize div 2;
      end else begin
       pos:=spos-1;
       spos:=0;
      end;
     end else beep;
    end else dec(pos);
   end;
  end;
 until false;
end;

function upstr(var s:string):string;
{$ifndef unix}
begin
 asm
  push ds
  lds si,s
  les di,@result
  lodsb
  stosb
  xor cx,cx
  mov cl,al
  jcxz @ende
 @loop1:
  lodsb
  cmp al,'z'
  jnbe @no_abc
  cmp al,'a'
  jnge @change_end
  and al,$5f
  jmp @change_end
 @no_abc:
  cmp al,'ü'
  jne @no_ue
  mov al,'Ü'
  jmp @change_end
 @no_ue:
  cmp al,'ö'
  jne @no_oe
  mov al,'Ö'
  jmp @change_end
 @no_oe:
  cmp al,'ä'
  jne @change_end
  mov al,'Ä'
 @change_end:
  stosb
  loop @loop1
 @ende:
  pop ds
 end;
{$else}
var i:integer;
begin
	for i:=1 to length(s) do s[i]:=upcase2(s[i]);	
	upstr:=s;
{$endif}
end;

function w2s(w:word;n:byte;zfill,min:boolean):string;
{$ifdef unix}
var
	s:array[1..255] of char;
	i:integer;
{$endif}
begin
 if min then begin
  if      w>=10000 then n:=5
  else if w>= 1000 then n:=4
  else if w>=  100 then n:=3
  else if w>=   10 then n:=2
  else			n:=1;
 end;
{$ifndef unix}
 asm
  les di,@result
  xor ax,ax
  mov al,[n]
  mov cx,ax
  cld
  stosb
  jcxz @ende
  dec cx
  jcxz @nofill
  mov al,' '
  mov bl,zfill
  or bl,bl
  jz @zerofill
  mov al,'0'
 @zerofill:
  rep stosb
 @nofill:
  std
  mov ax,[w]
  mov cl,n
  mov bx,10
 @convert:
  xor dx,dx
  div bx
  push ax
  mov al,dl
  or al,$30
  stosb
  pop ax
  or ax,ax
  loopnz @convert
 @ende:
 end;
{$else}
 if(n=0) then w2s:=''
 else begin
 	if (n>1) and not min then begin
 		if zfill then s[1]:='0' else s[1]:=' ';
 		fillchar(s[2],n-1,s[1]);
 	end;
	s[n]:=char(w mod 10+$30);
	w:=w div 10;
 	i:=n-1;
 	while (w>0) and (i>0) do begin
 		s[i]:=char(w mod 10+$30);
 		w:=w div 10;
 		dec(i);
 	end;
 	w2s:=substr(s,1,n);
 end;
{$endif}
end;


function l2s(l:longint;n:byte;signed,zfill,min:boolean):string;
var
 s:string;
 z:string1;
 sign:boolean;
 n2:byte;
begin
 n2:=n;
 if l=NotANumber then begin
  l2s:=spaces(n);
  exit;
 end;
 sign:=(l<0) and signed;
 l:=abs(l);
 if (n=0) or ((n=1) and signed and (l<0)) then begin
  l2s:=spaces(n);
  exit;
 end;
 if sign then begin
  dec(n);
  dec(n2);
  z:='-';
 end else z:='';
 if n<10 then begin
  if l>=e[n] then begin
   zfill:=true;
   min:=false;
  end;
  l:=l mod e[n];
 end;
 if abs(l)<65535 then s:=w2s(l,n,true,false)
 else begin
  s:='';
  while n>=4 do begin
   s:=w2s(l mod 10000,4,true,false)+s;
   dec(n,4);
   l:=l div 10000;
  end;
  if n<>0 then s:=w2s(l,n,true,false)+s;
  while s[1]='0' do delete(s,1,1);
 end;
 while length(s)>1 do if s[1]='0' then delete(s,1,1) else break;
 if min then l2s:=z+s
 else if zfill then l2s:=z+strings('0',n2-length(s))+s
 else l2s:=spaces(n2-length(s))+z+s;
end;

{$ifndef unix}
procedure writedebug(s:string;sonderzeichen:byte);
type
 crec=record
  c:char;
  attr:byte;
 end;
const
 x:byte=0;
var
 i:byte;
 screen:array[0..24,0..79]of crec absolute $b000:$0000;

 procedure scrollup;
 var i:byte;
 begin
  move(screen[1],screen[0],sizeof(screen)-sizeof(screen[0]));
  for i:=0 to 79 do begin
   screen[24,i].c:=' ';
   screen[24,1].attr:=7;
  end;
 end;

begin
 for i:=1 to byte(s[0]) do begin
  if (sonderzeichen and 2<>0) or not (s[i] in [#7,#8,#10,#13])
  then begin
   screen[24,x].c:=s[i];
   screen[24,x].attr:=7;
  end;
  if sonderzeichen and 1=0 then begin
   inc(x);
   if x=80 then begin
    x:=0;
    scrollup;
   end;
  end else case s[i] of
   #7:beep;
   #8:if x<>0 then dec(x);
   #10:scrollup;
   #13:x:=0;
  else
   inc(x);
   if x=80 then begin
    x:=0;
    scrollup;
   end;
  end;
 end;
end;
{$endif}

procedure standardhelp(s:string78);
var
 x,
 y,
 t:byte;
 wn,wx:word;
begin
 x:=wherex;
 y:=wherey;
 t:=textattr;
 wn:=windmin;
 wx:=windmax;
 window(1,1,80,helpline);
 gotoxy(1,helpline);
 textattr:=$77;
 write(' ');
 textattr:=$70;
 write(s);
 textattr:=$77;
 clreol;
 windmin:=wn;
 windmax:=wx;
 gotoxy(x,y);
 textattr:=t;
end;

procedure editdate(x,y:byte;var d:daterec;
		  feld1,feld2,feld3:byte;
		  longyear,subzero:boolean;
		  col0,col1,cold,colm,coly,col3:byte;
		  separator:char);
		  { Feldn: 0=Day 1=Month 2=Year >2=nothing }
var
 t:daterec;
 fpos,
 pos,
 xpos,
 anz:byte;
 pos2feld:array[0..2] of byte;
 changed:array[0..2] of boolean;
 insert:boolean;
 sign:shortint;
 i,j:word;
 c:char;
begin
 anz:=0;
 if feld1<3 then begin
  pos2feld[anz]:=feld1;
  inc(anz);
 end;
 if feld2<3 then begin
  pos2feld[anz]:=feld2;
  inc(anz);
 end;
 if feld3<3 then begin
  pos2feld[anz]:=feld3;
  inc(anz);
 end;
 if anz=0 then exit;
 t:=d;
 fpos:=0;
 pos:=0;
 fillchar(changed,sizeof(changed),false);
 insert:=true;
 if t.year>0 then sign:=1 else sign:=-1;
 t.year:=abs(t.year);

 with t do repeat
  cursor(2-byte(insert));
  gotoxy(x,y);
  for i:=0 to anz-1 do begin
   case pos2feld[i] of
    0:begin
     if not changed[i] then textattr:=col1 else textattr:=cold;
     write(w2s(day,2,true,false));
     if fpos=i then xpos:=wherex;
    end;
    1:begin
     if not changed[i] then textattr:=col1 else textattr:=colm;
     write(w2s(month,2,true,false));
     if fpos=i then xpos:=wherex;
    end;
    2:begin
     if not changed[i] then textattr:=col1 else textattr:=coly;
     write(w2s(abs(year),2+byte(longyear)*2,true,false));
     if fpos=i then xpos:=wherex;
     if longyear and subzero then
      if sign<0 then write(' vC') else write(' nC');
    end;
   end;
   if i<>anz-1 then begin
    textattr:=col0;
    write(separator);
   end;
  end;
  if usehelp then if longyear and subzero and (pos2feld[fpos]=2)
  then help(#27#26'=Cursor bewegen "." "," TAB=Eingabefeld wechseln - = vC/nC')
  else help(#27#26'=Cursor bewegen "." "," TAB=Eingabefeld wechseln');
  gotoxy(xpos-pos,y);
  c:=kbreadkey;
  case c of
   #0,#$e0:if kbscancode=0 then beep else case kbreadkey of
    #$48,#$47:begin
     if (pos2feld[fpos]=2) and longyear then pos:=3 else pos:=1;
     changed[fpos]:=true;
    end;
    #$50,#$4f:begin
     pos:=0;
     changed[fpos]:=true;
    end;
    #$4b:begin
     if (pos=0) or ((pos2feld[fpos]=2) and longyear and (pos<3))
     then inc(pos) else beep;
     changed[fpos]:=true;
    end;
    #$4d:begin
     if pos<>0 then dec(pos);
     changed[fpos]:=true;
    end;
    #$52:begin
     insert:=not insert;
     changed[fpos]:=true;
    end;
    #$53:if pos<>0 then case pos2feld[fpos] of
     0:begin
      day:=day div 10;
      pos:=0;
     end;
     1:begin
      month:=month div 10;
      pos:=0;
     end;
     2:begin
      year:=(year-year mod e[pos])div 10+year mod e[pos-1];
      dec(pos);
     end;
    else
     beep;
    end else begin
     beep;
     changed[fpos]:=true;
    end;
    #$0e:begin
     t:=d;
     fpos:=0;
     pos:=0;
     fillchar(changed,sizeof(changed),false);
    end;
   else
    beep;
   end;
   '','
':begin
    if (pos2feld[fpos]=2) and longyear then pos:=3 else pos:=1;
    changed[fpos]:=true;
   end;
   '','':begin
    pos:=0;
    changed[fpos]:=true;
   end;
   '':begin
    if (pos=0) or ((pos2feld[fpos]=2) and longyear and (pos<3))
    then inc(pos) else beep;
    changed[fpos]:=true;
   end;
   '':begin
    if pos<>0 then dec(pos);
    changed[fpos]:=true;
   end;
   '':begin
    insert:=not insert;
    changed[fpos]:=true;
   end;
   '':if pos<>0 then case pos2feld[fpos] of
    0:begin
     day:=day div 10;
     pos:=0;
    end;
    1:begin
     month:=month div 10;
     pos:=0;
    end;
    2:begin
     year:=(year-year mod e[pos])div 10+year mod e[pos-1];
     dec(pos);
    end;
   else
    beep;
   end else begin
    beep;
    changed[fpos]:=true;
   end;

   #9,',','.',' ':fpos:=(fpos+1) mod anz;
   #15:if kbscancode<>$f then beep
       else if fpos=0 then fpos:=anz-1 else dec(fpos);
   #13:if not(kbscancode in [$1c,$e0])
       or (day=0) or (month=0) then beep else begin
    year:=year*sign;
    d:=t;
    gotoxy(x,y);
    textattr:=col3;
    write(spaces(anz*3-1+byte((feld1=2) and longyear)*2
    +byte((feld1=2) and subzero)*3
    +byte((feld2=2) and longyear)*2
    +byte((feld2=2) and subzero)*3
    +byte((feld3=2) and longyear)*2
    +byte((feld3=2) and subzero)*3));
    ESCPressed:=false;
    exit;
   end;
   #27:if kbscancode<>1 then beep else begin
    gotoxy(x,y);
    textattr:=col3;
    write(spaces(anz*3-1+byte((feld1=2) and longyear)*2
    +byte((feld1=2) and subzero)*3
    +byte((feld2=2) and longyear)*2
    +byte((feld2=2) and subzero)*3
    +byte((feld3=2) and longyear)*2
    +byte((feld3=2) and subzero)*3));
    ESCPressed:=true;
    exit;
   end;
   '0'..'9':if changed[fpos] then case pos2feld[fpos] of
    0:if pos=1 then begin
     if c>'3' then begin
      beep
     end else begin
      if insert then begin
       if (day>9)or(day>1)and(c='3') then beep else day:=day+(byte(c)-48)*10;
      end else begin
       if (c<'3')or(day mod 10<2)then begin
	day:=day mod 10+(byte(c)-48)*10;
	pos:=0;
       end else beep;
      end;
     end
    end else if insert then begin
     if (day<3)or(day=3)and(c<='1') then day:=day*10+byte(c)-48 else beep;
    end else begin
     if(day<30)or(c<='1')then day:=day-day mod 10+byte(c)-48 else beep;
    end;
    1:if pos=1 then begin
     if c>'1' then beep else begin
      if insert then begin
       if (month>9)or(month>2)and(c='1') then beep
       else month:=month+(byte(c)-48)*10
      end else begin
       if (c<>'0')then begin
	if (month mod 10<3)then begin
	 month:=month mod 10+(byte(c)-48)*10;
	 pos:=0;
	end else beep;
       end else begin
	month:=month mod 10;
	pos:=0;
       end;
      end;
     end
    end else if insert then begin
     if (month<1)or(month=1)and(c<='2')
     then month:=month*10+byte(c)-48
     else beep;
    end else begin
     if(month<10)or(c<='2')
     then month:=month-month mod 10+byte(c)-48
     else beep;
    end;
    2:if longyear then begin
     if insert then begin
      j:=(year-year mod e[pos])*10+year mod e[pos]+(byte(c)-48)*e[pos];
      if j<9999 then year:=j else beep;
     end else begin
      year:=year+integer(byte(c)-48-(year div e[pos])mod 10)*e[pos];
      if pos<>0 then dec(pos);
     end;
    end else begin
     if pos=1 then begin
      if insert then begin
       if (year>9) then beep
       else year:=year-year mod 10+(byte(c)-48)*10
      end else begin
       year:=year mod 10+(byte(c)-48)*10;
       pos:=0;
      end;
     end else if insert then begin
      if year<10 then year:=year*10+byte(c)-48 else beep;
     end else year:=year-year mod 10+byte(c)-48;
    end;
   end else case pos2feld[fpos] of
    0:begin
     day:=byte(c)-48;
     changed[fpos]:=true;
    end;
    1:begin
     month:=byte(c)-48;
     changed[fpos]:=true;
    end;
    2:begin
     year:=byte(c)-48;
     changed[fpos]:=true;
    end;
   end;
   #8:case pos2feld[fpos] of
    0:begin
     changed[fpos]:=true;
     if pos=1 then day:=day mod 10 else day:=day div 10;
    end;
    1:begin
     changed[fpos]:=true;
     if pos=1 then month:=month mod 10 else month:=month div 10;
    end;
    2:begin
     changed[fpos]:=true;
     year:=(year div e[pos+1])*e[pos]+year mod e[pos];
    end;
   end;
   '-':if subzero and longyear and (pos2feld[fpos]=2) then sign:=-sign
       else beep;
  else
   if c=separator then fpos:=(fpos+1) mod anz else beep;
  end;
 until false;
end;

begin
 cursor(1);
end.