Anonymous

unit funkcijos;
INTERFACE
uses dos;

type tlaikas=record
	val, min, sec:word;
        hsec:longint;
	end;

type sar=^rsar;
     rsar=record
       elem:string[50];
       nxt:sar;
       prv:sar;
     end;
procedure print(head:sar);
var cur:sar;
begin
writeln;
cur:=head;
if cur=nil then writeln('Sarasas tuscias.');
while cur<>nil do begin
  writeln(cur^.elem);
  cur:=cur^.nxt;
end;
writeln;
end;

procedure destroy(var head, tail:sar);
var cur:sar;
begin
if head=nil then writeln('Sarasas tuscias.')
else begin
  cur:=head;
  while cur<>nil do begin
    cur:=cur^.nxt;
    dispose(cur);
    head:=cur;
  end;
  head:=nil;
  tail:=nil;
  writeln('Sarasas istrintas.');
end;
end;

procedure insert(var head, tail:sar;n:integer;tmp:rsar);
var cur, laik:sar;
    ar:boolean;
begin
if head=nil then writeln('Sarasas tuscias.')
else begin
  cur:=head;
  ar:=true;
  while (n-1)>0 do begin
    cur:=cur^.nxt;
    if cur=nil then begin
      writeln('Tiek elementu sarase nera.');
      ar:=false;
      break;
    end;
  n:=n-1;
  end; 
  if (ar=true) and (n>0) then begin
     new(laik);
     laik^.elem:=tmp.elem;
     if cur^.nxt=nil then begin
       laik^.prv:=cur;
       tail:=laik;
       cur^.nxt:=tail;
     end;
     if cur^.nxt<>nil then begin
       laik^.nxt:=cur^.nxt;
       laik^.prv:=cur;
       cur^.nxt^.prv:=laik;
       cur^.nxt:=laik;
     end;
     writeln('Elementas sekmingai iterptas.');
  end;
  if (ar=true) and (n=0) then writeln('Blogai ivesta komanda.');
end;  
end;

function add(var tail:sar; tmp:rsar):sar;
var cur:sar;
begin
new(cur);
cur^.elem:=tmp.elem;
cur^.prv:=tail;
cur^.nxt:=nil;
if tail<>nil then tail^.nxt:=cur;
add:=cur;
end;



procedure copy(var head, tail:sar; n:integer);
var cur:sar;
    ar:boolean;
    tmp:rsar;
begin
  if head=nil then writeln('Sarasas tuscias.')
  else begin
    cur:=head;
    ar:=true;
    while (n-1)>0 do begin
      cur:=cur^.nxt;
      if cur=nil then begin
        writeln('Tiek elementu sarase nera.');
        ar:=false;
        break;
      end;
    n:=n-1;
    end;
    if (ar=true) and (n>0) then begin
      tmp.elem:=cur^.elem;
      tail:=add(tail, tmp);
      writeln('Elementas sekmingai atkopijuotas.');
    end;
    if (n=0) and (ar=true) then writeln('Blogai ivesta komanda.');
  end;
end;

procedure del(var head, tail:sar;n:integer);
var cur, bf, af:sar;
    ar:boolean;
begin
  if head=nil then writeln('Sarasas tuscias.')
  else begin
    cur:=head;
    ar:=true;
    while (n-1)>0 do begin
      cur:=cur^.nxt;
      if cur=nil then begin
        writeln('Tiek elementu sarase nera.');
        ar:=false;
        break;
      end;
      n:=n-1;
    end;
    if (ar=true) and (n>0) then begin
      bf:=cur^.prv;
      af:=cur^.nxt; 
      if (bf<>nil) and (af<>nil) then begin
         bf^.nxt:=af; af^.prv:=bf;
      end;
      if (bf<>nil) and (af=nil) then begin
        tail:=bf;
        bf^.nxt:=nil;
      end;
      if (bf=nil) and (af<>nil) then begin
        head:=af;
        af^.prv:=nil;
      end;
      if(bf=nil) and (af=nil) then begin
        head:=nil; tail:=nil;
      end;
      dispose(cur);
      writeln('Elementas sekmingai istrintas.');
    end;
    if (n=0) and (ar=true) then writeln('Blogai ivesta komanda.');
  end;
end;