program spiski1;
uses crt;
Type
Dlist=^Node; {ukazatel na uzel}
Node=record  {tip dannix uzla}
     info:integer; {to, chto vnutri}
     prev:Dlist;    {ukazatel na predidushiy uzel}
     next:Dlist;    {ukazatel na sled. uzel}
end;

type dlistfile=file of integer;

Var
p,h,q,head,r,l:Dlist; {ukazatel na perviy uzel}
selection:char;
newinfo,x,k,info,index:integer;
f: dlistfile;

Procedure CreateNewNode (var p:Dlist; info:integer);
var
newnode:Dlist;
pos:Dlist;
begin
New (newnode);
newnode^.info:=info;
if (p = nil) then
begin   {spisok pustoi}
newnode^.next:=newnode;
newnode^.prev:=newnode;
p:=newnode;
end;
newnode^.prev:=p^.prev;
newnode^.next:=p;
p^.prev^.next:=newnode;
p^.prev:=newnode;
end;

Procedure AddNewNode (var p:Dlist; info:integer);
var
newnode:Dlist;
q,pp:Dlist;
i,kk:integer;
begin
i:=1;
if (p = nil) then
begin
New(q);
writeln ('vvedite info:');
readln(info);
q^.info:=info;
q^.next:=q;
q^.prev:=q;
p:=q;
end
else begin
writeln ('vvedite k:');
readln (k);
q:=p^.next;
if p=q then dec(i);
while (q<>p) and (i<k-1) do
begin
q:=q^.next;
i:=i+1;
end;
if i<>k-1 then
writeln ('nepravilniy nomer')
else begin
new(pp);
writeln ('vvedite info:');
readln(info);
pp^.next:=q^.next;
pp^.next^.prev:=pp;
q^.next:=pp;
pp^.info:=info;
end;
end;
end;

Procedure Showlist(p:Dlist);
var
pos:Dlist;
begin
if (p = nil) then exit;
pos:=p;
repeat
  writeln (pos^.info);
  pos:=pos^.next;
until (pos = p)
end;

{Function PrintK (head:dlist):dlist;
var
p:dlist;
k,i:integer;
begin
p:=head;
write ('vvedite nomer k: ');
readln(k);
for i:=1 to k-1 do
begin
   p:=p^.next;
end;
if p<>nil then write(p^.info)
else writeln ('vihod za predel');
PrintK:=p;
readln;
end;}



Procedure ChangeValue ( var p:dlist; x:integer); {p-ukazatel na golovu}
var
q:dlist;
begin
writeln ('vvedite info uzla:');
  readln (x);
  if p=nil then writeln ('spisok pust')
  else
   begin
   q:=p^.next;
   while (q<>p) and (q^.info<>x) do
   q:=q^.next;
   if q^.info <>x then
   writeln ('uzel ne naiden')
   else
   begin
   if q=p then
   p:=p^.next;
   writeln ('vvedite novoe znachenie: ');
   readln (q^.info);
   end;
   end;
end;

Procedure Savelist ( var p:dlist);
var
f: file of integer;
q: dlist;
begin
Assign(f,'spisok.dat');
rewrite(f);
write (f,p^.info);
q:=p^.next;
while q<>p do
begin
 write(f,q^.info);
 q:=q^.next;
 end;
close(f);
end;


Procedure Readlist (var p:dlist);
var
f: file of integer;
q: dlist;
{pr,info: integer;}
begin
{writeln ('readlist');}
Assign(f,'spisok.dat');
Reset(f);
while not (eof(f)) do
begin
read(f,info);
{info:=pr;}
CreateNewNode(p,info);
end;
close(f);
end;

Procedure DelNode(var p:Dlist; x:integer);
var q:dlist;
begin
  writeln ('vvedite info uzla:');
  readln (x);
  if p=nil then writeln ('spisok pust')
  else
   begin
   q:=p^.next;
   while (q<>p) and (q^.info<>x) do
   q:=q^.next;
   if q^.info <>x then
   writeln ('uzel ne naiden')
   else
   if q^.next=q then
      begin
      p:=nil;
      dispose(q);
      end
   else
   begin
   if q=p then
   p:=p^.next;
   q^.prev^.next:=q^.next;
   q^.next^.prev:=q^.prev;
   dispose (q);
   end;
   end;
end;


Procedure DeleteNode(var p:Dlist);
var q:dlist;
i,k:integer;
begin
  if p=nil then writeln ('spisok pust')
  else
   begin
   i:=1;
   writeln ('vvedite k:');
   readln (k);
   if k>1 then begin
     q:=p^.next;
     while (q<>p) and (i<>k-1) do
     begin
     q:=q^.next;
     inc(i);
     end;
   end
   else begin
   i:=0; q:=p;
   end;
   if i<>k-1 then
   writeln ('uzel ne naiden')
   else
   if q^.next=q then
      begin
      p:=nil;
      dispose(q);
      end
   else
   begin
   if q=p then
   p:=p^.next;
   q^.prev^.next:=q^.next;
   q^.next^.prev:=q^.prev;
   dispose (q);
   end;
   end;
   end;

Procedure ListDestroy(var p,h:dlist);
begin
if (p=nil) then exit;
p:=h;
while p<>nil do
 begin
 h:=h^.next;
 dispose (p);
 p:=h;
end;
end;


Procedure StraightSelection (p:dlist);
var
p1,p2,pmin:dlist;
min:integer;
begin
if p<>nil then
  begin
  p1:=h;
  repeat
  pmin:=p1; {ssilka na uzel s min znacheniem}
  min:=p1^.info;
  p2:=p1^.next;
  {poisk naim. znach. v ost. chasti spiska}
  while p2<>h do
  begin
  if p2^.info<min then
  begin
    min:=p2^.info;
    pmin:=p2;
  end;
  p2:=p2^.next;
  end;
  {obmen}
  pmin^.info:=p1^.info;
  p1^.info:=min;
  {perexod na sled. uzel}
  p1:=p1^.next;
  until p1^.next=p;
  end;
end;


begin
{p:=nil;
CreateNewNode (p,2);
CreateNewNode (p,3);
CreateNewNode (p,1);
CreateNewNode (p,4);
CreateNewNode (p,10);
CreateNewNode (p,6);}

repeat
clrscr;
writeln ('viberete deistvie:');
writeln ('1.Add node to list');
writeln ('2.Show list');
writeln ('3.Change info');
writeln ('4.Save List to file');
writeln ('5.Read list from file');
writeln ('6.Delete Node');
writeln ('7.Destroy list');
writeln ('8.Sort list');
writeln ('9.Exit');
writeln ('****************');
writeln ('');
write ('Vash vibor:');
Read (selection);

case (selection) of
'1' : AddNewNode(p,info);
      {begin
      write ('Enter info for new node:');
      readln (newinfo);
      CreateNewNode (p, newinfo);
      end;}
'2' : showlist (p);
'3' : changevalue (p,x);
'4' : savelist (p);
'5' : readlist (p);
'6' : deletenode (p);
'7' : listdestroy (p,h);
'8' : StraightSelection (h);
end;
repeat until keypressed
until (selection = '9');
end.