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.