program test;
{$r-,s-}
{$M 2000,0,0}

uses dos,crt,maus;

var intvec8,intvec9,intvec28    :pointer;
    idstring                    :^byte;
    active,mouseon              :boolean;
    turbosp,turboss,oldss,oldsp :word;
    i                           :integer;
    a,b                         :byte;
    taste                       :byte;

function vecs_changed: boolean;forward;

procedure totalexec(s:string);

var t_a,z,l:byte;

begin
  l:=length(s);
  t_a:=mem[$0040:$0080];
  mem[$0040:$001a]:=t_a;
  mem[$0040:$001c]:=t_a;
  z:=0;
  while z<l do begin
    mem[$0040:t_a+(2*z)]:=ord(s[z+1]);
    inc(z);
  end;
  if l>0 then begin
    mem[$0040:t_a+(2*z)]:=13;
    mem[$0040:$001c]:=t_a+(2*z)+2;
  end;
end;

PROCEDURE SetCursor(x, y: Byte);

VAR R: Registers;

BEGIN
  R.AH := 2;
  R.DH := y;
  R.DL := x;
  R.BH := 0;
  Intr($10,R);
END;

PROCEDURE getCursor(var x, y:byte);

VAR R: Registers;

BEGIN
  R.AH := 3;
  R.BH := 0;
  Intr($10,R);
  y:=R.DH;
  x:=R.DL;
END;

function getstringatmouse:string;

var ad   :integer;
    s    :string;
    b1,b2:boolean;

begin
  ad:=mousey div 8*160+mousex div 8*2;
  s:='';
  while mem[$b800:ad]<>32 do begin
    s:=s+chr(mem[$b800:ad]);
    inc(ad,2);
  end;
  ad:=mousey div 8*160+mousex div 8*2-2;
  while (ad mod 160<157) and (ad>=0) and (mem[$b800:ad]<>32) do begin
    s:=chr(mem[$b800:ad])+s;
    dec(ad,2);
  end;
  ad:=1;
  b1:=false;
  b2:=false;
  while ad<=length(s) do
    if s[ad] in ['[','<'] then begin
      if s[ad]='[' then b1:=true;
      if s[ad]='<' then b2:=true;
      delete(s,ad,1);
    end
    else if s[ad] in [']','>'] then begin
      if (s[ad]=']') and b1 then delete(s,ad,1);
      if (s[ad]='>') and b2 then delete(s,ad,1);
      if ((s[ad]=']') and not b1) or ((s[ad]='>') and not b2) then begin
        delete(s,1,ad);
        ad:=1;
      end;
      b1:=false;
      b2:=false;
    end else
      inc(ad);
  getstringatmouse:=s;
end;

procedure reset_vecs;

begin
  setintvec($08,intvec8);
  setintvec($09,intvec9);
  setintvec($28,intvec28);
end;

procedure re_alloc_mem;

var r: registers;

begin
  with r do begin
    ax:=$4900;
    es:=word(ptr(prefixseg,$2c)^);
    intr($21,r);
    ax:=$4900;
    es:=prefixseg;
    intr($21,r);
  end;
end;

procedure action;

var command:string[15];

begin
  if mouseon then mousehide;
  mouseon:=true;
  command:=getstringatmouse;
  if (button=2) and (command<>'') then command:='cd '+command;
  if command='UNLOAD' then begin
    if vecs_changed then begin
      writeln('Ein Entfernen des Programms ist unm”glich, da einer oder mehrere');
      writeln('Vektoren nicht mehr direkt auf das Programm zeigen !');
      writeln('Andere TSRs entfernen und erneut probieren !');
    end else begin
      reset_vecs;
      re_alloc_mem;
    end;
  end else if command<>'' then totalexec(command);
  mousestatus;
  getmousestatus;
  i:=0;
  delay(150);
  mouseon:=false;
end;

procedure screenwork;

begin
  if mouseon then mousehide;
  getcursor(a,b);
  setcursor(65,0);
  write('ÚÄÄÄÄÄÄÄÄÄ¿');
  setcursor(65,1);
  write('³ DIR     ³');
  setcursor(65,2);
  write('³ DIR/w   ³');
  setcursor(65,3);
  write('³ DIR/p   ³');
  setcursor(65,4);
  write('³ DIR/p/w ³');
  setcursor(65,5);
  write('³ CD..    ³');
  setcursor(65,6);
  write('³ UNLOAD  ³');
  setcursor(65,7);
  write('ÀÄÄÄÄÄÄÄÄÄÙ');
  setcursor(a,b);
  mouseshow;
  mousestatus;
  mouseon:=true;
end;

procedure int8;interrupt;

begin
  inline($9c/$ff/$1e/intvec8);
  if (not active) then begin
    getmousestatus;
    if i mod 15=0 then screenwork;
    inc(i);
    if button<>0 then begin
      asm
        cli
        mov oldss,ss
        mov oldsp,sp
        mov ss,turboss
        mov sp,turbosp
        sti
      end;
      active:=true;
      action;
      asm
        cli
        mov ss,oldss
        mov sp,oldsp
      end;
    end;
  end;
end;

procedure int9;interrupt;

begin
  asm
  in al,60h
  mov taste,al
  end;
  if taste=$1C then begin
    if mouseon then mousehide;
    mouseon:=false;
    active:=true;
  end;
  inline($9c/$ff/$1e/intvec9);
end;

procedure int28;interrupt;

begin
  if active and not mouseon then begin
    getcursor(a,b);
    i:=b*160+a*2-2;
    while (i mod 160<157) and (i>=0) and (active=true) do
      if mem[$b800:i]=62 then begin
          active:=false;
        end else dec(i,2);
  end;
  inline($9c/$ff/$1e/intvec28);
end;

function vecs_changed: boolean;

const ints: array[1..3] of byte=($08,$09,$28);

var akt_seg: word;
    int_no: byte;
    newints_feld: array[1..3] of word;

begin
  newints_feld[1]:=seg(int8);
  newints_feld[2]:=seg(int9);
  newints_feld[3]:=seg(int28);
  vecs_changed:=false;
  for i:=1 to 3 do begin
    int_no:=ints[i];
    asm
      mov al,int_no
      mov ah,35h
      int 21h
      mov akt_seg,es
    end;
    if akt_seg<>newints_feld[i] then vecs_changed:=true;
  end;
end;

procedure instid(n:string);

begin
  getmem(idstring,length(n)+1);
  while ofs(idstring^) mod 16<>0 do getmem(idstring,1);
  move(n[0], idstring^, length(n)+1);
end;

function findit(n:string):boolean;

var sptr:^string;

begin
  sptr:=ptr(0,0);
  while (sptr^<>n) and (seg(sptr^)<prefixseg) do
    sptr:=ptr(succ(seg(sptr^)),0);
  if sptr^=n then findit:=true
    else findit:=false;
end;

procedure init;

begin
  active:=false;
  mouseon:=false;
  getintvec($8,intvec8);
  setintvec($8,@int8);
  getintvec($9,intvec9);
  setintvec($9,@int9);
  getintvec($28,intvec28);
  setintvec($28,@int28);
  mouseinit;
  mouseshow;
  instid('ksoft');
  i:=0;
end;


begin
  if not findit('ksoft') then begin
    writeln('DOS-TOOL V1.0 IST INSTALLIERT. (C)1998 Holger Flechsig, Jens Koopmann');
    init;
    turboss:=sseg;
    turbosp:=sptr;
    keep(0);
  end
  else writeln('Programm ist schon im Speicher!');
end.