type
zap = record
fam: string[10];
im: string[7];
otc: string[13];
end;
ukaz = ^element;
element = record
inf: zap;
next: ukaz;
end;
var
newE, left, right, temp: ukaz;
z: zap;
number: integer;
function InputZ : zap;
var
z : zap;
begin
writeln('Введите фамилию студента');
readln(z.fam);
writeln('Введите имя студента');
readln(z.im);
writeln('Введите отчество студента');
readln(z.otc);
InputZ := z;
end;
procedure dob(var first, last : ukaz);
var
z : zap;
begin
z := InputZ;
if first = nil then
begin
New(first);
last := first;
end
else
begin
New(last^.next);
last := last^.next;
end;
last^.inf := z;
last^.next := nil;
end;
procedure org(var first, last : ukaz);
var
answer : String;
begin
writeln('Выполняется процедура организации очереди');
repeat
WriteLn;
WriteLn('Желаете добавить студента? 1 - да / 0 - нет');
ReadLn(answer);
if Length(answer) = 1 then
case answer[1] of
'1' : dob(first, last);
'0' : Exit;
end;
until False;
end;
procedure udal(var first, last : ukaz);
var
tmp : ukaz;
begin
writeln('Исключение главного элемента очереди');
if first = nil then
WriteLn('Операция невозможна: очередь пуста!')
else
begin
tmp := first;
first := first^.next;
dispose(tmp);
end;
writeln('Нажмите кнопку Enter');
readln;
end;
procedure prosmotr(cur : ukaz);
var
i : integer;
z : zap;
begin
if cur = nil then
WriteLn('Очередь пуста!')
else
begin
writeln('Очередь содержит следующие элементы');
i := 0;
while cur <> nil do
begin
inc(i);
z := cur^.inf;
writeln(i, ')', z.fam, ' ', z.im, ' ', z.otc);
cur := cur^.next;
end;
end;
writeln('Нажмите кнопку Enter');
readln;
end;
procedure SwapFirstAndLast(var first, last : ukaz);
var
tmp : ukaz;
begin
if first = nil then WriteLn('Очередь пуста!')
else if first = last then WriteLn('Первый = последнему!')
else
begin
tmp := first;
while tmp^.next <> last do tmp := tmp^.next;
last^.next := first^.next;
tmp^.next := first;
first^.next := nil;
tmp := last; last := first; first := tmp;
prosmotr(first);
end;
end;
{}
var
first, last : ukaz;
begin
first := nil;
last := nil;
repeat
writeln('1-организация очереди');
writeln('2-добавление элемента в очередь');
writeln('3-удаление элемента из очереди');
writeln('4-просмотр очереди');
writeln('5 - обменять первый и последний элементы');
writeln('0-выход');
writeln('');
writeln('введите номер пункта меню');
readln(number);
case number of
1: org(first, last);
2: dob(first, last);
3: udal(first, last);
4: prosmotr(first);
5: SwapFirstAndLast(first, last);
0: halt;
end;
until False;
end.
zap = record
fam: string[10];
im: string[7];
otc: string[13];
end;
ukaz = ^element;
element = record
inf: zap;
next: ukaz;
end;
var
newE, left, right, temp: ukaz;
z: zap;
number: integer;
function InputZ : zap;
var
z : zap;
begin
writeln('Введите фамилию студента');
readln(z.fam);
writeln('Введите имя студента');
readln(z.im);
writeln('Введите отчество студента');
readln(z.otc);
InputZ := z;
end;
procedure dob(var first, last : ukaz);
var
z : zap;
begin
z := InputZ;
if first = nil then
begin
New(first);
last := first;
end
else
begin
New(last^.next);
last := last^.next;
end;
last^.inf := z;
last^.next := nil;
end;
procedure org(var first, last : ukaz);
var
answer : String;
begin
writeln('Выполняется процедура организации очереди');
repeat
WriteLn;
WriteLn('Желаете добавить студента? 1 - да / 0 - нет');
ReadLn(answer);
if Length(answer) = 1 then
case answer[1] of
'1' : dob(first, last);
'0' : Exit;
end;
until False;
end;
procedure udal(var first, last : ukaz);
var
tmp : ukaz;
begin
writeln('Исключение главного элемента очереди');
if first = nil then
WriteLn('Операция невозможна: очередь пуста!')
else
begin
tmp := first;
first := first^.next;
dispose(tmp);
end;
writeln('Нажмите кнопку Enter');
readln;
end;
procedure prosmotr(cur : ukaz);
var
i : integer;
z : zap;
begin
if cur = nil then
WriteLn('Очередь пуста!')
else
begin
writeln('Очередь содержит следующие элементы');
i := 0;
while cur <> nil do
begin
inc(i);
z := cur^.inf;
writeln(i, ')', z.fam, ' ', z.im, ' ', z.otc);
cur := cur^.next;
end;
end;
writeln('Нажмите кнопку Enter');
readln;
end;
procedure SwapFirstAndLast(var first, last : ukaz);
var
tmp : ukaz;
begin
if first = nil then WriteLn('Очередь пуста!')
else if first = last then WriteLn('Первый = последнему!')
else
begin
tmp := first;
while tmp^.next <> last do tmp := tmp^.next;
last^.next := first^.next;
tmp^.next := first;
first^.next := nil;
tmp := last; last := first; first := tmp;
prosmotr(first);
end;
end;
{}
var
first, last : ukaz;
begin
first := nil;
last := nil;
repeat
writeln('1-организация очереди');
writeln('2-добавление элемента в очередь');
writeln('3-удаление элемента из очереди');
writeln('4-просмотр очереди');
writeln('5 - обменять первый и последний элементы');
writeln('0-выход');
writeln('');
writeln('введите номер пункта меню');
readln(number);
case number of
1: org(first, last);
2: dob(first, last);
3: udal(first, last);
4: prosmotr(first);
5: SwapFirstAndLast(first, last);
0: halt;
end;
until False;
end.