program drzewo;
  
  
  var num: integer;
  var op: boolean;
  var korzen: node;
  
    
  unit  sc : procedure(row, column : integer);
    var c,d,e,f  : char,
        i,j : integer;
  begin
    i := row div 10;
    j := row mod 10;
    c := chr(48+i);
    d := chr(48+j);
    i := column div 10;
    j := column mod 10;
    e := chr(48+i);
    f := chr(48+j);
    write( chr(27), "[", c, d, ";", e, f, "H")
  end sc;

  unit inchar : IIUWgraph function : integer;
    (*podaj nr znaku przeslanego z klawiatury *)
    var i : integer;
  begin
    do
      i := inkey;
      if i <> 0 then exit fi;
    od;
    result := i;
  end inchar;

  unit node: class (e: integer);
    var left, right: node
  end node;
  
  unit search: class (inout gdzie: node, co: integer);
    var pom: node, pom2: node;
    var czyjest: boolean
  begin
    pom:=gdzie;
    while pom=/=none 
    do
      if pom.e=co
      then exit
      fi;
      pom2:=pom;
      if pom.e>co
      then pom:=pom.left
      else pom:=pom.right
      fi
    od;
    if pom=/=none
    then czyjest:=true
    fi
  end search;
  
  unit np : procedure;
  begin
    write( chr(27), "[2J")
  end np;
        
  unit cll: procedure (k: integer);
    unit EraseLine : procedure;
      begin
        write( chr(27), "[K")
    end EraseLine;
  begin
    call sc(k,1);
    call EraseLine
  end cll;
  
  unit ramka: procedure (w1, w2, w3, k1, k2: integer);
    var i: integer;
  begin
    call sc(w1,k1);
    write ("Ú");
    for i:=k1+1 to k2-1
    do
      write ("Ä")
    od;
    write ("¿");
    for i:=w1+1 to w3-1
    do
      call sc(i,k1);
      write ("³");
      call sc(i,k2);
      write ("³")
    od;
    if w2 > 0
    then
      call sc(w2,k1);
      write ("Ã");
      for i:=k1+1 to k2-1
      do
        write ("Ä")
      od;
      write ("´")
    fi;
    call sc (w3,k1);
    write ("À");
    for i:=k1+1 to k2-1
    do write ("Ä") od;
    write ("Ù")
  end ramka;
  
  unit menu: procedure;
  begin
    call np;
    call ramka (1,5,21,10,70);
    call sc(3,33);
    write ("M   E   N   U");
    call sc(7,15);
    write ("1.   Wstawienie elementu do drzewa");
    call sc(9,15);
    write ("2.   Usuniecie elementu z drzewa");
    call sc(11,15);
    write ("3.   Sprawdzenie, czy element jest w drzewie");
    call sc(13,15);
    write ("4.   Sprawdzenie, czy drzewo jest puste");
    call sc(15,15);
    write ("5.   Drukowanie drzewa w postaci grafu");
    call sc(17,15);
    write ("6.   Drukowanie drzewa w postaci listy elementow");
    call sc(19,15);
    write ("7.   Wyjscie")
  end menu;
  
  unit wprowliczbe: procedure (output liczba: integer, jest: boolean);
    var znak: char;
    var minus,l: boolean;
    var t, k: integer;
    var m,z: char;
    
    unit cyfra: function (z: char): boolean;
    begin
      if ord(z) >= ord('0') and ord(z) <= ord('9')
      then result:=true
      fi
    end cyfra;
    
    unit alarm: procedure;
    begin
      writeln;
      write ("To nie jest liczba calkowita");
      call beep
    end alarm;
  
  begin
    t:=0;
    z:='0';
    k:=inchar;
    znak:=chr(k);
    m:='-';
    if znak=m
    then
      minus:=true;
      write ("-")
    else
      if not cyfra(znak)         
      then 
        call alarm;
        return
      else
        write (znak); 
        t:=t+ord(znak)-ord(z);
        l:=true
      fi
    fi;
    do
      k:=inchar;
      if k=013     (*  enter  *)
      then 
        jest:=l;
	if minus
	then
	  liczba:=-t
	else
          liczba:=t;
	fi;
        exit
      else
        if not cyfra (chr(k))
        then 
          call alarm;
          return
        else
          write (chr(k));
          l:=true;
          t:=10*t+k-ord('0');
        fi
      fi
    od
  end wprowliczbe;
  
  unit podkresl: procedure (k1, k2, opcja: integer, czym: char);
    var i, j, co: integer;
  begin
    co:=5+2*opcja;
    for i:=co-1 step 2 to co+1 
    do
      call sc(i,k1+1);
      for j:=k1+1 to k2-1
      do
        write (czym)
      od
    od
  end podkresl;
  
  unit robzsearch: procedure (r: integer);
    var elem: integer;
    var licz: boolean;
    
    unit insert: search procedure;
      var nowy: node;
    begin
      if not czyjest
      then
        nowy:=new node(co);
        if gdzie=none
        then
          gdzie:=nowy
        else
          if pom2.e>co
          then pom2.left:=nowy
          else pom2.right:=nowy
          fi
        fi
      fi
    end insert;
    
    unit delete: search procedure;
      var p1, p2: node;
      
      unit przestaw: procedure (naco: node);
      begin
        if pom=gdzie
	then     (*  usuwamy korzen  *)
	  gdzie:=naco
	else
          if pom2.left=pom
          then pom2.left:=naco
          else pom2.right:=naco
          fi
	fi
      end przestaw;
      
    begin
      if czyjest 
      then
        if pom.left=none
        then 
          call przestaw (pom.right)
        else
          if pom.right=none
          then
            call przestaw (pom.left)
          else     (*  usuwany wezel ma dwoch synow  *)
            if pom.right.left=none
            then
              call przestaw(pom.right);
              pom.right.left:=pom.left
            else
              p1:=pom.right;
              p2:=p1.left;
              while p2.left=/=none
              do
                p1:=p1.left;
                p2:=p2.left
              od;
              p1.left:=p2.right;
              p2.left:=pom.left;
              p2.right:=pom.right;
              call przestaw (p2)
            fi
          fi
        fi
      fi
    end delete;
    
    unit member: search procedure;
      var kon: integer;
    begin
      call cll(24);
      if czyjest
      then
        write ("Ten element jest w drzewie     ")
      else
        write ("Tego elementu nie ma w drzewie     ") 
      fi;
      kon:=inchar
    end member;
    
  begin     (*  robzsearch  *)
    call cll(24);
    write ("Podaj element     ");
    call wprowliczbe (elem,licz);
    if not licz
    then
      return
    else
      case r
        when 1 : call insert (korzen,elem);
        when 2 : call delete (korzen,elem);
        when 3 : call member (korzen,elem)
      esac
    fi
  end robzsearch;
  
  unit empty: procedure (k: node);
    var kon: integer;
  begin
    call cll(24);
    if k=none
    then
      write ("Drzewo jest puste     ")
    else
      write ("Drzewo nie jest puste     ")
    fi;
    kon:=inchar
  end empty;
  
  unit drukuj: procedure;
    var s: char;
    var g, ko: integer;
    var h: boolean;
    var x: search;
    
    unit druk: procedure (kor: node);
      var kondruk: boolean;
      
      unit dlugi: function (k: node): boolean;
      begin
        if k=/=none
        then
          result:=k.e>99 or k.e<-9 or dlugi(k.left) or dlugi(k.right)
        fi
      end dlugi;
      
      unit krotkidruk: procedure (wiersz, pocz, kon: integer; drzewo: node);
        var y, i, z: integer;
      begin
        z:= (kon+pocz-1) div 2;
	call ramka (wiersz, 0, wiersz+2, z-1, z+2);
	if wiersz=/=1
	then
	  call sc(wiersz,z);
	  write ("Á")
	fi;
        call sc(wiersz+1,z);
        write (drzewo.e:2);
        if drzewo.left=/=none
        then 
          if wiersz=21
          then kondruk:=true
          else      (*  drukowanie lewego poddrzewa  *)
            y:= (z+pocz-1) div 2;
            call sc (wiersz+4,y);
            write ("Ú");
            for i:=y+1 to z-1
            do
              write ("Ä")
            od;
            write ("Ù");
            call sc(wiersz+3,z);
            write ("³");
	    call sc(wiersz+2,z);
	    write ("Â");
            call krotkidruk (wiersz+5,pocz,z,drzewo.left)
          fi
        fi;
        if drzewo.right=/=none
        then
          if wiersz=21
          then kondruk:=true
          else     (*  drukowanie prawego poddrzewa  *)
            y:= (kon+z) div 2;
	    call sc(wiersz+2,z+1);
	    write ("Â");
            call sc(wiersz+3,z+1);
            write ("³");
            call sc(wiersz+4,z+1);
            write ("À");
            for i:=z+2 to y-1
            do
              write ("Ä")
            od;
            write ("¿");
            call krotkidruk (wiersz+5,z+1,kon,drzewo.right)
          fi
        fi
      end krotkidruk;
      
      unit dlugidruk: procedure (wiersz, pocz, kon: integer, drzewo: node);
        var y, i, z: integer;
      begin
        z:= (kon+pocz-1) div 2;
	call ramka (wiersz, 0, wiersz+2, z-4,  z+4);
	if wiersz=/=1
	then
	  call sc(wiersz,z);
	  write ("Á")
	fi;
	call sc(wiersz+1,z-3);
        write (drzewo.e:7);
        if drzewo.left=/=none
        then
          if wiersz=19
          then 
            kondruk:=true
          else     (*  drukowanie lewego poddrzewa  *)
            y:= (z+pocz-1) div 2;
            call sc(wiersz+5,y);
            write ("³");
            call sc(wiersz+4,y);
            write ("Ú");
            for i:=y+1 to z-3
            do
              write ("Ä")
            od;
            write ("Ù");
            call sc(wiersz+3,z-2);
            write ("³");
	    call sc(wiersz+2,z-2);
	    write ("Â");
            call dlugidruk (wiersz+6, pocz, z, drzewo.left)
          fi
        fi;
        if drzewo.right=/=none
        then
          if wiersz=19
          then
            kondruk:=true
          else     (*  drukowanie prawego poddrzewa  *)
            y:= (kon+z) div 2;
	    call sc (wiersz+2,z+2);
	    write  ("Â");
            call sc(wiersz+3,z+2);
            write ("³");
            call sc(wiersz+4,z+2);
            write ("À");
            for i:=z+3 to y-1
            do
              write ("Ä")
            od;
            write ("¿");
            call sc(wiersz+5,y);
            write ("³");
            call dlugidruk (wiersz+6, z+1, kon, drzewo.right)
          fi
        fi
      end dlugidruk;
      
    begin     (*  druk  *)
      call np;
      if dlugi (kor)
      then
        call dlugidruk(1,1,80,kor)
      else
        call krotkidruk(1,1,80,kor)
      fi;
      if kondruk
      then
        call sc(25,1);
        write ("Dalsza czesc drzewa nie miesci sie na ekranie     ");
      fi
    end druk;
    
  begin     (*  drukuj  *)
    call cll(24);
    if korzen=none
    then
      write ("Drzewo jest puste")
    else
      write ("Czy chcesz obejrzec drzewo od korzenia ?");
      ko:=inchar;
      s:=chr(ko);
      if s=/='n'
      then
        call druk (korzen)
      else
        call cll(24);
        write ("Podaj korzen poddrzewa, ktore chcesz obejrzec     ");
        call wprowliczbe (g,h);
        if not h 
        then
          return
        else
          x:=new search (korzen,g);
          if not x.czyjest
          then
            call cll(24);
            write ("Tego elementu nie ma w drzewie     ");
            kill (x)
          else
            call druk (x.pom);
            kill (x)
          fi
        fi
      fi
    fi;
    ko:=inchar
  end drukuj;
  
  unit fix: procedure (k: node);
    var n, kon: integer;
    var f: boolean;
    
    unit prefix: procedure (d: node);
    begin
      if d=/=none
      then
        write (d.e);
        write ("  ,  ");
        call prefix (d.left);
        call prefix (d.right)
      fi
    end prefix;
    
    unit infix: procedure (d: node);
    begin
      if d=/=none
      then
        call infix (d.left);
        write (d.e);
        write ("  ,  ");
        call infix (d.right)
      fi
    end infix;
    
    unit postfix: procedure (d: node);
    begin
      if d=/=none
      then
        call postfix (d.left);
        call postfix (d.right);
        write (d.e);
        write ("  ,  ")
      fi
    end postfix;
    
  begin     (*  fix  *)
    if k=none
    then
      writeln;
      write ("Drzewo jest puste")
    else
      call np;
      call ramka (1,5,13,30,49);
      call sc(3,35);
      write ("M  E  N  U");
      call sc(7,33);
      write ("1.  prefix");
      call sc(9,33);
      write ("2.  infix");
      call sc(11,33);
      write ("3.  postfix");
      call sc(24,1);
      write ("Podaj numer opcji     ");
      call wprowliczbe (n,f);
      if f andif (n >= 1 and n <= 3)
      then
        call podkresl (30,49,n,'.');
        call cll(24);
        call sc(17,1);
        case n
          when 1 : call prefix (korzen);
          when 2 : call infix (korzen);
          when 3 : call postfix (korzen)
        esac
      fi;
    fi;
    write("     ");
    kon:=inchar
  end fix;
  
  unit czekaj: procedure;
    var t, k: integer;
  begin
    t:=time;
    k:=time;
    while k-t<2
    do
      k:=time
    od
  end czekaj;
  
  unit beep: procedure;
  begin
    write ("")
  end beep;
  
  unit zakonczenie: procedure;
    var i, j, t, k: integer;
  begin
    for i:=9 to 15 
    do
      call cll(i)
    od;
    for i:=10 step 4 to 14 
    do
      call sc(i,10);
      for j:=10 to 70
      do
        write ('*')
      od
    od;
    for i:=10 step 60 to 70 
    do
      for j:=11 to 13
      do
        call sc(j,i);
        write ('*')
      od
    od;
    call sc(12,33);
    write ("DO ZOBACZENIA          ");
    call czekaj;
    call endrun
  end zakonczenie;
  
  
begin     (*  program glowny  *)
  call menu;
  do
    call cll(25);
    call cll(24);
    write ("Podaj numer opcji      ");
    call wprowliczbe (num,op);
    if not op
    then  
      repeat
    fi;
    if num < 1 or num > 7
    then  
      call beep;
      repeat
    fi;
    call podkresl (10,70,num,'.');
    case num
      when 1 : call robzsearch (1);     (*  insert  *)
      when 2 : call robzsearch (2);     (*  delete  *)
      when 3 : call robzsearch (3);     (*  member  *)
      when 4 : call empty (korzen);
      when 5 : call drukuj;
      when 6 : call fix (korzen)
    esac;
    if num=5 or num=6
    then
      call menu
    else
      call podkresl (10,70,num,' ')
    fi;
    if num=7
    then
      call zakonczenie
    fi
  od
end drzewo