UNIT DLISTEN_1;
(* ******************************************************************** *)
(* *)
(* M O D U L : DLISTEN_1 *)
(* -------------------------------------------------------------------- *)
(* Version : 1.56 vom: 04-OKT-94 *)
(* *)
(* Autor : S. Spolwig *)
(* Funktion : Allgemeines dynamisches Listenmodul zur Verwaltung *)
(* beliebiger Datenobjekte. Die Objekte muessen *)
(* importiert und dem Typ TDaten übergeben werden. *)
(* Zum Bewegen in der Liste ist intern eine Listenmarke *)
(* mitgeführt, die die jeweils aktuelle Listenposition *)
(* bezeichnet. *)
(* *)
(* Voraussetzung : Der Elementtyp ist importiert. *)
(* *)
(* Compiler : MSDOS / TURBO Pascal V. 6.0 / KICK - PASCAL 2.12 *)
(* ******************************************************************** *)
INTERFACE
(* ========================== Export ================================== *)
{USES (* import: *)}
type
TDaten = string[30] ; (* muss importiert werden *)
Telementzeiger = ^Telemente;
Telemente = record
daten : TDaten;
naechster : Telementzeiger;
end;
TListen = record
liste, (* zeigt auf die Liste *)
aktueller : Telementzeiger; (* nur zum Durchlaufen, *)
lilaenge : integer; (* zeigt auf das ak. El.*)
end;
IMPLEMENTATION
(* ==================================================================== *)
procedure initialisieren {(var li : TListen)};
(* -------------------------------------------------------------------- *)
(* Effekt : li ist initialisiert. Listenlaenge ist 0; (Liste ist leer) *)
(* -------------------------------------------------------------------- *)
begin
with li do
begin
liste := NIL;
aktueller:= NIL;
lilaenge := 0;
end;
end;
function ist_leer {(var li : TListen) : boolean} ;
(* -------------------------------------------------------------------- *)
(* Voraus: Die Liste ist initialisiert. *)
(* Effekt: True, wenn die Liste leer ist. *)
(* -------------------------------------------------------------------- *)
begin
ist_leer := false;
with li do
begin
if liste = NIL
then ist_leer := true;
end; (* with li *)
end;
procedure first {(var li : TListen)};
(* -------------------------------------------------------------------- *)
(* Zweck : Listenmarke auf das 1. Element setzen *)
(* Vorauss: Die Liste ist initialisiert und nicht leer *)
(* Effekt : Aktuelle Position ist das erste Elment *)
(* Wenn die Liste leer ist, geschieht nichts *)
(* -------------------------------------------------------------------- *)
begin
if not ist_leer(li)
then
with li do
begin
aktueller := liste;
end; (* with li *)
end;
procedure next {(var li : TListen)};
(* -------------------------------------------------------------------- *)
(* Zweck : Die Listenmarke auf das naechste Element setzen *)
(* Vorauss: Die Liste ist nicht leer *)
(* Effekt : Die Marke steht auf der neuen aktuellen Position *)
(* Wenn die Liste leer ist, geschieht nichts *)
(* -------------------------------------------------------------------- *)
begin
if not ist_leer(li)
then
with li do
begin
aktueller := aktueller^.naechster
end; (* with li *)
end;
procedure last {(var li : TListen)};
(* -------------------------------------------------------------------- *)
(* Zweck : Listenmarke auf das Ende der Liste setzen *)
(* Vorauss: Die Liste ist nicht leer. *)
(* Effekt : Letztes vorhandenes Element ist aktuelle Position *)
(* -------------------------------------------------------------------- *)
begin
first(li);
with li do
begin
while aktueller^.naechster <> nil do
begin
next(li);
end;
end; (* with li *)
end;
procedure getdata {(var li : TListen; var da : TDaten)};
(* -------------------------------------------------------------------- *)
(* Zweck : Zugriff auf das aktuelle Element zum Lesen des Inhalts *)
(* Voraus: Die Liste ist nicht leer. *)
(* -------------------------------------------------------------------- *)
begin
with li do
begin
da := aktueller^.daten
end;
end;
procedure vorsetzen {(var li : TListen; da : TDaten)};
(* -------------------------------------------------------------------- *)
(* Voraus: Die Liste initialisiert. *)
(* Effekt: Das neue Element ist an den Anfang der Liste gesetzt. Wenn *)
(* die Liste vorher leer war, ist das Element das erste. *)
(* Die Listenlaenge ist um eins erhoeht. *)
(* -------------------------------------------------------------------- *)
var neuptr : Telementzeiger;
begin
with li do
begin
new(neuptr);
with neuptr^ do
begin
daten := da;
naechster := liste;
end;
liste:= neuptr;
aktueller := neuptr;
inc(lilaenge);
end; (* with li *)
end;
procedure anhaengen {(var li : TListen; na : TDaten)};
(* -------------------------------------------------------------------- *)
(* Voraus: Die Liste initialisiert. *)
(* Effekt: Das neue Element ist ans Ende der Liste angehaengt. Wenn *)
(* die Liste vorher leer war, ist das Element das erste. *)
(* Die Listenlaenge ist um eins erhoeht. *)
(* -------------------------------------------------------------------- *)
var neuptr : Telementzeiger;
begin
with li do
begin
if ist_leer(li)
then vorsetzen(li,na)
else
begin
last(li);
new(neuptr);
with neuptr^ do
begin
daten := na;
naechster := NIL;
end;
aktueller^.naechster := neuptr;
aktueller := aktueller^.naechster;
inc(lilaenge);
end; (* else *)
end; (* with *)
end;
procedure vorne_loeschen {(var li : TListen)};
(* -------------------------------------------------------------------- *)
(* Zweck : Das erste Element loeschen. *)
(* Voraus: Die Liste ist nicht leer. *)
(* Effekt: Das erste Element ist aus der Liste entfernt. *)
(* Die Listenlaenge ist um eins vermindert. Ist die Liste leer,*)
(* geschieht nichts. *)
(* -------------------------------------------------------------------- *)
var hilfptr : Telementzeiger;
begin
if not ist_leer(li)
then
with li do
begin
first(li);
hilfptr := liste;
liste := hilfptr^.naechster ;
dispose(hilfptr);
aktueller := liste;
dec(lilaenge);
end;
end;
procedure entfernen {(var li : TListen)};
(* -------------------------------------------------------------------- *)
(* Zweck : Das aktuelle Element aus der Liste entfernen. *)
(* Voraus: Die Liste ist nicht leer. Das aktuelle Element ist definiert*)
(* Effekt: Das aktuelle Element ist. Die Listenlaenge ist um eins *)
(* vermindert. *)
(* -------------------------------------------------------------------- *)
var hilfptr : Telementzeiger;
begin
if not ist_leer(li)
then
begin
with li do
begin
if lilaenge = 1 (* es gibt nur eins *)
then vorne_loeschen(li)
else (* letztes Element *)
if (aktueller^.naechster = NIL) and (lilaenge > 1)
then hinten_loeschen(li)
else (* mittendrin *)
begin
with aktueller^ do
begin
hilfptr := naechster; (* zeiger auf naechstes Element *)
daten := hilfptr^.daten; (* umkopieren *)
naechster := hilfptr^.naechster; (* verketten *)
end;
dispose(hilfptr); (* und Folgeelement loe. *)
dec(lilaenge);
end; (* else mittendrin *)
end; (* with li *)
end; (* if not *)
end; (* entfernen *)
END. (* Unit *)
|