[Back to POINTERS SWAG index]  [Back to Main SWAG index]  [Original]

program du_kivuni;
uses crt;
type pelement=^element;
          element=record
             info:integer;
             r,l:pelement;
             end;
var head:pelement;sp:char;val:integer;
procedure init (var head:pelement);
begin
  new (head);
  writeln('Type value.');
  readln(head^.info);
  head^.l:=nil;
  head^.r:=nil;
end;
procedure insert (var head:pelement;val:integer);
var t,p:pelement;
begin
new(t);
new(p);
write('Type value: ');
readln(t^.info);
if t^.info >= head^.info then
begin
p:=head;
if p^.r<>nil then
 begin
   while (p^.r<>nil) and (p^.info<t^.info) do
    begin
     if p^.r^.info>=t^.info then
      begin
       t^.l:=p;
       p^.r^.l:=t;
       t^.r:=p^.r;
       p^.r:=t;
      end;
     p:=p^.r;
    end;
 end;
if p^.r=nil then begin
p^.r:=t;
t^.l:=p;
t^.r:=nil;
end;
end;
if t^.info < head^.info then
begin
p:=head;
if p^.l<>nil then
 begin
   while (p^.l<>nil) and (p^.info>t^.info) do
    begin
     if p^.l^.info<=t^.info then
      begin
       t^.r:=p;
       p^.l^.r:=t;
       t^.l:=p^.l;
       p^.l:=t;
      end;
     p:=p^.l;
    end;
 end;
if p^.l=nil then begin
p^.l:=t;
t^.r:=p;
t^.l:=nil;
end;
end;
end;
procedure print (var head:pelement);
var p:pelement;
begin
 p:=head;
 if (head^.r=nil) and (head^.l=nil) then write(head^.info)
  else begin
        while p^.l<>nil do p:=p^.l;
        while p^.r<>nil do
         begin
            write(p^.info:3);
            p:=p^.r;
         end;
       writeln(p^.info:3);
      end;
end;
begin
clrscr;
init (head);
writeln('(I)nsert (P)rint (Q)uit ');
readln(sp);
while sp<>'q' do begin
case sp of
     'i':insert(head,val);
     'p':print(head);
     end;
     writeln;
     writeln('(I)nsert (P)rint (Q)uit ');
     readln(sp);
  end;
end.

[Back to POINTERS SWAG index]  [Back to Main SWAG index]  [Original]