program tree;
(*****************************************************************************
                   B O G D A N    W I E R C Z Y N S K I
                            1 0 . 0 1 . 1 9 8 9
  Przedstawiony program umozliwia tworzenie drzewa BST oraz jego modyfikacje
  w celach dydaktycznych.  Udostepnia  cztery  podstawowe  operacje  na  tej
  strukturze danych:insert,delete,minimum i maximum. Struktora drzewa jest
  wyswietlana na ekranie i kazda akcja powodujaca jej zmiane wiaze sie ze
  zmiana drzewa na ekranie.
******************************************************************************)
 
 
 unit BST:class;
 (* Klasa implementujaca BST jako abstrakcyjny typ danych z podstawowymi
    operacjami zwiazanymi z ta struktora.                                 *)
 
  unit vertex:class;
   var key:integer,
       left,right:vertex;
  end vertex;
 
  unit find:class(x:real;inout v:vertex);
  (* Wyszukanie w drzewie o korzeniu v wierzcholka z kluczem o wartosci x *)
   var father,(* Wskazanie na ojca szukanegoelementu *)
       znaleziony,(* Wskazanie na wierzcholek ktorego klucz ma wartosc x *)
       vpom:vertex,(* Zmienna pomocnicza *)
       lson:boolean;(* Zmienna informujaca ze znaleziony element jest
                       lewym synem *)
   begin
    vpom:=v;
    father,znaleziony:=none;
    while vpom=/=none do
     if x<vpom.key then father:=vpom;vpom:=vpom.left;lson:=true
      else
       if x>vpom.key then father:=vpom;vpom:=vpom.right;lson:=false
        else znaleziony:=vpom;exit
       fi
     fi
    od;
  end find;
 
  unit delete:find procedure;
  (* Kasowanie wierzcholka ktorego wartosc klucza jest parametrem x w
     find *)
   begin
   if znaleziony=/=none then
     if znaleziony.left=znaleziony.right then
      (* Usuwany element jest lisciem  *)        kill(znaleziony)
      else
       if znaleziony.right=none then
         if father=none then v:=v.left
          (* Usuwany element jest korzeniem drzewa *)
           else
            if lson then father.left:=znaleziony.left
             else father.right:=znaleziony.left
            fi
         fi;
         kill(znaleziony)
        else
          vpom:=znaleziony.right;
          while vpom.left=/=none do
           vpom:=vpom.left
          od;
          znaleziony.key:=vpom.key;
          if vpom.right=none then  kill(vpom)
            else
              znaleziony:=vpom.right; (* Wykorzystanie zmiennej znaleziony
                                        jako zmiennej pomocniczej        *)
              vpom.key:=znaleziony.key;
              vpom.left:=znaleziony.left;
              vpom.right:=znaleziony.right;
              kill(znaleziony)
          fi
       fi
     fi
   fi
  end delete;
 
  unit insert:procedure(x:integer;inout v:vertex);
  (* Wstawienie do drzewa BST  o korzeniu v elementu ktorego wartosc klucza
     bedzie rowna x *)
  var vpom:vertex;
   begin
   if v=none then v:=new vertex; v.key:=x (* Puste drzewo *)
     else
       vpom:=v;
       do
         if x<=vpom.key then
           if vpom.left=/=none then vpom:=vpom.left
             else vpom.left:=new vertex;
                  vpom.left.key:=x;
                  exit
           fi
          else
            if vpom.right=/=none then vpom:=vpom.right
              else vpom.right:=new vertex;
                  vpom.right.key:=x;
                  exit
            fi
         fi
       od
   fi
  end insert;
 
  unit minimum:function(v:vertex):integer;
  (* Znalezienie elementu o najmniejszym kluczu *)
  begin
    while v.left =/= none do
      v:=v.left;
    od;
    result:=v.key;
  end minimum;
 
  unit maximum:function(v:vertex):integer;
  (* Znalezienie elementu o najwiekszym kluczu *)
  begin
    while v.right=/= none do
      v:=v.right;
    od;
    result:=v.key;
  end maximum;
 
 end BST;
 
 
 unit SetCursor: procedure(x,y:integer);
 var i,j:integer,
     c,d,e,f:char;
 begin
   i:= x div 10;
   j:= x mod 10;
   c:=chr(48+i);
   d:=chr(48+j);
   i:=y div 10;
   j:=y mod 10;
   e:=chr(48+i);
   f:=chr(48+j);
   write(chr(27),"[",c,d,";",e,f,"H")
 end SetCursor;
 
 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 ClearScreen: procedure;
 begin
   write(chr(27),"[2J")
 end ClearScreen;
 
 
begin
pref BST block
 
 
 unit OpenWindow:procedure(x,y,height,width:integer);
 (* Otwarcie okienka ktorege lewy gorny rog ma wspolrzedne (x,y) i o wymiarach
    height x width (wysokosc x szerokosc)                                     *)
 var i,j:integer;
 begin
   call SetCursor(x,y);
   write(chr(218));
   for j:=2 to width-1 do write(chr(196)) od;
   write(chr(191));
   for i:=2 to height-1 do
     call SetCursor(x+i-1,y);
     write(chr(179));
     for j:=2 to width-1 do write(" ") od;
     write(chr(179));
   od;
   call SetCursor(x+height-1,y);
   write(chr(192));
   for j:=2 to width-1 do write(chr(196)) od;
   write(chr(217));
   call SetCursor(x+1,y+1);
 end OpenWindow;
 
 unit CloseWindow:procedure(x,y,height,width:integer);
 (* Zamkniecie okienka ktorege lewy gorny rog ma wspolrzedne (x,y) i o wymiarach
    height x width (wysokosc x szerokosc)                                     *)
 var i,j:integer;
 begin
 
   for i:=0 to height-1 do
     call SetCursor(x+i,y);
     for j:=1 to width do write(" ") od;
   od;
 end CloseWindow;
 
 unit negative:procedure;
   begin
     write(chr(27),"[7m");
 end negative;
 
 unit positive:procedure;
   begin
     write(chr(27),"[0m");
 end positive;
 
 unit MenuType:class;
  var beginingX,beginingY:integer,
      Name:string;
 end MenuType;
 
 unit Inic:procedure;
 (* Zainicjowanie systemu,utorzenie odpowiednich danych, ich zainicjowanie,
    wyswietlenie menu .                                                    *)
 var i:integer;
 begin
   AktPoz:=0;
   array Menu dim(0:4);
   for i:=0 to 4 do     (* Wypelnienie tablicy menu *)
     Menu(i):=new MenuType;
     Menu(i).beginingX:=2; (* Wspolrzedne peczatku napisu opcji w menu *)
     Menu(i).beginingY:=8+i*16;
     case i                  (* Wstawienie odpowiedniego tekstu *)
       when 0: Menu(i).Name:="INSERT";
       when 1: Menu(i).Name:="DELETE";
       when 2: Menu(i).Name:="MINIMUM";
       when 3: Menu(i).Name:="MAXIMUM";
       when 4: Menu(i).Name:="EXIT";
     esac;
   od;
   call ClearScreen;
   call SetCursor(1,1);
   for i:=1 to 80 do
     write(chr(196))
   od;
   call negative;
   call SetCursor(Menu(0).beginingX,Menu(0).beginingY);
   write(Menu(0).Name);
   call positive;
   for i:=1 to 4 do
     call SetCursor(Menu(i).beginingX,Menu(i).beginingY);
     write(Menu(i).Name);
   od;
   call SetCursor(3,1);
   for i:=1 to 80 do
     write(chr(196))
   od;
   call SetCursor(Menu(0).beginingX,Menu(0).beginingY);
 end Inic;
 
 unit printclass:class;
 (* Klasa ktora zajmuje sie wyswietlaniem drzewa na ekranie .
    (Mozna ja traktowac w pewnym sensie jak pprocedure)       *)
  const X=1,
        Y=2;
  var i,j,last,przes,NumberOfVert:integer,
      VertCoord:array_of array_of integer,(*Tablica zawierajaca wspolrzedne
                                            wyswietlanych elementow         *)
      queueForPrint:array_of vertex;(*kolejka elementow do wyswietlenia*)
 
  unit printTree:procedure(v:vertex);
  (* Procedura wyswietlajaca drzewo o podanym korzeniu *)
  var first:integer,
      isleft,isright:boolean;
  begin
  if v=/=none then
    first,last:=1;
    queueForPrint(last):=v;
    while first<=31 do (* Wstawianie 31 kolejnych wierzcholkow do kolejki
                          i drukowanie ich.(Tylko tyle miesci sie na
                          monitorze                                       *)
      if first<=15 then
        if queueForPrint(first)=none then
          queueForPrint(last+1),queueForPrint(last+2):=none;
          (*Niema synow wiec wstawiamy none *)
         else
           queueForPrint(last+1):=queueForPrint(first).left;
           queueForPrint(last+2):=queueForPrint(first).right;
           isleft:=queueForPrint(first).left=/=none;
           isright:=queueForPrint(first).right=/=none;
           call Setcursor(VertCoord(X,first),VertCoord(Y,first)-1);
           (* Wypisanie elementu drzewa w odpowiednim formacie *)
           call format(queueForPrint(first).key);
           if isleft or_if isright then
              call Setcursor(VertCoord(X,first)+1,VertCoord(Y,first));
              write(chr(179));
              if isleft then
                call Setcursor(VertCoord(X,first*2)-1,VertCoord(Y,2*first));
                write(chr(179));
                call Setcursor(VertCoord(X,first*2)-2,VertCoord(Y,2*first));
                write(chr(218));
                for i:=1 to ( VertCoord(Y,first)-VertCoord(Y,2*first)-1) do
                  write(chr(196));
                od;
              fi;
              if isleft and isright then write(chr(193))
                else
                  if isleft then write(chr(217))
                    else
                      call Setcursor(VertCoord(X,first)+2,VertCoord(Y,first));
                      write(chr(192));
                  fi;
              fi;
              if isright then
                for i:=1 to ( VertCoord(Y,2*first+1)-VertCoord(Y,first)-1) do
                  write(chr(196));
                od;
                write(chr(191));
                call Setcursor(VertCoord(X,first*2+1)-1,
                               VertCoord(Y,2*first+1));
                write(chr(179));
              fi;
           fi;
        fi;
        last:=last+2
       else
         if queueForPrint(first)=/=none then
           call SetCursor(VertCoord(X,first),VertCoord(Y,first)-1);
           (* Wypisanie elementu drzewa w odpowiednim formacie *)
           call format(queueForPrint(first).key);
           if queueForPrint(first).left=/=none or_if
              queueForPrint(first).right=/=none then
              call Setcursor(VertCoord(X,first)+1,VertCoord(Y,first));
              write(chr(25));
           fi;
         fi;
      fi;
      first:=first+1
    od;
  fi;
  end printTree;
 
  unit format:procedure(x:integer);
  (* Procedura wybiera odpowiedni format wydruku w zaleznosci od liczby
     cyfr w liczbie x i wypisuje ja na ekran                            *)
  begin
    if x>=0 then
       if x>999 then write(x:4)
         else
          if x>99 then write(x:3)
           else write(x:2)
          fi
       fi
     else
       if x<-99 then write(x:4)
        else
          if x<-9 then write(x:3)
           else write(x:2)
          fi
       fi
    fi
  end format;
 
 begin
   array VertCoord dim(1:2);
   for i:=1  to 2 do array VertCoord(i) dim(1:31);od;
   array queueForPrint dim(1:31);
   przes:=40;
   last,NumberOfVert:=1;
   (* Wypelnienie tablicy VertCoord wspolrzednymi wszystkich elementow
      ktore moga byc wyswietlone na ekranie                            *)
   for i:=0 to 4 do
     for j:=1 to NumberOfVert do
       if i=/=4 then
         VertCoord(Y,last):=przes+(j-1)*2*przes;
       fi;
       VertCoord(X,last):=i*4+7;
       last:=last+1
     od;
     NumberOfVert:=NumberOfVert*2;
     przes:=przes div 2
   od;
   przes:=0;
   for last:=16 to 31 do
       VertCoord(Y,last):=2+przes;
       przes:=przes+5
   od;
 end printclass;
 
 
const  IndicatorLeft=-75,(* Kody znakow wykorzystywanych przy poslugiwaniu *)
       IndicatorRight=-77,(* sie menu.                                     *)
       Enter=13,
       Esc=27,
       ConstInsert=0,(* Indeksy tablicy Menu odpowiadajace opcjom *)
       ConstDelete=1,
       ConstMinimum=2,
       ConstMaximum=3,
       ConstExit=4;
 
var i,znak,AktPoz,key:integer,
    root:vertex,(* Korzen drzewa BST *)
    print:printclass,
    Menu :array_of MenuType;
 
(********** POCZATEK PROGRAMU GLOWNEGO **********)
begin
  print:=new printclass;
  call Inic;
  do
    znak:=inchar;
    case znak
      when IndicatorRight:call SetCursor(Menu(AktPoz).beginingX,
                                         Menu(AktPoz).beginingY);
                          write(Menu(AktPoz).Name);
                          AktPoz:=(AktPoz+1) mod 5;
                          call SetCursor(Menu(AktPoz).beginingX,
                                         Menu(AktPoz).beginingY);
                          call negative;
                          write(Menu(AktPoz).Name);
                          call positive;
                          call SetCursor(Menu(AktPoz).beginingX,
                                         Menu(AktPoz).beginingY);
      when IndicatorLeft: call SetCursor(Menu(AktPoz).beginingX,
                                         Menu(AktPoz).beginingY);
                          write(Menu(AktPoz).Name);
                          AktPoz:=(AktPoz+4) mod 5;
                          call SetCursor(Menu(AktPoz).beginingX,
                                         Menu(AktPoz).beginingY);
                          call negative;
                          write(Menu(AktPoz).Name);
                          call positive;
                          call SetCursor(Menu(AktPoz).beginingX,
                                         Menu(AktPoz).beginingY);
      when Enter: if Aktpoz=ConstExit then call endrun
                    else
                      call OpenWindow(3,Menu(AktPoz).beginingY,3,22);
                      case Aktpoz
                        when ConstInsert:write("VALUE: ");
                                         readln(key);
                                         call insert(key,root);
                                         call print.printtree(root);
                                         call SetCursor(Menu(AktPoz).beginingX,
                                               Menu(AktPoz).beginingY);
                        when ConstDelete:write("VALUE: ");
                                         readln(key);
                                         call delete(key,root);
                                         call CloseWindow(7,1,18,80);
                                         call print.printtree(root);
                                         call SetCursor(Menu(AktPoz).beginingX,
                                              Menu(AktPoz).beginingY);
                        when ConstMinimum:if root =/= none then
                                            write(minimum(root):4," ")
                                            else  write("Empty Tree ");
                                          fi;
                                          write("press Esc");
                                          do
                                            if inchar=Esc then exit fi;
                                          od;
                                          call SetCursor(Menu(AktPoz).beginingX,
                                                      Menu(AktPoz).beginingY);
                        when ConstMaximum:if root =/= none then
                                            write(maximum(root):4," ")
                                            else  write("Empty Tree ");
                                          fi;
                                          write("press Esc");
                                          do
                                            if inchar=Esc then exit fi;
                                          od;
                                          call SetCursor(Menu(AktPoz).beginingX,
                                                     Menu(AktPoz).beginingY);
                      esac;
                      call CloseWindow(3,Menu(AktPoz).beginingY,3,22);
                      call SetCursor(Menu(AktPoz).beginingX+1,
                                          Menu(AktPoz).beginingY);
                      for i:=1 to 22 do write(chr(196)) od;
                      call SetCursor(Menu(AktPoz).beginingX,
                                          Menu(AktPoz).beginingY);
                  fi;
 
    esac;
  od;
end ;
end tree