Power-Programmierung/CD1.mdf/pascal/library/dos/ooplists/lists.pas

Pascal/Delphi Source File | 1990-10-04 | 9.1 KB | 323 lines

{ DEFINE DEBUG}
{$IFDEF TEST} {$R+,S+,I+,V+} {$ELSE} {$R-,S-,I-,V-} {$ENDIF}
{$IFDEF DEBUG} {$D+} {$ELSE} {$D-} {$ENDIF}

UNIT Lists;
{ Diverse Listen-Strukturen
  Martin Austermeier
  Last Update : Thu  10-04-1990
  Testprogramm siehe Dateiende
}
INTERFACE

TYPE

     einNodePtr = ^aNode;
     aNode = OBJECT  { internal use only }
       elementPtr : Pointer;  { wo ist das Listenelement gesp. }
       prev,                            { vorhergehender }
       next       : einNodePtr;         { nächster Node }
     END;

     einListPtr = ^eineListe;
     eineListe = OBJECT
       _root,
       _currPtr : einNodePtr;
       _elemSize : Word;
       _anzElem : Word;
       _isEoL,
       _isBoL   : Boolean;
       CONSTRUCTOR Create (elementSize : Word);
       DESTRUCTOR Remove;
       FUNCTION GetCurrPtr : Pointer;  { zum merken einer best. Position }
       PROCEDURE SetCurrPtr (p : Pointer);  { Direkter Sprung (RAW!) }
        { **Achtung: keine Fehlerprüfung
          (falls zB. das Element inzwischen gelöscht wurde..) }
       FUNCTION IsEmpty : Boolean;
       FUNCTION GetCount : Word;
       PROCEDURE GoTop;     { auf erstes Element positionieren }
       PROCEDURE SeekEoL;   { auf letztes Element positionieren }
       PROCEDURE GotoItem (n : Word);
                 { auf n'tes Element (erstes Element -> n=1) positionieren }
       PROCEDURE Skip (anzahlElem : Integer); { Skip -1 --> previous }
       FUNCTION  BoL : Boolean; { wurde vor den Anfang positioniert? }
       FUNCTION  EoL : Boolean; { wurde hinter das Ende positioniert? }
       PROCEDURE Get (VAR element);   { aktuelles Element lesen }
       PROCEDURE Read (VAR element);   { aktuelles Element lesen & Skip(1) }
       PROCEDURE Put (VAR element);   { element an akt. Position schreiben }
       PROCEDURE Insert (VAR element);{ element VOR akt. Position einfügen }
       PROCEDURE Append (VAR element); { element an Liste anhängen }
       PROCEDURE Delete;              { element an aktueller Position löschen }
     END;

IMPLEMENTATION
{ -------------------- eineListe --------------------- }

PROCEDURE Error (err : Integer);
BEGIN
  WriteLn; Writeln (#7'LISTS: Error', err);
  HALT(1);
END;

PROCEDURE _ResetList (lp : einListPtr; p : Pointer);
{ keine "Methode", da NON-PUBLIC }
BEGIN
  WITH lp^ DO BEGIN
    _root := p;                  { _root = ^neuesElement }
    _currPtr := _root;           { _currPtr = ^neuesElement }
    IF (_currPtr <> NIL) THEN BEGIN
      _currPtr^.next := NIL;       { the only one }
      _currPtr^.prev := NIL;       { "" }
    END;
    _anzElem := 0;
    _isEoL := TRUE; _isBoL := TRUE;
  END;
END;

CONSTRUCTOR eineListe.Create (elementSize : Word);
BEGIN
  _ResetList (@self, NIL);
  _elemSize := elementSize;
END;

DESTRUCTOR eineListe.Remove;
BEGIN
  GoTop;
  While NOT IsEmpty do Delete;
END;

FUNCTION eineListe.GetCount : Word;
BEGIN
  GetCount := _anzElem;
END;

FUNCTION eineListe.IsEmpty : Boolean;
BEGIN
  IsEmpty := (_root = NIL);
END;

FUNCTION eineListe.GetCurrPtr : Pointer;
BEGIN
  GetCurrPtr := _currPtr;
END;

PROCEDURE eineListe.SetCurrPtr (p : Pointer);
BEGIN
  IF (p = NIL) THEN IF NOT IsEmpty THEN Error (1); { das darf nicht sein! }
  _currPtr := p;
  _isEoL := IsEmpty; _isBoL := _isEoL;
END;

PROCEDURE eineListe.GoTop;
{ auf erstes Element positionieren }
BEGIN
  _currPtr := _root;
  _isEoL := IsEmpty; _isBoL := _isEoL;
END;

PROCEDURE eineListe.SeekEoL;
{ auf letztes Element positionieren }
BEGIN
  IF IsEmpty THEN EXIT;
  IF (_currPtr = NIL) THEN Error (1); { das darf nicht sein! }
  while (_currPtr^.next <> NIL) do _currPtr := _currPtr^.next;
  _isEoL := FALSE; _isBoL := FALSE;
END;

PROCEDURE eineListe.GotoItem (n : Word);
BEGIN
  IF (n < 1) THEN EXIT;
  GoTop;
  Skip (n-1);
END;

PROCEDURE eineListe.Skip (anzahlElem : Integer);
BEGIN
  IF IsEmpty THEN EXIT;
  IF (_currPtr = NIL) THEN Error (1); { das darf nicht sein! }
  _isBoL := FALSE; _isEoL := FALSE;
  IF (anzahlElem < 0) THEN BEGIN { rückwärts }
    WHILE (anzahlElem <> 0) do BEGIN
      IF (_currPtr^.prev = NIL) THEN BEGIN
      { Versuch, VOR den Anfang zu positionieren }
        _isBoL := TRUE;
        EXIT;
      END;
      _currPtr := _currPtr^.prev;
      Inc (anzahlElem);
    END;
  END ELSE BEGIN { vorwärts }
    WHILE (anzahlElem <> 0) do BEGIN
      if (_currPtr^.next = NIL) then BEGIN
      { Versuch, HINTER das Ende zu positionieren }
        _isEoL := TRUE;
        EXIT;
      END;
      _currPtr := _currPtr^.next;
      Dec (anzahlElem);
    END;
  END;
END;

FUNCTION  eineListe.BoL : Boolean;
{ wurde versucht, VOR den Anfang zu positionieren? }
BEGIN
  BoL := _isBoL;
END;

FUNCTION  eineListe.EoL : Boolean;
{ Ende der Liste gelesen? }
BEGIN
  EoL := _isEoL;
END;

PROCEDURE eineListe.Get (VAR element);
{ aktuelles Element lesen }
BEGIN
  if IsEmpty then EXIT;
  Move (_currPtr^.elementPtr^, element, _elemSize);
END;

PROCEDURE eineListe.Read (VAR element);
BEGIN
  Get (element);
  Skip (1);
END;

PROCEDURE eineListe.Put (VAR element);
{ element an akt. Position schreiben }
BEGIN
  if _isEoL OR _isBoL OR IsEmpty then EXIT;
  IF (_currPtr = NIL) THEN Error (1); { das darf nicht sein! }
  IF (_currPtr^.elementPtr = NIL) then EXIT;
  Move (element, _currPtr^.elementPtr^, _elemSize);
END;

PROCEDURE eineListe.Insert (VAR element);
{ element VOR akt. Position einfügen }
VAR p : einNodePtr;
BEGIN
  New (p);
  if IsEmpty then BEGIN  { Liste neu anlegen }
    _ResetList (@self, p);
  END else BEGIN
    p^.next := _currPtr;      { einklinken: next auf mom.Element }
    p^.prev := _currPtr^.prev;{ prev auf _currPtr^.prev }
    if (_currPtr^.prev <> NIL)
    then _currPtr^.prev^.next := p; { Vorgänger's next ist neuesElement }
    _currPtr^.prev := p;         { Vorgänger von mom ist neuesElement }
    _currPtr := p;               { _currPtr auf neuesElement setzen }
  END;
  IF (_currPtr = NIL) THEN Error (1); { das darf nicht sein! }
  GetMem (_currPtr^.elementPtr, _elemSize);
  _isEoL := FALSE;  _isBoL := FALSE;
  Put (element);
  Inc (_anzElem);
END;

PROCEDURE eineListe.Append (VAR element);
{ element ans Ende der Liste anhängen }
VAR p : einNodePtr;
BEGIN
  New (p);
  if IsEmpty then BEGIN  { Liste neu anlegen }
    _ResetList (@self, p);
  END else BEGIN
    SeekEoL;
    p^.prev := _currPtr;   { anhängen: Vorgänger ist momentanes Ende der Liste }
    p^.next := NIL;        { dies ist jetzt das Ende(! :) }
    _currPtr^.next := p;   { altes Ende einklinken }
    _currPtr := p;         { _currPtr auf neuesElement setzen }
  END;
  IF (_currPtr = NIL) THEN Error (1); { das darf nicht sein! }
  GetMem (_currPtr^.elementPtr, _elemSize);
  _isEoL := FALSE;  _isBoL := FALSE;
  Put (element);
  Inc (_anzElem);
END;

PROCEDURE eineListe.Delete;
{ element an aktueller Position löschen }
VAR p : einNodePtr;
BEGIN
  if IsEmpty then EXIT;
  p := _currPtr;

  if (p^.prev <> NIL)
  then p^.prev^.next := p^.next;
  if (p^.next <> NIL)
  then p^.next^.prev := p^.prev;

  IF (p = _root) THEN _root := p^.next;
                                    { erstes Element? -> weiter (bzw. root=NIL) }

  _isEoL := FALSE;  _isBoL := FALSE;
  IF (p^.next = NIL) AND (p^.prev = NIL) THEN BEGIN  { einziges Element? }
    _ResetList (@self, NIL);  { _root und _currPtr auf NIL; _isEoL, _isBoL = TRUE }
  END ELSE BEGIN  { mehr als ein Element.. }
    IF (_currPtr^.next <> NIL)          { kommt noch was nach? }
    THEN _currPtr := _currPtr^.next     { -> move forward }
    ELSE _currPtr := _currPtr^.prev;    { else move backward }
    IF (_currPtr = NIL) THEN Error (1); { das darf nicht sein! }
  END;

  FreeMem (p^.elementPtr, _elemSize);
  Dispose (p);
  Dec (_anzElem);
END;

{****** NO INIT ******}
END.

{ LISTS.T Testprogramm fuer Unit LISTS }
Program TestLists;
USES Lists;

CONST MAX = 100;
VAR
    liste : eineListe;
    element : Word;
    i : Integer;
BEGIN
 liste.Create (SizeOf (element));
 liste.GoTop;
 liste.SeekEoL;
 for element:=1 to MAX do BEGIN
   liste.Append (element);
 END;
 liste.GoTop;
 liste.Get (element);
 liste.Delete;
 liste.Get (element);
 liste.SeekEoL;
 liste.Skip (-1);
 liste.Get (element); WriteLn (element);
 While NOT liste.IsEmpty do BEGIN
   liste.Delete;
 END;
 liste.Remove;

(** hier noch ein praktisches Beispiel aus meiner Windows-Unit:
 Suche das angegebene Window in der Window-Liste und aktiviere es.

PROCEDURE GotoWindow (handle : einHandle);
{ activeWindow setzen }
VAR done : Boolean;
BEGIN
 SaveScreenParms;                                { Cursor, Farben etc. sichern }
 wList^.GoTop;                                               { Suche von vorne }
 REPEAT
   wList^.Get (activeWindow);                      { hole Handle aus der Liste }
   done := (activeWindow = handle) OR (wList^.EoL);    { found or End of list? }
   wList^.Skip (1);                                                { setzt EoL }
 UNTIL done;

 IF (activeWindow <> handle)
 THEN GotoWindow (firstWindow);    { falsches Handle -> FullScreen (rekursiv!) }
 SetScreenParms;   {setze neue Cursorposition, Farben}
END;
**)
END.