Vladimir Kraguljac - Gimnazija Vrnjačka Banja

05 - Jednostruko ulančana kružna lista

Primer programa koji žonglira jednostruko ulančanu kružnu listu:

program juk_lista;
type
  lista=^slog;
  slog=record
         inf:integer;
         sled:lista;
       end;
var
  l:lista;
  k:integer;

procedure dodaj(var l:lista; elem:integer);
var
  t:lista;
begin
  t:=l;
  new(l);
  l^.inf:=elem;
  l^.sled:=t;
  if t=nil then
    l^.sled:=l
  else begin
    while t^.sled<>l^.sled do
      t:=t^.sled;
    t^.sled:=l;
  end;
end;

procedure popunilistu(var l:lista);
var
  c:char;
  i:integer;
begin
  write('Zelite li da unesete novi element? (D/N): ');
  readln(c);
  while UpperCase(c)<>'N' do begin
    writeln('Unesite ceo broj: ');
    readln(i);
    dodaj(l,i);
    write('Zelite li da unesete novi element? (D/N): ');
    readln(c);
  end;
  writeln;
end;

procedure ispis(l:lista);
var
  t:lista;
begin
  writeln('Ispis liste:');
  if l=nil then
    writeln('Lista je prazna.')
  else begin
    t:=l;
    repeat
      writeln(t^.inf);
      t:=t^.sled;
    until t=l;
  end;
  writeln;
end;

procedure brisikti(var l:lista; k:integer);
var
  t1,t:lista; b:integer;
begin
  if l<>nil then
    if l^.sled<>l then begin
      t1:=l;
      t:=t1^.sled;
      b:=2;
      while t<>l do begin
        if b mod k = 0 then begin
          t1^.sled:=t^.sled;
          dispose(t);
          t:=t1^.sled; end
        else begin
          t:=t^.sled;
          t1:=t1^.sled;
        end;
        b:=b+1;
      end;
    end;
end;

begin  {glavni program}
  l:=nil;
  popunilistu(l);
  ispis(l);
  write('Unesite k: ');
  readln(k);
  brisikti(l,k);
  ispis(l);
  readln;
end.