program drzewo;
(*-----------------------------------------------------------------------*)
(*              2-3 tree   J.Kujawski   1989-90                          *)
(*-----------------------------------------------------------------------*)
 
CONST min = 0 ,
      max = 99 ,
      lewy = ".lsyn" ,
      prawy = ".psyn" ,
      srodkowy = ".ssyn" ;
 
(*-----------------------------------------------------------------------*)
 
VAR
   node   :drzewo ,
   i,j    : integer ;
 
(*-----------------------------------------------------------------------*)
 
SIGNAL emptytree ;
 
(*-----------------------------------------------------------------------*)
 
UNIT drzewo:class;
 
  Var klucz:integer,
      lsyn,psyn:drzewo,
      logl,logp:boolean;
 
  Unit lisc : function :boolean ;
      begin
        result := lsyn = none
  end lisc
end drzewo;
 
 
 
(*-----------------------------------------------------------------------*)
 
UNIT licznosc :function (d:drzewo , p:integer , log:boolean):integer ;
 
(* Liczy ile miejsca potrzeba do wydruku linii *)
 
Var licznik : integer ;
 
Signal alarm ;
 
 
Unit licz :procedure (d:drzewo) ;
 begin
    i := i+1 ;
    if d = none then raise alarm fi;
    if i = p then
       if log then licznik := licznik + 1
       else
          if d.logp then
                licznik := licznik + 6
          else
                licznik := licznik + 3  ;
          fi
       fi
    else
       call licz (d.lsyn) ;
       if d.logp then
          call licz(d.psyn.lsyn) ;
          call licz(d.psyn.psyn) ;
       else
          call licz(d.psyn)
       fi
    fi ;
    i := i-1
end licz ;
 
Handlers
 when alarm : licznik := 0 ;
         wind
end handlers ;
 
Begin
  licznik :=0 ;
  i := 0 ;
  call licz (d) ;
  result := licznik
end licznosc ;
 
(*-----------------------------------------------------------------------*)
 
UNIT infix :procedure(d : drzewo) ;
 
Begin
  if d.lisc then
      write(d.klucz:3)
  else
     call infix (d.lsyn );
     call infix (d.psyn )
  fi
end infix ;
 
(*-----------------------------------------------------------------------*)
 
UNIT empty : function (d : drzewo) : boolean ;
   Begin
      result := d = none
End empty ;
 
 
(*-----------------------------------------------------------------------*)
 
UNIT minimum : function (d : drzewo) : integer ;
 
Begin
   if d = none then
      raise emptytree
   else
      if d.lisc then
         result := d.klucz
      else
         result := minimum (d.lsyn)
      fi
   fi
end minimum ;
 
 
(*-----------------------------------------------------------------------*)
 
UNIT member : function ( k:integer , d:drzewo ) : boolean ;
 
  Begin
    if d <> none   then
      if d.klucz <> k then
        if  d.klucz < k  then
            result := member(k,d.psyn);
        else
            result := member(k,d.lsyn);
        fi
      else
         result := true
      fi
    else
         result := false
    fi
  end  member ;
 
(*-----------------------------------------------------------------------*)
 
UNIT insert : procedure ( k : integer ; inout d : drzewo ) ;
 
Var pom1,pom2 : drzewo ,
    max1,max2 : integer ;
 
Signal jest ;
 
Unit ins : procedure ( a:drzewo ) ;
Begin
  if a.klucz = k then raise jest
  fi ;
  if a.lisc then
     pom1 := new drzewo ;
     if a.klucz < k then
         pom1.klucz := k ;
         max1 := a.klucz
     else
         pom1.klucz := a.klucz ;
         max1 := k ;
         a.klucz := k
     fi
  else
     if k <= a.klucz then
        call ins (a.lsyn ) ;
        if pom1 <> none then
           if a.logl then
              pom2 := a.psyn ;
              a.psyn := pom1 ;
              max2 := a.klucz ;
              a.klucz := max1 ;
              max1 := max2 ;
              pom1 := pom2
           else
              if a.logp then
                 pom2 := a.psyn ;
                 a.psyn := pom1 ;
                 max2 := a.klucz ;
                 a.klucz := max1 ;
                 max1 := max2 ;
                 pom1 := pom2 ;
                 a.logp,pom1.logl := false
              else
                 pom2 := new drzewo ;
                 pom2.lsyn := pom1 ;
                 pom2.psyn := a.psyn ;
                 pom2.klucz := a.klucz ;
                 a.klucz := max1 ;
                 pom2.logl,a.logp := true ;
                 a.psyn := pom2 ;
                 pom1 := none
              fi
           fi
        fi
     else
        call ins (a.psyn) ;
        if pom1 <> none then
           if a.logp then
              pom2 := a.psyn ;
              a.psyn := a.psyn.lsyn ;
              pom2.lsyn := pom2.psyn ;
              pom2.psyn := pom1 ;
              max2 := max1 ;
              max1 := pom2.klucz ;
              pom2.klucz := max2 ;
              pom1 := pom2 ;
              pom1.logl,a.logp := false
           else
              if not a.logl then
                 pom2 := new drzewo ;
                 pom2.psyn := pom1 ;
                 pom2.lsyn := a.psyn ;
                 a.psyn := pom2 ;
                 pom2.klucz := max1 ;
                 a.logp,pom2.logl := true ;
                 pom1 := none
              fi
           fi
        fi
     fi
  fi
end ins ;
 
Handlers
   when jest : call setcursor(20,1) ;
               call eraseline ;
               writeln("element ",k:2," already in this tree") ;
               call setcursor (25,30) ;
               call reverse ;
               write ("press any key") ;
               call cursorleft (1) ;
               call normal ;
               call czekaj ;
               call setcursor (25,30) ;
               call eraseline ;
               call setcursor (20,1) ;
               call eraseline ;
               terminate
end handlers ;
 
Begin
  if d=none then
     d := new drzewo ;
     d.klucz := k
  else
     call ins (d) ;
     if pom1 <> none then
        pom2 := new drzewo ;
        pom2.klucz := max1 ;
        pom2.lsyn := d ;
        pom2.psyn := pom1 ;
        d := pom2
      fi
  fi
end insert ;
 
(*-----------------------------------------------------------------------*)
 
UNIT delete:procedure(k:integer;inout d:drzewo);
 
  Var pom,pom1 : drzewo ,
  nowymax      : integer ,
  kon          : boolean ;
 
  Signal  koniec ,niema ;
 
  Unit del : procedure (inout d : drzewo ) ;
 
   Begin
      if d.lisc then
         if d.klucz = k then
            kill (d)
         else
            raise niema
         fi
      else
         if d.klucz >= k then
            call del (d.lsyn) ;
            if kon then
               raise koniec
            fi ;
            if d.lsyn = none then
               if pom = none then
                  if d.logp then
                     pom1 := d ;
                     d := d.psyn ;
                     d.logl := false ;
                     kill (pom1) ;
                     kon := true
                  else
                     pom := d.psyn ;
                     kill (d)
                  fi
               else
                  if k = d.klucz then
                     d.klucz := nowymax
                  fi ;
                  if d.logp then
                     if d.psyn.lsyn.logp then
                        pom1 := d.psyn.lsyn ;
                        d.psyn.lsyn := d.psyn.lsyn.psyn ;
                        d.lsyn :=pom ;
                        pom1.psyn := d.psyn ;
                        d.psyn := pom1.lsyn ;
                        pom1.lsyn := d ;
                        d := pom1 ;
                        d.logp,d.psyn.logl := false ;
                        d.lsyn.logp , d.psyn.lsyn.logl := false ;
                        kon := true
                     else
                        pom1 := d.psyn ;
                        d.lsyn := pom ;
                        d.psyn := d.psyn.lsyn ;
                        pom1.lsyn := d ;
                        d := pom1 ;
                        d.logl := false ;
                        d.lsyn.psyn.logl := true ;
                        pom := none ;
                        kon := true
                     fi
                  else
                     if d.psyn.logp then
                        pom1 := d.psyn ;
                        d.lsyn := pom ;
                        d.psyn := d.psyn.lsyn ;
                        pom1.lsyn := d ;
                        d := pom1 ;
                        d.logp , d.psyn.logl := false ;
                        if d.lsyn.logl  then
                           d.lsyn.logl := false ;
                           d.logl := true
                        fi ;
                        pom := none ;
                        kon := true
                     else
                        d.lsyn := pom ;
                        d.psyn.logl , d.logp := true ;
                        pom := d ;
                        d := none ;
                     fi
                  fi
               fi
            else
 
               if k = d.klucz then d.klucz := nowymax fi;
               pom := none ;
               kon := true
            fi
         else
            call del (d.psyn) ;
            if kon then
               raise koniec
            fi ;
            if d.psyn = none then
               if pom = none then
                  nowymax := d.lsyn.klucz ;
                  pom := d.lsyn ;
                  kill (d)
               else
                  if d.logp then
                     d.psyn := pom ;
                     d.logp := false ;
                     d.psyn.logl := false ;
                     pom := none
                  else
                     if d.lsyn.logp then
                        pom1 := d.lsyn ;
                        d.psyn := pom ;
                        d.lsyn := pom1.psyn.psyn ;
                        pom1.psyn.psyn := d ;
                        d := pom1.psyn ;
                        pom1.psyn := d.lsyn ;
                        d.lsyn := pom1 ;
                        d.logl , d.lsyn.logp := false ;
                        pom := none
                     else
                        pom1 := d.lsyn ;
                        d.psyn := pom ;
                        d.lsyn := d.lsyn.psyn ;
                        pom1.psyn :=d ;
                        pom :=pom1 ;
                        pom1.logp , pom1.psyn.logl := true ;
                        d := none ;
                     fi
                  fi
               fi
            fi
         fi
      fi
   end del ;
 
Handlers
   when niema  : call setcursor(20,1) ;
                 writeln("There is no ",k:2," in the tree") ;
                 call setcursor (25,30) ;
                 call reverse ;
                 write ("press any key") ;
                 call cursorleft (1) ;
                 call normal ;
                 call czekaj ;
                 call setcursor (25,30) ;
                 call eraseline ;
                 call setcursor(20,1) ;
                 call eraseline ;
                 terminate ;
   when koniec : terminate
end handlers ;
 
   Begin
     if d = none then
        raise niema
     else
        call del (d) ;
        if pom <> none then
           d := pom
        fi
    fi
end delete ;
 
(*-----------------------------------------------------------------------*)
 
Unit delmin : procedure (inout d : drzewo) ;
 
   Var a : integer ;
 
   Begin
      if empty (d) then
         raise emptytree
      else
         a := minimum (d) ;
         call delete (a,d)
      fi
End delmin
 
(*-----------------------------------------------------------------------*)
(*                   PROCEDURY prawie GRAFICZNE                          *)
(* ----------------------------------------------------------------------*)
 
 
  unit Reverse : procedure;
  begin
    write( chr(27), "[7m")
  end Reverse;
 
  unit Normal : procedure;
  begin
    write( chr(27), "[0m")
  end Normal;
 
 
  unit EraseLine : procedure;
  begin
    write( chr(27), "[K")
  end EraseLine;
 
  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 NewPage : procedure;
  begin
    write( chr(27), "[2J")
  end NewPage;
 
  unit  SetCursor : 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 SetCursor;
 
  unit CursorLeft : procedure (columns : integer);
     var e,f  : char,
        i,j : integer;
  begin
    i := columns div 10;
    j := columns mod 10;
    e := chr(48+i);
    f := chr(48+j);
    write( chr(27), "[", e, f, "D")
  end CursorLeft;
 
  unit CursorRight : procedure (columns : integer);
    var e,f  : char,
        i,j : integer;
  begin
    i := columns div 10;
    j := columns mod 10;
    e := chr(48+i);
    f := chr(48+j);
    write( chr(27), "[", e, f, "C")
  end CursorRight;
 
  unit CursorUp : procedure (rows : integer);
    var c,d  : char,
        i,j : integer;
  begin
    i := rows div 10;
    j := rows mod 10;
    c := chr(48+i);
    d := chr(48+j);
    write( chr(27), "[", c, d, "A")
  end CursorUp;
 
  unit CursorDown : procedure (rows : integer);
    var c,d  : char,
        i,j : integer;
  begin
    i := rows div 10;
    j := rows mod 10;
    c := chr(48+i);
    d := chr(48+j);
    write( chr(27), "[", c, d, "B")
  end CursorDown;
 
(*-----------------------------------------------------------------------*)
 
UNIT czekaj :procedure ;
  Var i :integer ;
  Begin
    i := inchar
End czekaj ;
 
(*-----------------------------------------------------------------------*)
 
unit  PrAnyKey : procedure;
begin
      call setcursor (25,30) ;
      call reverse ;
      write ("press any key") ;
      call cursorleft (1) ;
      call normal ;
      call czekaj ;
      call setcursor (25,30) ;
      call eraseline ;
      call setcursor(20,1) ;
      call eraseline;
end PrAnyKey;
 
(*-----------------------------------------------------------------------*)
UNIT tytul : procedure ;
Begin
   call newpage ;
   call setcursor (10,30) ;
   write ("PRIORITY QUEUE  in  2-3 TREE ") ;
   call setcursor (15,32) ;
   write ("Author  :  Adam  Kujawski") ;
   call PrAnyKey;
 
end tytul ;
 
 
 
(*-----------------------------------------------------------------------*)
 
UNIT menu : procedure ;
 
Unit insdelmenu : procedure(formal : boolean) ;
   Var c1,c2,c3 : integer ;
 
   Begin
      call newpage ;
      call setcursor (5,25) ;
      write ("Give a number x to insert ") ;
      call setcursor (7,25) ;
      write ( "  0 < x < 100  .") ;
      call setcursor (9,25) ;
      writeln ("  0 --- to terminate the operation") ;
 
      Do
        call setcursor(15,39);
        call eraseline ;
        c1 := 0 ;
        c2 := 0 ;
        do
           c1 := inchar ;
           if c1 >= 48 andif c1 <= 57 then
              write (chr(c1)) ;
              do
                 c2 := inchar ;
                 if c2 >= 48 andif c2 <= 57 then
                    write (chr (c2)) ;
                    do
                       c3 := inchar ;
                       if c3 = 13 then
                          j := (c1-48) * 10 + (c2-48) ;
                          exit exit exit
                       else
                          if c3 = 8 then
                             c2 := 0 ;
                             call cursorleft(1) ;
                             call eraseline ;
                             exit
                          fi
                       fi
                    od
                 else
                    if c2 = 13 then
                       j := c1-48 ;
                       exit exit
                    else
                       if c2 = 8 then
                          c1 := 0   ;
                          call cursorleft (1) ;
                          call eraseline ;
                          exit
                       fi
                    fi
                 fi
              od
           fi
        od ;
 
        if j < 100 andif j > 0 then
           if formal then
              call insert (j,node) ;
           else
              call delete (j,node) ;
           fi ;
           call setcursor(20,1) ;
           call eraseline ;
           write ("                              O.K.")
       else
           if j = 0 then
              exit
           fi
        fi
     Od
  end insdelmenu ;
 
(*----------------------------------------------------------------------*)
 
Unit membermenu : procedure ;
 
   Var c1,c2,c3 : integer ,
       bool1    : boolean ;
 
   Begin
      call newpage ;
      call setcursor (5,25) ;
      write ("Give a number x ") ;
      call setcursor (7,25) ;
      write ( "  0 < x < 100  .") ;
      call setcursor (9,25) ;
      writeln ("  0 --- to terminate the operation") ;
 
      Do
        call setcursor(15,39);
        call eraseline ;
        c1 := 0 ;
        c2 := 0 ;
        do
           c1 := inchar ;
           if c1 >= 48 andif c1 <= 57 then
              write (chr(c1)) ;
              do
                 c2 := inchar ;
                 if c2 >= 48 andif c2 <= 57 then
                    write (chr (c2)) ;
                    do
                       c3 := inchar ;
                       if c3 = 13 then
                          j := (c1-48) * 10 + (c2-48) ;
                          exit exit exit
                       else
                          if c3 = 8 then
                             c2 := 0 ;
                             call cursorleft(1) ;
                             call eraseline ;
                             exit
                          fi
                       fi
                    od
                 else
                    if c2 = 13 then
                       j := c1-48 ;
                       exit exit
                    else
                       if c2 = 8 then
                          c1 := 0   ;
                          call cursorleft (1) ;
                          call eraseline ;
                          exit
                       fi
                    fi
                 fi
              od
           fi
        od ;
 
        if j < 100 andif j > 0 then
           bool1 := member (j,node) ;
           call setcursor (20,20) ;
           if bool1 then
              write(" Element ",j:2," exists already in the tree.")
           else
              write (" There is no ",j:2," in the tree.")
           fi ;
           call PrAnyKey;
        fi ;
 
        if j = 0 then
           exit
        fi
     Od
end membermenu ;
(*-----------------------------------------------------------------------*)
 
Unit help : procedure ;
 
Begin
   call newpage ;
   call setcursor (7,1) ;
   write ("     If you do not know : ") ;
   write ("  ^d   =  'Ctrl' + 'd' .") ;
   call PrAnyKey;
end help ;
 
(*-----------------------------------------------------------------------*)
Unit emptymenu : procedure ;
Var bo : boolean ;
Begin
   call newpage ;
   bo := empty (node) ;
   call setcursor (12,25) ;
   if bo then
      write ( "The tree is empty.") ;
   else
      write ("This is not empty tree.") ;
   fi ;
   call PrAnyKey;
end emptymenu ;
(*------------------------------------------------------------------------*)
 
Unit minimummenu:procedure ;
Var x : integer ;
Begin
   if empty (node) then
      raise emptytree
   else
      x := minimum(node) ;
      call newpage ;
      call setcursor(12,20) ;
      write ("A minimal element of the tree : ",x:2," .") ;
      call PrAnyKey;
   fi
end minimummenu;
(*---------------------------------------------------------------------*)
 
Unit rysmenu :procedure ;
 
Unit listawezlow : class ;
   var dr       : drzewo ,
       kier     : integer ,
       next,pop : listawezlow ;
end listawezlow ;
 
Var aktualny : listawezlow ,
    pom      : listawezlow ;
 
Begin
      aktualny := new listawezlow ;
      aktualny.dr := node ;
DO
   call newpage ;
   call setcursor (10,30);
   call reverse ;
   write (" S U B M E N U ") ;
   call normal ;
   call setcursor (13,27);
   write ("-> , <-  -  to change the actual tree") ;
   call setcursor (14,27);
   write ("enter    -  draw the actual tree") ;
   call setcursor (15,27);
   write ("Esc      -  return to  M E N U") ;
   call setcursor (25,1);
   write ("actual  =  root") ;
   pom := aktualny ;
   while pom.pop <> none
      do
         pom := pom.pop
      od;
   while pom.next <> none
      do
         case pom.kier
         when 1 : write (lewy) ;
         when 2 : write (srodkowy) ;
         when 3 : write (prawy)
         esac ;
         pom := pom.next
      od;
   DO
      i := inchar ;
      if i > 0 then
         case   i
          when  13 : exit ;
          when  27 : exit exit
         esac
      else
         case   i + 80
          when  8 : if aktualny.dr <> node then
                     aktualny := aktualny.pop ;
                     call cursorleft(5) ;
                     call eraseline ;
                     kill (aktualny.next) ;
                     aktualny.kier := 0
                  fi ;
          when 5 :if aktualny.dr <> none then
                    pom := new listawezlow ;
                    pom.pop := aktualny ;
                    pom.dr := aktualny.dr.lsyn ;
                    aktualny.next := pom ;
                    aktualny.kier := 1 ;
                    aktualny := pom ;
                    write (lewy)
                 fi ;
          when  3 :if aktualny.dr <> none then
                    pom := new listawezlow ;
                    pom.pop := aktualny ;
                    if aktualny.dr.logp then
                       pom.dr := aktualny.dr.psyn.psyn
                    else
                       pom.dr := aktualny.dr.psyn
                    fi ;
                    aktualny.next := pom ;
                    aktualny.kier := 3 ;
                    aktualny := pom ;
                    write (prawy) ;
                 fi ;
          when  0 :if aktualny.dr <> none then
                    if aktualny.dr.logp then
                       pom := new listawezlow ;
                       pom.pop := aktualny ;
                       aktualny.next := pom ;
                       pom.dr := aktualny.dr.psyn.lsyn ;
                       aktualny.kier := 2 ;
                       aktualny := pom ;
                       write (srodkowy)
                    fi ;
                 fi
          esac
       fi
 
      OD ;
      call rys (aktualny.dr)
   OD
 
end rysmenu ;
(*--------------------------------------------------------------------*)
 
Begin
DO
   call newpage ;
   call setcursor (13,31);
   call reverse ;
   write (" M E N U ") ;
   call normal ;
   call setcursor (13,30);
   write ("i  - insert") ;
   call setcursor (14,30);
   write ("d  - delete");
   call setcursor (15,30);
   write ("m  - member" );
   call setcursor (16,30);
   write ("e  - empty?") ;
   call setcursor (17,30);
   write ("w  - draw tree");
   call setcursor (18,30);
   write ("^m - minimum");
   call setcursor (19,30);
   write ("^d - delmin");
   call reverse ;
   call setcursor (25,1);
   write ("     F1 -  HELP     ,     Esc - end of the execution            ");
   call normal ;
 
   DO
      i := inchar ;
      if i = 27 then
         exit exit
      else
         if i > 80 then
            case   i
               when 105 : call insdelmenu(true) ;
               when 100 : call insdelmenu(false) ;
               when 109 : call membermenu ;
               when 101 : call emptymenu ;
               when 119 : call rysmenu ;
            esac;
            exit
         else
            case    i + 60
               when 64 : call delmin (node) ;
               when 73 : call minimummenu ;
               when 1  : call help ;
            esac;
            exit;
         fi
      fi
   OD
OD;
call NewPage;
 
end menu ;
(*-----------------------------------------------------------------------*)
(*-----------------------------------------------------------------------*)
 
UNIT rys:IIUWGraph procedure(d:drzewo) ;
 
Const skok = 6 ;
 
Var licznik,poziom,licznik2  : integer  ,
    krok,krok2,staryx,staryy : integer  ;
 
 
 Unit  ramka :procedure (wr,kol,dl:integer) ;
 Var x1,y1,l,h :integer ;
 Begin
      x1 := (wr) * 8 - 2 ;
      y1 := (kol) * 8 -2 ;
      l := 8 * dl + 4 ;
      h := 12 ;
      call move (x1,y1) ;
      call draw (x1+l,y1) ;
      call draw (x1+l,y1+h) ;
      call draw (x1,y1+h) ;
      call draw (x1,y1) ;
      call move (x1 + l div 2,y1) ;
      call draw (staryx ,staryy ) ;
      call move (x1+2,y1+2)
 end ramka ;
 
 Unit print : procedure (a : integer) ;
 Begin
     if a > 9 then
        call hascii (48 + a div 10)
     fi;
     call hascii (48 + a mod 10)
 end print ;
 
 Unit odstep : function(d :drzewo,poziom :integer) : integer ;
 var i,j : integer ;
 
 begin
      j := licznosc (d,poziom,true) ;
      i := licznosc (d,poziom,false) ;
      result :=( 85 - i ) div (j+1)
end odstep ;
 
Unit linia :procedure (d:drzewo);
 
 (* poziom = drukowany poziom *)
 (* i - numer poziomu *)
 
 begin
     i := i+1 ;
     if poziom - 1 = i then
        if d.logp then
           staryx := licznik2 * 8 + 20;
           staryy :=  i * skok * 8 + 10  ;
           licznik2 := licznik2 + 6 + krok2
        else
           staryx := licznik2 * 8 + 8;
           staryy :=  i * skok * 8 + 10 ;
           licznik2 := licznik2 + 3 +krok2
        fi
     fi ;
     if i = poziom then
          if d.logp then
          call ramka (licznik, poziom*skok ,5) ;
          call print (d.klucz) ;
          call hascii (44) ;
          call print (d.psyn.klucz) ;
          licznik := licznik + 6 + krok
       else
          call ramka (licznik, poziom*skok ,2) ;
          call print (d.klucz) ;
          licznik := licznik + 3 + krok
       fi
     else
       call linia (d.lsyn) ;
       if d.logp then
          call linia(d.psyn.lsyn) ;
     call linia(d.psyn.psyn) ;
       else
          call linia(d.psyn)
       fi
     fi;
     i := i-1
end linia ;
 
Unit napis1 : procedure ;
begin
   call move ( 275 ,335) ;
         call hascii (78) ;
         call hascii (97) ;
         call hascii (99) ;
         call hascii (105) ;
         call hascii (115) ;
         call hascii (110) ;
         call hascii (105) ;
         call hascii (106) ;
         call hascii (32) ;
         call hascii (99) ;
         call hascii (111) ;
         call hascii (107) ;
         call hascii (111) ;
         call hascii (108) ;
         call hascii (119) ;
         call hascii (105) ;
         call hascii (101) ;
         call hascii (107)
 
end napis1 ;
 
Unit napis2 : procedure ;
begin
         call move ( 275 ,300) ;
         call hascii (66) ;
         call hascii (114) ;
         call hascii (97) ;
         call hascii (107) ;
         call hascii (32) ;
         call hascii (109) ;
         call hascii (105) ;
         call hascii (101) ;
         call hascii (106) ;
         call hascii (115) ;
         call hascii (99) ;
         call hascii (97)
 
end napis2 ;
 
Unit napis3 : procedure ;
 
begin
         call move ( 285 ,300) ;
         call hascii (79) ;
         call hascii (46) ;
         call hascii (75) ;
         call hascii (46) ;
 
end napis3 ;
 
Begin
     call gron(0) ;
     poziom:=1 ;
     Do
        j := licznosc(d,poziom,false) ;
        if j>0 andif j<82 then
             i := 0 ;
             krok2 := odstep (d,poziom-1) ;
             krok := odstep (d,poziom) ;
             licznik := krok + 1 ;
             licznik2 :=krok2 + 1 ;
             staryx := 350 ;
             staryy := skok * 8 -2  ;
              call linia(d) ;
              poziom := poziom+1
        else
            exit
        fi
     Od ;
     call napis1 ;
     if j >= 82  then
          call napis2
     else
        call napis3
     fi ;
     call czekaj ;
     call groff
end rys;
 
(*-----------------------------------------------------------------------*)
 
HANDLERS
   when emptytree : call newpage ;
                    call setcursor(12,30) ;
                    write ("EMPTY TREE  !") ;
                    call PrAnyKey;
                    (*
                    call setcursor (25,30) ;
                    call reverse ;
                    write ("nacisnij cokolwiek") ;
                    call cursorleft (1) ;
                    call normal ;
                    call czekaj ;*)
                    return
End handlers;
(*-----------------------------------------------------------------------*)
                         (* program glowny *)
(*-----------------------------------------------------------------------*)
 
BEGIN
 
       call tytul ;
       call menu
 
END kolejka ;