Program Lineare_Liste;

uses
 crt;

type
 ListenPtr=^ListenTyp;
 ListenTyp=Record
            x:Real;
            next:ListenPtr;
           end;

var
 Liste:ListenPtr;
 x:real;
 a:char;

Procedure Einfuegen(x:real);
var
 cursor:ListenPtr;
Begin
 new(cursor);
 cursor^.x:=x;
 cursor^.next:=liste;
 liste:=cursor;
end;

Procedure Wait;
begin
 Writeln;
 Writeln ('Weiter mit beliebiger Taste');
 a:=readkey;
end;

procedure Loeschen;
var
 cursor:ListenPtr;
begin
 cursor:=liste;
 If cursor=nil then begin
  writeln ('liste ist leer! ');
  Wait;
 end
 else begin
  If cursor^.next=nil then begin
   Dispose(liste);
   Liste:=nil;
  end
  else begin
   while cursor^.next^.next<>nil do begin
    cursor:=cursor^.next;
   end;
   dispose(cursor^.next);
   cursor^.next:=nil;
  end;
  Writeln('letztes Element ist gelöscht');
  Wait;
 end;
end;

Procedure Anzeigen;
var
 cursor:listenPtr;
 i:Integer;
begin
 cursor:=liste;
 If cursor=nil then begin
  Writeln('Liste ist leer! ');
  Wait;
 end
 else
 begin
  i:=2;
  writeln (cursor^.x);
  while cursor^.next<>nil do begin
   cursor:=cursor^.next;
   writeln (cursor^.x);
   If i=20 then begin
    i:=-1;
    wait;
    clrscr;
   end;
   i:=i+1;
  end;
  writeln('Ende der liste erreicht.');
  Wait;
 end;
end;

begin
 Liste:=nil;
 a:='x';
 while a<>'q' do begin
  clrscr;
  writeln ('Lineare Listen von Guido.Moser@gmx.de (c) ');
  Writeln;
  Writeln ('(E)infügen (L)öschen (A)nzeigen (Q)uitt ');
  a:=readkey;
  case a of
   'e','E':begin
    clrscr;
    Writeln('Reelle Zahl eingeben ');
    read(x);
    Einfuegen(x);
   end;
   'l','L':begin
    clrscr;
    Loeschen;
   end;
   'a','A':begin
    clrscr;
    Writeln('Inhalt der Liste:');
    Anzeigen;
   end;
  end;
 end;
end.