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.