[PAS] Lista podwójnie wiązana

program Project1;

uses
    crt, DOS;
type
  listPtr = ^list;

  list = record
       next: listPtr;
       previous: listPtr;
       name: String;
       points: Double;
  end;

procedure listStartAdd(var listStart: listPtr; var listEnd: listPtr);
var
   newElement: listPtr;
begin
     clrScr;
     newElement := listStart;
     if listStart = NIL then
     begin
          new(newElement);
          writeLn('Wprowadz nazwisko: ');
          readLn(newElement^.name);
          writeLn('Wprowadz liczbe punktow: ');
          readLn(newElement^.points);
          newElement^.next := NIL;
          newElement^.previous := NIL;
          listEnd := newElement;
          listStart := newElement;
     end else
     begin
          new(newElement);
          newElement^.next := listStart;
          listStart^.previous := newElement;
          newElement^.previous := NIL;
          listStart := newElement;
          writeLn('Wprowadz nazwisko: ');
          readLn(newElement^.name);
          writeLn('Wprowadz liczbe punktow: ');
          readLn(newElement^.points);
     end;
end;

procedure listEndAdd(var listStart: listPtr; var listEnd: listPtr);
var
   newElement: listPtr;
begin
     clrScr;
     if listEnd = NIL then
     begin
          newElement := listStart;
          new(newElement);
          writeLn('Wprowadz nazwisko: ');
          readLn(newElement^.name);
          writeLn('Wprowadz liczbe punktow: ');
          readLn(newElement^.points);
          newElement^.next := NIL;
          newElement^.previous := NIL;
          listEnd := newElement;
          listStart := newElement;
     end else
     begin
          newElement := listEnd;
          New(newElement^.next);
          newElement := newElement^.next;
          writeLn('Wprowadz nazwisko: ');
          readLn(newElement^.name);
          writeLn('Wprowadz liczbe punktow: ');
          readLn(newElement^.points);

          newElement^.next := NIL;
          newElement^.previous := listEnd;
          listEnd := newElement;
     end;
end;

procedure ListStartdelete(var listStart: listPtr; var listEnd: listPtr);
var
   pointer: listPtr;
begin
     if listStart = NIL then
     begin
          clrScr;
          writeLn('Nie moge usunac - lista pusta!');
          writeLn;
          writeLn('Nacisnij dowolny klawisz, aby powrocic do menu...');
          ReadKey;
     end else
     if listStart^.next = NIL then
     begin
          pointer := listStart;
          dispose(pointer);
          listStart := NIL;
          listEnd := NIL;
     end else
     begin
          pointer := listStart;
          listStart := pointer^.next;
          listStart^.previous := NIL;
          dispose(pointer);
     end;
end;

procedure listEndDelete(var listStart: listPtr; var listEnd: listPtr);
var
   pointer: listPtr;
begin
     if listStart = NIL then
     begin
          clrScr;
          writeLn('Nie moge usunac - lista pusta!');
          writeLn;
          writeLn('Nacisnij dowolny klawisz, aby powrocic do menu...');
          ReadKey;
     end else
     if listStart^.next = NIL then
     begin
          pointer := listStart;
          dispose(pointer);
          listStart := NIL;
          listEnd := NIL;
     end else
     begin
          pointer := listEnd;
          listEnd := pointer^.previous;
          listEnd^.next := NIL;
          dispose(pointer);
     end;
end;

procedure listClear(var listStart: listPtr; var listEnd: listPtr);
var
   pointer: listPtr;
begin
     while listStart <> NIL do
     begin
          pointer := listStart;
          listStart := pointer^.next;
          dispose(pointer);
     end;
     listStart := NIL;
     listEnd := NIL;
end;

procedure listShow(var listStart: listPtr);
var
   pointer: listPtr;
begin
     clrScr;
     pointer := listStart;
     if pointer = NIL then
     begin
          writeLn('Lista pusta!');
     end else
     begin
          writeLn('Nazwisko: ', pointer^.name);
          writeLn('Punkty: ', pointer^.points:0:1);

          while pointer^.next <> NIL do
          begin
               writeLn;
               pointer := pointer^.next;
               writeLn('Nazwisko: ', pointer^.name);
               writeLn('Punkty: ', pointer^.points:0:1);
          end;
     end;
     writeLn;
     writeLn('Nacisnij dowolny klawisz, aby powrocic do menu...');
     ReadKey;
end;

procedure listReverseShow(var listEnd: listPtr);
var
   pointer: listPtr;
begin
     clrScr;
     pointer := listEnd;
     if pointer = NIL then
     begin
          writeLn('Lista pusta!');
     end else
     begin
          writeLn('Nazwisko: ', pointer^.name);
          writeLn('Punkty: ', pointer^.points:0:1);

          while pointer^.previous <> NIL do
          begin
               writeLn;
               pointer := pointer^.previous;
               writeLn('Nazwisko: ', pointer^.name);
               writeLn('Punkty: ', pointer^.points:0:1);
          end;
     end;
     writeLn;
     writeLn('Nacisnij dowolny klawisz, aby powrocic do menu...');
     ReadKey;
end;

procedure findLargest(var listStart: listPtr);
var
   pointer: listPtr;
   largest: Double;
   foundName: String;
begin
     clrScr;
     pointer := listStart;
     if pointer = NIL then
     begin
          writeLn('Lista pusta!');
     end else
     begin
          largest := pointer^.points;
          foundName := pointer^.name;
          while pointer^.next <> NIL do
          begin
               pointer := pointer^.next;
               if pointer^.points > largest then
               begin
                    largest := pointer^.points;
                    foundName := pointer^.name;
               end;
          end;
          writeLn('Najwyzszy wynik to: ', largest:0:1);
          writeLn('Uzyskal/a go: ', foundName);
          writeLn;
          writeLn('Nacisnij dowolny klawisz, aby powrocic do menu...');
          ReadKey;
     end;
end;

procedure findLeast(var listStart: listPtr);
var
   pointer: listPtr;
   least: Double;
   foundName: String;
begin
     clrScr;
     pointer := listStart;
     if pointer = NIL then
     begin
          writeLn('Lista pusta!');
     end else
     begin
          least := pointer^.points;
          foundName := pointer^.name;
          while pointer^.next <> NIL do
          begin
               pointer := pointer^.next;
               if pointer^.points < least then
               begin
                    least := pointer^.points;
                    foundName := pointer^.name;
               end;
          end;
          writeLn('Najnizszy wynik to: ', least:0:1);
          writeLn('Uzyskal/a go: ', foundName);
          writeLn;
          writeLn('Nacisnij dowolny klawisz, aby powrocic do menu...');
          ReadKey;
     end;
end;

var
   listStart, listEnd, pointer: listPtr;
   choice: String;
begin
     listEnd:= NIL;
     listStart := NIL;

     while true do
     begin
          clrScr;
          WriteLn('1. Dodaj element na poczatku listy');
          WriteLn('2. Dodaj element na koncu listy');
          WriteLn('3. Usun element z poczatku listy');
          WriteLn('4. Usun element z konca listy');
          WriteLn('5. Wyczysc liste');
          WriteLn('6. Wyswietl cala liste od poczatku');
          WriteLn('7. Wyswietl cala liste od konca');
          WriteLn('8. Znajdz najmniejszy wynik');
          WriteLn('9. Znajdz najwiekszy wynik');
          WriteLn('0. Wyjscie');
          ReadLn(choice);
          case choice of
          '1': listStartAdd(listStart, listEnd);
          '2': listEndAdd(listStart, listEnd);
          '3': listStartDelete(listStart, listEnd);
          '4': listEndDelete(listStart, listEnd);
          '5': listClear(listStart, listEnd);
          '6': listShow(listStart);
          '7': listReverseShow(listEnd);
          '8': findLeast(listStart);
          '9': findLargest(listStart);
          '0': break;
          end;
     end;
end.