Program STROM_Seznam;
uses Crt;

type    TKlic = Word;
     THodnota = string;
     StromPtr = ^Strom;
        Strom = record
                 Levy, Pravy : StromPtr;
                 Klic : TKlic;
                 Hodnota : THodnota;
                end;

var     Koren : StromPtr;

Procedure Init;
begin
 Koren:=nil;
end;

Procedure ZrusStrom(var T : StromPtr);
begin
 If T <> nil then
  begin
   If T^.Levy <> nil then ZrusStrom(T^.Levy);
   If T^.Pravy <> nil then ZrusStrom(T^.Pravy);
   If (T^.Levy = nil) AND (T^.Pravy = nil) then
    begin
     Dispose(T);
     T:=nil;
    end;
  end;
end;

Function Vyska(S : StromPtr) : Integer;
var Vl, Vp : Integer;
begin
 If S = nil then Vyska:=0
  else
   begin
    Vl:=Vyska(S^.Levy);
    Vp:=Vyska(S^.Pravy);
    If Vp > Vl then Vyska:=Vp+1 else Vyska:=Vl+1;
   end;
end;

Function Vyvazenost(S : StromPtr) : Integer;
begin
 Vyvazenost := Vyska(S^.Pravy) - Vyska(S^.Levy);
end;

Procedure RotaceL(var S : StromPtr);
var T : StromPtr;
begin
 T:=S;
 S:=S^.Pravy;
 T^.Pravy:=T^.Levy;
 T^.Levy:=T;
end;

Procedure RotaceP(var S : StromPtr);
var T : StromPtr;
begin
 T:=S;
 S:=S^.Levy;
 T^.Levy:=T^.Pravy;
 T^.Pravy:=T;
end;

Procedure KoukniDal2(var S, Svl : StromPtr);
begin
 If S = nil then
  begin
   S:=Svl;
  end else
  begin
   If Svl^.Klic > S^.Klic then KoukniDal2(S^.Pravy, Svl);
   If Svl^.Klic < S^.Klic then KoukniDal2(S^.Levy, Svl);
  end;
end;

Procedure Vymen(var K, S : StromPtr; kt : ShortInt);
var Temp : StromPtr;
begin
 Temp:=K;
 K:=S;
 If Kt=1 then Temp^.Pravy:=nil;
 If Kt=-1 then Temp^.Levy:=nil;
 {Znova zaradit TEMP do seznamu}
 KoukniDal2(K,Temp);
end;

Procedure VyvazStrom(var S : StromPtr);
begin
 If Abs(Vyvazenost(S)) > 1 then {VyskaPravy-VyskaLevy}
  begin {Tady je to cele spatne}
   If Vyvazenost(S) > 1 then Vymen(S,S^.Pravy,1); {Pravy > Levy}
   If Vyvazenost(S) < -1 then Vymen(S,S^.Levy,-1); {Levy > Pravy}
{   VyvazStrom(S^.Levy);}
{   VyvazStrom(S^.Pravy);}
(*
   If Vyvazenost(S) > 1 then RotaceL(S); {Pravy > Levy}
   If Vyvazenost(S) < -1 then RotaceP(S); {Levy > Pravy}
*)
  end;
end;

Function Najdi(S : StromPtr; Klic : TKlic) : StromPtr;
var T : StromPtr;
begin
 T:=S;
 While (T <> nil) AND (T^.Klic <> Klic) do
  begin
   If Klic > T^.Klic then T:=T^.Pravy;
   If Klic < T^.Klic then T:=T^.Levy;
  end;
 Najdi:=T;
end;

Procedure KoukniDal(var S : StromPtr; const Klic : TKlic; Hodnota : THodnota);
begin
 If S = nil then
  begin
   New(S);
   S^.Klic:=Klic;
   S^.Hodnota:=Hodnota;
   S^.Levy:=nil;
   S^.Pravy:=nil;
  end else
  begin
   If Klic > S^.Klic then KoukniDal(S^.Pravy, Klic, Hodnota);
   If Klic < S^.Klic then KoukniDal(S^.Levy, Klic, Hodnota);
  end;
end;

Procedure VypisStrom(S : StromPtr; X : Byte; var Y : Byte; Ch : Char);
var Ym, P : Byte;
begin
 Ym:=Y;
 If S <> nil then
  begin
   GotoXY(X,Y); Write(Ch);
   If Abs(Vyvazenost(S)) <= 1 then TextBackGround(2) else TextBackGround(4);
   TextColor(14);
   Write(S^.Klic:5);
   TextBackGround(0); TextColor(7);
   VypisStrom(S^.Pravy,X+6,Y,'Â');
   For P:=Ym+1 to Y do begin GotoXY(X+6,P); Write('³'); end; Y:=Y+1;
   VypisStrom(S^.Levy,X+6,Y,'À');
  end
  else
   begin
    GotoXY(X,Y); Write(Ch);
    TextBackGround(0); TextColor(15);
    Write(' nil ');
    TextBackGround(0); TextColor(7);
   end;
WriteLn;
end;

var Y:Byte;
    OrigMode:Integer;
    Dotaz:string;
    NovyKlic:TKlic;
    Code:Integer;
begin
 Init;
 ClrScr;
 OrigMode:=LastMode;
 TextMode(C80 + Font8x8);
 Repeat
  ClrScr; Y:=1;
  VypisStrom(Koren,1,Y,'Ä');
  ReadLn(Dotaz);
  Val(Dotaz,NovyKlic,Code);
  KoukniDal(Koren,NovyKlic,'nic');
 Until (Dotaz = 'K')OR(Dotaz = 'k');
 ZrusStrom(Koren);
 TextMode(OrigMode);
end.