program dinam; {однонаправленный список}
uses crt;
const cr=#13#10;
type telem = ^tspisok;
     tspisok = record
                 simvol: char;
                 next: telem;
               end;
var
   spisok:telem;
   nmenu: byte;

function menu:byte;
var
   i:integer;
begin
  clrscr;
  writeln('1. Создать список',cr,'2. Заменить элемент',cr,
          '3. Вставить элемент',cr,'4. Вывод списка в прямом направлении',cr,
          '5. Вывод списка в обратном направлении',cr,'6. Выход');
  read(i);
  menu:=i;
end;{menu}

procedure pause;
begin
  repeat until keypressed;
end;{pause}

procedure udalenie(spisok:telem);
begin
  if spisok^.next=nil then dispose(spisok)
  else
    udalenie(spisok^.next)
end;{udalenie}

procedure sozdat(spisok:telem);
var
   sim: char;
   p:pointer;
begin
  if spisok^.next<>nil then udalenie(spisok^.next);
  writeln('Введите символы (enter - конец ввода):');
  repeat
    sim:=readkey;
    write(sim);
    if sim<>#13 then
    begin
      spisok^.simvol:=sim;
      new(spisok^.next);
      p:=spisok;
      spisok:=spisok^.next;
      spisok^.next:=nil;
    end;
  until sim=#13;
  spisok:=p;
  dispose(spisok^.next);
  spisok^.next:=nil;
end;

procedure vivodp(spisok:telem);
begin
  while spisok<>nil do
    begin
    write(spisok^.simvol);
    spisok:=spisok^.next;
    end
end;{vivodp}

procedure vivodn(spisok:telem);
begin
  if spisok^.next<>nil then vivodn(spisok^.next);
  write(spisok^.simvol);
end;{vivodn}

procedure zamena(spisok:telem);
var
   number,i:word;
   sim: char;
begin
  vivodp(spisok);
  writeln(cr,'Введите порядковый номер элемента перед которым нужно сделать замену:');
  readln(number);
  writeln('Введите символ');
  read(sim);
  i:=1;
  while (spisok<>nil) and (i<number) do
    if (i+1)=number then
      begin
        spisok^.simvol:=sim;
        i:=number+1;
      end
    else
      begin
        i:=i+1;
        spisok:=spisok^.next
      end;
  if (i=number) or (spisok=nil) then
    begin
      writeln('Замена невыполнима');
      pause;
    end
end;

procedure vstavka(spisok:telem);
var
   number,i: word;
   sim,el: char;
   p:pointer;
begin
  vivodp(spisok);
  writeln(cr,'Введите порядковый номер элемента перед которым нужно сделать вставку:');
  readln(number);
  writeln('Введите символ');
  read(sim);
  i:=1;
  while (spisok<>nil) and (i<number) do
    begin
      spisok:=spisok^.next;
      i:=i+1;
    end;
  if i=number then
    begin
      while spisok<>nil do
      begin
        el:=spisok^.simvol;
        spisok^.simvol:=sim;
        sim:=el;
        p:=spisok;
        spisok:=spisok^.next;
      end;
      spisok:=p;
      new(spisok^.next);
      spisok^.next^.simvol:=sim;
      spisok^.next^.next:=nil;
    end
  else
    begin
    writeln('Вставка невозможна');
    pause;
    end;
end;

begin
  new(spisok);
  spisok^.next:=nil;
  nmenu:=0;
  while nmenu<6 do
    begin
      case nmenu of
        1: sozdat(spisok);
        2: zamena(spisok);
        3: vstavka(spisok);
        4: begin vivodp(spisok);pause end;
        5: begin vivodn(spisok);pause end;
      end;
      nmenu:=menu;
    end;
  udalenie(spisok);
end.