program spiski;
 type
  Telem=integer;
  tlist=^tnode;
  tnode=record
    inf:telem;
    ref:tlist;
 end;
   procedure Init(var N:tlist);
    begin
     N:=nil;
    end;
   procedure addfirst(var N:tlist;E:integer;var c:boolean);
    var
     L:tlist;
      begin
       new(L);
       L^.inf:=E;
       L^.ref:=N;
       c:=true;
       N:=L;
      end;
   procedure addlast(var root:tlist;E:telem;var c:boolean);
 var
   p,s:tlist;
    begin
    new(p);
    if root=nil then
        begin
            p^.inf:=E;
            root:=p;
            p^.ref:=nil
        end
    else
        begin
            s:=root;
            while root^.ref<>nil do
                root:=root^.ref;
            p^.ref:=nil;
            p^.inf:=E;
            root^.ref:=p;
            root:=s
        end;
end;

  procedure addnext (var root:tlist;dobav,E:telem;var c:boolean);
   var
   N1,t:tlist;
   ok:boolean;
     begin
    ok:=false;
    if root<>nil then
      begin
        while not(root^.inf=dobav) and (root<>nil) do
          root:=root^.ref;
            if root^.inf=dobav then
              begin
                new(t);
                t^.ref:=root^.ref;
                root^.ref:=t;
                t^.inf:=E;
                ok:=true
              end;
        end;
       c:=ok
end;

  procedure addbefore(var root:tlist;dobav,E:integer; var c:boolean);
  var
   s,p:tlist;
   ok:boolean;
    begin
    ok:=false;
    if root<>nil then
        begin
            if root^.inf=dobav then
                addfirst(root,E,c)
            else
                begin
                    s:=root;
                    while (root^.ref<>nil) and (root^.ref^.inf<>dobav) do
                        root:=root^.ref;
                    if root^.ref^.inf=dobav then
                        begin
                            new(p);
                            p^.ref:=root^.ref;
                            p^.inf:=E;
                            root^.ref:=p;
                            ok:=true
                        end;
                    root:=s
                end
        end;
    c:=ok
end;


 procedure removefirst(var N:tlist; var c:boolean);
  var
   p:tlist;
  begin
   if N<>nil then
    begin
     p:=N^.ref;
     dispose(N);
     new(N);
     N:=p;
     c:=true;
    end
   else
    c:=false;
  end;
 procedure removelast(var root:tlist; var c:boolean);
 var
   t,p:tlist;
   ok:boolean;
    begin
    ok:=false;
   if root<>nil then
     begin
       if root^.ref=nil then
         begin
           dispose(root);
           root:=nil;
           ok:=true;
         end
       else
         begin
          p:=root;
           while root^.ref^.ref<>nil do
           root:=root^.ref;
           dispose(root^.ref);
           root^.ref:=nil;
           ok:=true;
           root:=p;
        end
     end;
    c:=ok
end;

 procedure removeelem(var root:tlist; E:integer; var c:boolean);
  var
   p,s:tlist;
   ok:boolean;
    begin
     ok:=false;
   if root<>nil then
     begin
      if root^.ref=nil then
         begin
           if root^.inf=E then
             begin
               dispose(root);
               root:=nil;
               ok:=true
             end
         end
      else
        if root^.inf=E then
           begin
             p:=root;
             root:=root^.ref;
             dispose(p);
             ok:=true;
           end
        else
          begin
           s:=root;
            while (root^.ref^.inf<>E) and (root^.ref<>nil) do
              root:=root^.ref;
                if root^.ref^.inf=E then
                  begin
                   p:=root^.ref;
                    root^.ref:=root^.ref^.ref;
                     dispose(p);
                     ok:=true
                  end;
               root:=s;
          end
        end;
    c:=ok
end;
 procedure removenext(var root:tlist; E:integer; var c:boolean);
  var
   p:tlist;
   ok:boolean;
     begin
    ok:=false;
    if root<>nil then
     begin
      while (root^.inf<>E) and (root^.ref<>nil) do
        root:=root^.ref;
          if root^.inf=E then
            begin
             if root^.ref<>nil then
               begin
                p:=root^.ref;
                root^.ref:=root^.ref^.ref;
                 dispose(p);
                 ok:=true
               end
            end;
        end;
    c:=ok
end;

 procedure removebefore(var root:tlist; E:integer; var c:boolean);
  var
   p,s:tlist;
   ok:boolean;
    begin
    ok:=false;
    if (root<>nil) and (root^.ref<>nil) then
     begin
      if root^.ref^.inf=E then
       begin
        p:=root;
        root:=root^.ref;
        dispose(p);
        ok:=true;
       end
     else
      begin
       s:=root;
        while (root^.ref^.ref^.inf<>E) and (root^.ref^.ref<>nil) do
        root:=root^.ref;
         if root^.ref^.ref^.inf=E then
          begin
           p:=root^.ref;
           root^.ref:=root^.ref^.ref;
           dispose(p);
           ok:=true;
         end;
       root:=s
     end
   end;
    c:=ok
end;

 procedure print(var N:tlist; var c:boolean);
  var
   t:tlist;
  begin
   if N<>nil then
    begin
     t:=N;
     writeln('получившийся список:');
     while not (N=nil) do
      begin
       write(N^.inf,' ');
       N:=N^.ref;
      end;
     c:=true;
     writeln;
     N:=t;
    end
   else
    c:=false;
  end;
 function findelem(root:tlist; E:integer):boolean;
  var
   p:tlist;
  begin
    findelem:=false;
    while (root<>nil) and (root^.inf<>E) do
        root:=root^.ref;
    findelem:=root<>nil
end;
    var
     number,a,dobav:integer;
     N,root:tlist;
     E:telem;
     c,I:boolean;
    begin
    init(N);
    repeat
     writeln('1:Добавление в начало');
     writeln('2:Добавление в конец');
     writeln('3:Добавление после указанного элемента');
     writeln('4:Добавление перед указанным элементом');
     writeln('5:Удаление из начала');
     writeln('6:Удаление из конца');
     writeln('7:Удаление указанного эдемента');
     writeln('8:Удаление после указанного элемента');
     writeln('9:Удаление перед указанным элементом');
     writeln('10:Распечатывание списка');
     writeln('11:Нахождение элемента');
     writeln('12:Выход');
     writeln('Введите любой номер');
     readln(number);
      case number of
    1:
     begin
      writeln('Введите элемент для добавления');
      readln(E);
      addfirst(N,E,c);
     end;
    2:
     begin
      writeln('Введите элемент для добавления');
      readln(E);
      addlast(root,E,c);
     end;
    3:
     begin
      writeln('Введите элемент, после которого добавлять');
      readln(dobav);
      writeln('введите элемент для добавления');
      readln(E);
      addnext(root,dobav,E,c);

     end;
    4:
     begin
      writeln('Введите элемент,перед которым добавлять');
      readln(a);
      writeln('введите элемент для добавления');
      readln(E);
      addbefore(root,dobav,E,c);
     end;
    5:
     begin
      writeln('Введите элемент для удаления');
      readln(E);
      removefirst(N,c);
     end;
    6:
     begin
      writeln('Введите элемент для удаления');
      readln(E);
      removelast(root,c);
     end;
    7:
     begin
      writeln('введите элемент для удаления');
      readln(E);
      removeelem(N,E,c);
     end;
    8:
     begin
      writeln('Введите элемент,после которого удалять');
      readln(a);
      writeln('введите элеметн для удаления');
      writeln(E);
      removenext(root,E,c);
     end;
    9:
     begin
      writeln('Введите элемент,до которого удалять');
      readln(a);
      writeln('введите элемент для удаления');
      readln(E);
      removebefore(root,E,c);
     end;
    10:
     begin
      writeln('распечатывание списка');
      print(N,c);
     end;
    11:
     begin
      writeln('введите элемент который хотите найти');
      readln(E);
      I:=findelem(root,E);
      if I then
     writeln('элемент найден: ',E)
    else
     writeln('элемент не найден: ',E);
     end;
   end;
    if c=false then
     writeln('список пуст-error');

   until number=12
    end.