Turbo Toolbox/Turbo_Toolbox.iso/spezial/22/lists/lists1.pas

Pascal/Delphi Source File | 1991-01-04 | 13.2 KB | 478 lines

(* ----------------------------------------------------- *)
(*                      LISTS.PAS                        *)
(*                                                       *)
(* ■ SListNodePtr: Knotenobjekt für einfach verkettete   *)
(*   Liste...                                            *)
(* ■ DListNodePtr: und für doppelt verkettete Liste.     *)
(* ■ AbstractList: Abstraktes Objekt, als Grundlage für  *)
(*   Listen verwaltenden Objekt.                         *)
(* ■ DListCollection: Implementiert Verwaltung für       *)
(*   doppelt verkettete, unsortierte Liste. Die vielen   *)
(*   Methoden sollen den Umgang erleichern.              *)
(*                                                       *)
(*          (c) 1991 by R.Reichert & toolbox             *)
(* ----------------------------------------------------- *)
UNIT Lists;

INTERFACE

USES UBase;

CONST
  DLOk    = 0;
  DLNoMem = 1; { ReturnCode, falls es zuwenig Speicher hat}

TYPE
  SListNodePtr = ^SListNode;
  SListNode = OBJECT (Base)
    Next : SListNodePtr;
    Data : BasePtr;

    CONSTRUCTOR Init;
    CONSTRUCTOR InitSet (N : SListNodePtr;
                         D : BasePtr);
    PROCEDURE SetNext (N : SListNodePtr);
    PROCEDURE SetData (D : BasePtr);
    FUNCTION GetNextNode : SListNodePtr;
    FUNCTION GetData : BasePtr;
    DESTRUCTOR Done;                               VIRTUAL;
  END;

  DListNodePtr = ^DListNode;
  DListNode = OBJECT (SListNode)
    Prev : DListNodePtr;

    CONSTRUCTOR Init;
    CONSTRUCTOR InitSet (P, N : DListNodePtr;
                         D : BasePtr);
    PROCEDURE SetNext (N : DListNodePtr);
    PROCEDURE SetPrev (P : DListNodePtr);
    FUNCTION GetPrev : DListNodePtr;
    FUNCTION GetNext : DListNodePtr;
  END;

  AbstractListPtr = ^AbstractList;
  AbstractList = OBJECT (Base)
    CONSTRUCTOR Init;
    PROCEDURE Put (D : BasePtr);                   VIRTUAL;
    PROCEDURE Insert (D : BasePtr);                VIRTUAL;
    PROCEDURE Delete;                              VIRTUAL;
    PROCEDURE Clear;                               VIRTUAL;
    FUNCTION GetActData : BasePtr;                 VIRTUAL;
    FUNCTION GetNumber : LONGINT;                  VIRTUAL;
    DESTRUCTOR Done;                               VIRTUAL;
  END;

  DListCollectionPtr = ^DListCollection;
  DListCollection = OBJECT (AbstractList)

    FreeHeap,
    Counter : LONGINT;
    OverFlow: BOOLEAN;
    First, Last,
    Act,
    Left, Right : DListNodePtr;
    ReturnCode  : BYTE;

    CONSTRUCTOR Init;
    PROCEDURE SetFreeHeap (FrH : LONGINT);         VIRTUAL;
    PROCEDURE SetOverFlow (O : BOOLEAN);           VIRTUAL;
    PROCEDURE Put (D : BasePtr);                   VIRTUAL;
    PROCEDURE Insert (D : BasePtr);                VIRTUAL;
    PROCEDURE Delete;                              VIRTUAL;
    PROCEDURE Clear;                               VIRTUAL;
    PROCEDURE SetActNode (N : DListNodePtr);       VIRTUAL;
    PROCEDURE SetActNodeTo (Nr : LONGINT);         VIRTUAL;

    FUNCTION GetNumber : LONGINT;                  VIRTUAL;
    FUNCTION GetFreeHeap : LONGINT;                VIRTUAL;
    FUNCTION GetOverFlow : BOOLEAN;                VIRTUAL;
    FUNCTION GetReturnCode : BYTE;                 VIRTUAL;
    { Die folgenden ...Node-Methoden geben einen Zeiger
      auf den Knoten, die ...Data-Methoden auf das Daten-
      objekt dieser Methoden.                             }
    FUNCTION GetActNode : DListNodePtr;            VIRTUAL;
    FUNCTION GetActData : BasePtr;                 VIRTUAL;
    FUNCTION GetNextNode : DListNodePtr;           VIRTUAL;
    FUNCTION GetNextData : BasePtr;                VIRTUAL;
    FUNCTION GetPrevNode : DListNodePtr;           VIRTUAL;
    FUNCTION GetPrevData : BasePtr;                VIRTUAL;
    FUNCTION GetFirstNode: DListNodePtr;           VIRTUAL;
    FUNCTION GetFirstData: BasePtr;                VIRTUAL;
    { GetLast... beziehen sich nicht auf den Knoten Last,
      der nie Daten enthält, sondern auf den letzten
      Knoten, der noch Daten enthält, also auf den
      Vorgänger von Last.                                 }
    FUNCTION GetLastNode : DListNodePtr;           VIRTUAL;
    FUNCTION GetLastData : BasePtr;                VIRTUAL;
    { Die folgenden Methoden verschieben den Knotenzeiger
      Act zum nächsten,vorhergehenden, ersten oder letzten
      Knoten und einen Zeiger auf dessen Datenobjekt
      zurück.                                             }
    FUNCTION GotoNextData: BasePtr;                VIRTUAL;
    FUNCTION GotoPrevData: BasePtr;                VIRTUAL;
    FUNCTION GotoFirstData: BasePtr;               VIRTUAL;
    FUNCTION GotoLastData: BasePtr;                VIRTUAL;
    { IsOnLast ist TRUE, wenn Act^.Data auf das letzte
      Datenobjekt zeigt (dh, Act^.Next=Last ist).         }
    FUNCTION IsOnLast : BOOLEAN;                   VIRTUAL;
    DESTRUCTOR Done;                               VIRTUAL;
  END;

IMPLEMENTATION

(* ───────────────────────────────────────────────────── *)
(*            Implementation von SListNode               *)
(* ───────────────────────────────────────────────────── *)
CONSTRUCTOR SListNode.Init;
BEGIN
  Next := NIL;  Data := NIL
END;

CONSTRUCTOR SListNode.InitSet (N:SListNodePtr; D:BasePtr);
BEGIN
  Next := N;    Data := D
END;

PROCEDURE SListNode.SetNext (N : SListNodePtr);
BEGIN
  Next := N
END;

PROCEDURE SListNode.SetData (D : BasePtr);
BEGIN
  Data := D
END;

FUNCTION SListNode.GetNextNode : SListNodePtr;
BEGIN
  GetNextNode := Next
END;

FUNCTION SListNode.GetData : BasePtr;
BEGIN
  GetData := Data
END;

DESTRUCTOR SListNode.Done;
BEGIN
  IF Data<>NIL THEN
    Dispose (Data, Done)
END;

(* ───────────────────────────────────────────────────── *)
(*              Implementation von DListNode             *)
(* ───────────────────────────────────────────────────── *)
CONSTRUCTOR DListNode.Init;
BEGIN
  SListNode.Init;   Prev := NIL;
END;

CONSTRUCTOR DListNode.InitSet (P,N:DListNodePtr;D:BasePtr);
BEGIN
  Next := N;  Prev := P;  Data := D
END;

PROCEDURE DListNode.SetNext (N : DListNodePtr);
BEGIN
  Next := N
END;

PROCEDURE DListNode.SetPrev (P : DListNodePtr);
BEGIN
  Prev := P
END;

FUNCTION DListNode.GetPrev : DListNodePtr;
BEGIN
  GetPrev := Prev
END;

FUNCTION DListNode.GetNext : DListNodePtr;
BEGIN
  GetNext := DListNodePtr (Next)
END;

(* ───────────────────────────────────────────────────── *)
(*       (Nicht-) Implementation von AbstractList        *)
(* ───────────────────────────────────────────────────── *)
CONSTRUCTOR AbstractList.Init;
BEGIN  Abstract ('AbstractList');  END;

PROCEDURE AbstractList.Put (D : BasePtr);
BEGIN  Abstract ('AbstractList');  END;

PROCEDURE AbstractList.Insert (D : BasePtr);
BEGIN  Abstract ('AbstractList');  END;

PROCEDURE AbstractList.Delete;
BEGIN  Abstract ('AbstractList');  END;

PROCEDURE AbstractList.Clear;
BEGIN  Abstract ('AbstractList');  END;

FUNCTION AbstractList.GetActData : BasePtr;
BEGIN  Abstract ('AbstractList');  END;

FUNCTION AbstractList.GetNumber : LONGINT;
BEGIN  Abstract ('AbstractList');  END;

DESTRUCTOR AbstractList.Done;
BEGIN  Abstract ('AbstractList');  END;

(* ───────────────────────────────────────────────────── *)
(*           Implementation von DListCollection          *)
(* ───────────────────────────────────────────────────── *)
CONSTRUCTOR DListCollection.Init;
BEGIN
  Counter := 0;    FreeHeap := 0;     OverFlow := TRUE;
  First   := NIL;  Last     := NIL;   Act      := NIL;
  Left    := NIL;  Right    := NIL;   ReturnCode := DLOk;
END;

PROCEDURE DListCollection.SetFreeHeap (FrH : LONGINT);
BEGIN
  FreeHeap := FrH;
  IF FreeHeap>MemAvail THEN FreeHeap := MemAvail;
END;

PROCEDURE DListCollection.SetOverFlow (O : BOOLEAN);
BEGIN
  OverFlow := O;
END;

PROCEDURE DListCollection.Put (D : BasePtr);
  VAR p : DListNodePtr;
BEGIN
  IF D<>NIL THEN BEGIN
    IF FreeHeap+SizeOf (D^) > MemAvail THEN BEGIN
      Dispose (D);
      ReturnCode := DLNoMem
    END ELSE IF First=Last THEN BEGIN
      Last := New (DListNodePtr, Init);
      First:= New (DListNodePtr, InitSet (NIL, Last, D));
      Last^.SetNext (NIL);
      Last^.SetPrev (First);
      Act := First;
      Inc (Counter);
    END ELSE BEGIN
      Left := Act;
      Right:= Act^.GetNext;
      p := New (DListNodePtr, InitSet (Left, Right, D));
      Left^.SetNext (p);
      Right^.SetPrev (p);
      Act := p;
      Inc (Counter);
    END
  END ELSE
    ReturnCode := DLNoMem;
END;

PROCEDURE DListCollection.Insert (D : BasePtr);
BEGIN
  Put (D);
END;

PROCEDURE DListCollection.Delete;
  VAR p : DListNodePtr;
BEGIN
  IF First^.GetNext=Last THEN BEGIN
    Dispose (First, Done);         { First ist gleich Act }
    First := NIL;  Last := NIL;       { Liste wieder leer }
    Act   := NIL;  Left := NIL; Right := NIL;
    Dec (Counter);
  END ELSE                      { sonst, wenn Liste nicht }
  IF NOT (First = Last) THEN BEGIN      { leer, entfernen }
    Left := Act^.GetPrev;
    Right:= Act^.GetNext;
    Left^.SetNext (Right);
    Right^.SetPrev (Left);
    p := Act;
    IF NOT (Act^.GetNext = Last) THEN
      Act := Right
    ELSE
      Act := Left;
    Dispose (p, Done);
    Dec (Counter);
  END;
END;

PROCEDURE DListCollection.Clear;
  VAR p : DListNodePtr;
BEGIN
  IF NOT (First = Last) THEN BEGIN     { Wenn Liste nicht }
    Act := First;                            { leer, dann }
    WHILE (Act<>NIL) DO BEGIN               { durchlaufen }
      p := Act^.GetNext;
      Dispose (Act, Done);                  { und löschen }
      Act := p;
    END;
    First := NIL;  Last := NIL;  Act := NIL;
    Right := NIL;  Left := NIL;
  END;
END;

PROCEDURE DListCollection.SetActNode (N : DListNodePtr);
BEGIN
  IF N<>NIL THEN Act := N;
END;

PROCEDURE DListCollection.SetActNodeTo (Nr : LONGINT);
  VAR i : LONGINT;
BEGIN
  IF First<>NIL THEN BEGIN
    Act := First; i := 1;
    WHILE (i<Counter) AND (i<Nr) DO BEGIN
      Act := Act^.GetNext;  Inc (i);
    END;
  END;
END;

FUNCTION DListCollection.GetNumber : LONGINT;
BEGIN
  GetNumber := Counter;
END;

FUNCTION DListCollection.GetFreeHeap : LONGINT;
BEGIN
  GetFreeHeap := FreeHeap;
END;

FUNCTION DListCollection.GetOverFlow : BOOLEAN;
BEGIN
  GetOverFlow := OverFlow;
END;

FUNCTION DListCollection.GetReturnCode : BYTE;
BEGIN
  GetReturnCode := ReturnCode;  ReturnCode := DLOk;
END;

FUNCTION DListCollection.GetActNode : DListNodePtr;
BEGIN
  GetActNode := Act;
END;

FUNCTION DListCollection.GetActData : BasePtr;
BEGIN
  GetActData := Act^.GetData;
END;

FUNCTION DListCollection.GetNextNode : DListNodePtr;
BEGIN
  GetNextNode := Act^.GetNext;
END;

FUNCTION DListCollection.GetNextData : BasePtr;
BEGIN
  IF Act^.GetNext<>Last THEN
    GetNextData := Act^.GetNext^.GetData
  ELSE
    GetNextData := NIL;
END;

FUNCTION DListCollection.GetPrevNode : DListNodePtr;
BEGIN
  GetPrevNode := Act^.GetPrev;
END;

FUNCTION DListCollection.GetPrevData : BasePtr;
BEGIN
  IF Act^.GetPrev<>NIL THEN
    GetPrevData := Act^.GetPrev^.GetData
  ELSE
    GetPrevData := NIL;
END;

FUNCTION DListCollection.GetFirstNode: DListNodePtr;
BEGIN
  GetFirstNode := First;
END;

FUNCTION DListCollection.GetFirstData: BasePtr;
BEGIN
  IF First<>NIL THEN GetFirstData := First^.GetData
                ELSE GetFirstData := NIL;
END;

FUNCTION DListCollection.GetLastNode : DListNodePtr;
BEGIN
  IF Last<>NIL THEN GetLastNode := Last^.GetPrev
               ELSE GetLastNode := NIL;
END;

FUNCTION DListCollection.GetLastData : BasePtr;
BEGIN
  IF Last<>NIL THEN
    GetLastData := Last^.GetPrev^.GetData
  ELSE
    GetLastData := NIL;
END;

FUNCTION DListCollection.GotoNextData: BasePtr;
BEGIN
  IF NOT (First = Last) THEN BEGIN
    IF NOT (Act^.GetNext = Last) THEN BEGIN
      Act := Act^.GetNext;
      GotoNextData := Act^.GetData;
    END ELSE
      IF NOT OverFlow THEN
        GotoNextData := NIL
      ELSE BEGIN
        Act := First;
        GotoNextData := Act^.GetData;
      END
  END ELSE
    GotoNextData := NIL;
END;

FUNCTION DListCollection.GotoPrevData: BasePtr;
BEGIN
  IF NOT (First = Last) THEN BEGIN
    IF NOT (Act^.GetPrev = NIL) THEN BEGIN
      Act := Act^.GetPrev;
      GotoPrevData := Act^.GetData;
    END ELSE
      IF NOT OverFlow THEN
        GotoPrevData := NIL
      ELSE BEGIN
        Act := Last^.GetPrev;
        GotoPrevData := Act^.GetData;
      END
  END ELSE
    GotoPrevData := NIL;
END;

FUNCTION DListCollection.GotoFirstData: BasePtr;
BEGIN
  IF NOT (First = Last) THEN BEGIN
    Act := First;
    GotoFirstData := Act^.GetData;
  END ELSE
    GotoFirstData := NIL;
END;

FUNCTION DListCollection.GotoLastData: BasePtr;
BEGIN
  IF NOT (First = Last) THEN BEGIN
    Act := Last;
    GotoLastData := Act^.GetData;
  END ELSE
    GotoLastData := NIL;
END;

FUNCTION DListCollection.IsOnLast : BOOLEAN;
BEGIN
  IsOnLast := (Act^.GetNext=Last);
END;

DESTRUCTOR DListCollection.Done;
BEGIN
  Clear;
END;

END.
(* ----------------------------------------------------- *)
(*                  Ende von LISTS.PAS                   *)
(* ----------------------------------------------------- *)