uses crt;
type ptr = ^T;
T = record
data:integer;
next:ptr;
end;
var head,curr,sortedList:ptr;
str:integer;
maxPtr:ptr;
pressedKey:char;
{----------------------------------------------------------------------}
procedure addToList(value:integer);
begin
new(curr);
curr^.data:=value;
curr^.next:=head;
head:=curr;
end;
{----------------------------------------------------------------------}
procedure printList(myHead:ptr);
{var myHead:ptr;}
begin
{myHead:=head;}
while myHead <> nil do
begin
curr:=myHead;
myHead:=curr^.next;
write(curr^.data,' ');
end;
end;
{----------------------------------------------------------------------}
procedure printListRecursive(var myHead:ptr);
{var myHead:ptr;}
begin
if myHead <> nil then
begin
write(myHead^.data, ' ');
printListRecursive(myHead^.next);
end;
end;
{----------------------------------------------------------------------}
procedure swapMinMax;
var min,max:integer;
minPtr,maxPtr:ptr;
x:integer;
myHead:ptr;
begin
myHead:=head;
minPtr:=myHead;
maxPtr:=myHead;
curr:=myHead;
max:=curr^.data;
min:=curr^.data;
while curr <> nil do
begin
if (curr^.data > max) then
begin
max:=curr^.data;
maxPtr:=curr;
end;
if (curr^.data < min) then
begin
min:=curr^.data;
minPtr:=curr;
end;
curr:=curr^.next;
end;
x:=maxPtr^.data;
maxPtr^.data:= minPtr^.data;
minPtr^.data:= x;
end;
{----------------------------------------------------------------------}
procedure deleteKey(a:integer);
var flag:boolean;
prev:ptr;
begin
curr:=head;
flag:=true;
prev:=curr;
while (curr <> nil) and flag do
begin
if curr^.data = a then
begin
prev^.next := curr^.next;
dispose(curr);
flag:= false;
end;
prev:=curr;
curr:=curr^.next;
end;
end;
{----------------------------------------------------------------------}
procedure findMax(var maxPtr:ptr);
var max:integer;
begin
maxPtr:=head;
curr:=head;
max:=curr^.data;
while curr <> nil do
begin
if (curr^.data > max) then
begin
max:=curr^.data;
maxPtr:=curr;
end;
curr:=curr^.next;
end;
end;
{----------------------------------------------------------------------}
procedure insertMax(max:integer; a:integer);
var newPtr:ptr;
flag:boolean;
begin
curr:=head;
flag:=true;
while (curr <> nil) and flag do
begin
if (curr^.data > a) then
begin
new(newPtr);
newPtr^.data := max;
newPtr^.next := curr^.next;
curr^.next :=newPtr;
flag:=false;
end;
curr:=curr^.next;
end;
end;
{----------------------------------------------------------------------}
procedure addElement(var myHead:ptr; d:integer);
var current:ptr;
begin
if (myHead = nil) then
begin
new(current);
current^.data:=d;
current^.next:=nil;
myHead:=current;
end
else
if myHead^.data > d then
begin
new(current);
current^.data:=d;
current^.next:=myHead;
myHead:=current;
end
else
addElement(myHead^.next,d);
end;
{----------------------------------------------------------------------}
procedure sortList(var oldList:ptr; var newList:ptr);
begin
while (oldList <> nil) do
begin
addElement(newList,oldList^.data);
oldList:=oldList^.next;
end;
end;
{----------------------------------------------------------------------}
procedure deleteListRecursive(var myHead:ptr);
begin
if myHead <> nil then
begin
printListRecursive(myHead^.next);
dispose(myHead);
end;
end;
{----------------------------------------------------------------}
procedure getCommands;
begin
window(55,1,80,25);
writeln('Commands: ');
writeln('1 - exit');
writeln('2 - create list');
writeln('3 - print list');
writeln('4 - delete list');
writeln('5 - swap min and max elements');
writeln('6 - cleen screen');
writeln('7 - delete element with key');
writeln('8 - insert max element after key');
writeln('9 - sort list');
writeln('a - print sorted list');
end;
{----------------------------------------------------------------------}
Begin
clrscr;
gotoXY(20,1);
repeat
getCommands;
window(1,1,80,25);
write('Command: ');
clreol;
readln(pressedKey);
window(1,2,54,25);
case pressedKey of
'2':
begin
writeln('Enter data for list: ');
readln(str);
while str <> 0 do
begin
addToList(str);
readln(str);
end;
end;
'3':
begin
writeln('Your list: ');
printListRecursive(head);
end;
'4': deleteListRecursive(head);
'5': swapMinMax;
'6': clrscr;
'7':
begin
write('Enter key for deleting: ');
readln(str);
deleteKey(str);
end;
'8':
begin
write('Enter key: ');
readln(str);
findMax(maxPtr);
insertMax(maxPtr^.data,str);
end;
'9':
begin
sortedList:=Nil;
sortList(head,sortedList);
end;
'a':
printListRecursive(sortedList);
end;
until pressedKey = '1';
End.