home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / ooplists / lists.pas
Pascal/Delphi Source File  |  1990-10-04  |  9KB  |  323 lines
  1. { DEFINE DEBUG}
  2. {$IFDEF TEST} {$R+,S+,I+,V+} {$ELSE} {$R-,S-,I-,V-} {$ENDIF}
  3. {$IFDEF DEBUG} {$D+} {$ELSE} {$D-} {$ENDIF}
  4.  
  5. UNIT Lists;
  6. { Diverse Listen-Strukturen
  7.   Martin Austermeier
  8.   Last Update : Thu  10-04-1990
  9.   Testprogramm siehe Dateiende
  10. }
  11. INTERFACE
  12.  
  13. TYPE
  14.  
  15.      einNodePtr = ^aNode;
  16.      aNode = OBJECT  { internal use only }
  17.        elementPtr : Pointer;  { wo ist das Listenelement gesp. }
  18.        prev,                            { vorhergehender }
  19.        next       : einNodePtr;         { nächster Node }
  20.      END;
  21.  
  22.      einListPtr = ^eineListe;
  23.      eineListe = OBJECT
  24.        _root,
  25.        _currPtr : einNodePtr;
  26.        _elemSize : Word;
  27.        _anzElem : Word;
  28.        _isEoL,
  29.        _isBoL   : Boolean;
  30.        CONSTRUCTOR Create (elementSize : Word);
  31.        DESTRUCTOR Remove;
  32.        FUNCTION GetCurrPtr : Pointer;  { zum merken einer best. Position }
  33.        PROCEDURE SetCurrPtr (p : Pointer);  { Direkter Sprung (RAW!) }
  34.         { **Achtung: keine Fehlerprüfung
  35.           (falls zB. das Element inzwischen gelöscht wurde..) }
  36.        FUNCTION IsEmpty : Boolean;
  37.        FUNCTION GetCount : Word;
  38.        PROCEDURE GoTop;     { auf erstes Element positionieren }
  39.        PROCEDURE SeekEoL;   { auf letztes Element positionieren }
  40.        PROCEDURE GotoItem (n : Word);
  41.                  { auf n'tes Element (erstes Element -> n=1) positionieren }
  42.        PROCEDURE Skip (anzahlElem : Integer); { Skip -1 --> previous }
  43.        FUNCTION  BoL : Boolean; { wurde vor den Anfang positioniert? }
  44.        FUNCTION  EoL : Boolean; { wurde hinter das Ende positioniert? }
  45.        PROCEDURE Get (VAR element);   { aktuelles Element lesen }
  46.        PROCEDURE Read (VAR element);   { aktuelles Element lesen & Skip(1) }
  47.        PROCEDURE Put (VAR element);   { element an akt. Position schreiben }
  48.        PROCEDURE Insert (VAR element);{ element VOR akt. Position einfügen }
  49.        PROCEDURE Append (VAR element); { element an Liste anhängen }
  50.        PROCEDURE Delete;              { element an aktueller Position löschen }
  51.      END;
  52.  
  53. IMPLEMENTATION
  54. { -------------------- eineListe --------------------- }
  55.  
  56. PROCEDURE Error (err : Integer);
  57. BEGIN
  58.   WriteLn; Writeln (#7'LISTS: Error', err);
  59.   HALT(1);
  60. END;
  61.  
  62. PROCEDURE _ResetList (lp : einListPtr; p : Pointer);
  63. { keine "Methode", da NON-PUBLIC }
  64. BEGIN
  65.   WITH lp^ DO BEGIN
  66.     _root := p;                  { _root = ^neuesElement }
  67.     _currPtr := _root;           { _currPtr = ^neuesElement }
  68.     IF (_currPtr <> NIL) THEN BEGIN
  69.       _currPtr^.next := NIL;       { the only one }
  70.       _currPtr^.prev := NIL;       { "" }
  71.     END;
  72.     _anzElem := 0;
  73.     _isEoL := TRUE; _isBoL := TRUE;
  74.   END;
  75. END;
  76.  
  77. CONSTRUCTOR eineListe.Create (elementSize : Word);
  78. BEGIN
  79.   _ResetList (@self, NIL);
  80.   _elemSize := elementSize;
  81. END;
  82.  
  83. DESTRUCTOR eineListe.Remove;
  84. BEGIN
  85.   GoTop;
  86.   While NOT IsEmpty do Delete;
  87. END;
  88.  
  89. FUNCTION eineListe.GetCount : Word;
  90. BEGIN
  91.   GetCount := _anzElem;
  92. END;
  93.  
  94. FUNCTION eineListe.IsEmpty : Boolean;
  95. BEGIN
  96.   IsEmpty := (_root = NIL);
  97. END;
  98.  
  99. FUNCTION eineListe.GetCurrPtr : Pointer;
  100. BEGIN
  101.   GetCurrPtr := _currPtr;
  102. END;
  103.  
  104. PROCEDURE eineListe.SetCurrPtr (p : Pointer);
  105. BEGIN
  106.   IF (p = NIL) THEN IF NOT IsEmpty THEN Error (1); { das darf nicht sein! }
  107.   _currPtr := p;
  108.   _isEoL := IsEmpty; _isBoL := _isEoL;
  109. END;
  110.  
  111. PROCEDURE eineListe.GoTop;
  112. { auf erstes Element positionieren }
  113. BEGIN
  114.   _currPtr := _root;
  115.   _isEoL := IsEmpty; _isBoL := _isEoL;
  116. END;
  117.  
  118. PROCEDURE eineListe.SeekEoL;
  119. { auf letztes Element positionieren }
  120. BEGIN
  121.   IF IsEmpty THEN EXIT;
  122.   IF (_currPtr = NIL) THEN Error (1); { das darf nicht sein! }
  123.   while (_currPtr^.next <> NIL) do _currPtr := _currPtr^.next;
  124.   _isEoL := FALSE; _isBoL := FALSE;
  125. END;
  126.  
  127. PROCEDURE eineListe.GotoItem (n : Word);
  128. BEGIN
  129.   IF (n < 1) THEN EXIT;
  130.   GoTop;
  131.   Skip (n-1);
  132. END;
  133.  
  134. PROCEDURE eineListe.Skip (anzahlElem : Integer);
  135. BEGIN
  136.   IF IsEmpty THEN EXIT;
  137.   IF (_currPtr = NIL) THEN Error (1); { das darf nicht sein! }
  138.   _isBoL := FALSE; _isEoL := FALSE;
  139.   IF (anzahlElem < 0) THEN BEGIN { rückwärts }
  140.     WHILE (anzahlElem <> 0) do BEGIN
  141.       IF (_currPtr^.prev = NIL) THEN BEGIN
  142.       { Versuch, VOR den Anfang zu positionieren }
  143.         _isBoL := TRUE;
  144.         EXIT;
  145.       END;
  146.       _currPtr := _currPtr^.prev;
  147.       Inc (anzahlElem);
  148.     END;
  149.   END ELSE BEGIN { vorwärts }
  150.     WHILE (anzahlElem <> 0) do BEGIN
  151.       if (_currPtr^.next = NIL) then BEGIN
  152.       { Versuch, HINTER das Ende zu positionieren }
  153.         _isEoL := TRUE;
  154.         EXIT;
  155.       END;
  156.       _currPtr := _currPtr^.next;
  157.       Dec (anzahlElem);
  158.     END;
  159.   END;
  160. END;
  161.  
  162. FUNCTION  eineListe.BoL : Boolean;
  163. { wurde versucht, VOR den Anfang zu positionieren? }
  164. BEGIN
  165.   BoL := _isBoL;
  166. END;
  167.  
  168. FUNCTION  eineListe.EoL : Boolean;
  169. { Ende der Liste gelesen? }
  170. BEGIN
  171.   EoL := _isEoL;
  172. END;
  173.  
  174. PROCEDURE eineListe.Get (VAR element);
  175. { aktuelles Element lesen }
  176. BEGIN
  177.   if IsEmpty then EXIT;
  178.   Move (_currPtr^.elementPtr^, element, _elemSize);
  179. END;
  180.  
  181. PROCEDURE eineListe.Read (VAR element);
  182. BEGIN
  183.   Get (element);
  184.   Skip (1);
  185. END;
  186.  
  187. PROCEDURE eineListe.Put (VAR element);
  188. { element an akt. Position schreiben }
  189. BEGIN
  190.   if _isEoL OR _isBoL OR IsEmpty then EXIT;
  191.   IF (_currPtr = NIL) THEN Error (1); { das darf nicht sein! }
  192.   IF (_currPtr^.elementPtr = NIL) then EXIT;
  193.   Move (element, _currPtr^.elementPtr^, _elemSize);
  194. END;
  195.  
  196. PROCEDURE eineListe.Insert (VAR element);
  197. { element VOR akt. Position einfügen }
  198. VAR p : einNodePtr;
  199. BEGIN
  200.   New (p);
  201.   if IsEmpty then BEGIN  { Liste neu anlegen }
  202.     _ResetList (@self, p);
  203.   END else BEGIN
  204.     p^.next := _currPtr;      { einklinken: next auf mom.Element }
  205.     p^.prev := _currPtr^.prev;{ prev auf _currPtr^.prev }
  206.     if (_currPtr^.prev <> NIL)
  207.     then _currPtr^.prev^.next := p; { Vorgänger's next ist neuesElement }
  208.     _currPtr^.prev := p;         { Vorgänger von mom ist neuesElement }
  209.     _currPtr := p;               { _currPtr auf neuesElement setzen }
  210.   END;
  211.   IF (_currPtr = NIL) THEN Error (1); { das darf nicht sein! }
  212.   GetMem (_currPtr^.elementPtr, _elemSize);
  213.   _isEoL := FALSE;  _isBoL := FALSE;
  214.   Put (element);
  215.   Inc (_anzElem);
  216. END;
  217.  
  218. PROCEDURE eineListe.Append (VAR element);
  219. { element ans Ende der Liste anhängen }
  220. VAR p : einNodePtr;
  221. BEGIN
  222.   New (p);
  223.   if IsEmpty then BEGIN  { Liste neu anlegen }
  224.     _ResetList (@self, p);
  225.   END else BEGIN
  226.     SeekEoL;
  227.     p^.prev := _currPtr;   { anhängen: Vorgänger ist momentanes Ende der Liste }
  228.     p^.next := NIL;        { dies ist jetzt das Ende(! :) }
  229.     _currPtr^.next := p;   { altes Ende einklinken }
  230.     _currPtr := p;         { _currPtr auf neuesElement setzen }
  231.   END;
  232.   IF (_currPtr = NIL) THEN Error (1); { das darf nicht sein! }
  233.   GetMem (_currPtr^.elementPtr, _elemSize);
  234.   _isEoL := FALSE;  _isBoL := FALSE;
  235.   Put (element);
  236.   Inc (_anzElem);
  237. END;
  238.  
  239. PROCEDURE eineListe.Delete;
  240. { element an aktueller Position löschen }
  241. VAR p : einNodePtr;
  242. BEGIN
  243.   if IsEmpty then EXIT;
  244.   p := _currPtr;
  245.  
  246.   if (p^.prev <> NIL)
  247.   then p^.prev^.next := p^.next;
  248.   if (p^.next <> NIL)
  249.   then p^.next^.prev := p^.prev;
  250.  
  251.   IF (p = _root) THEN _root := p^.next;
  252.                                     { erstes Element? -> weiter (bzw. root=NIL) }
  253.  
  254.   _isEoL := FALSE;  _isBoL := FALSE;
  255.   IF (p^.next = NIL) AND (p^.prev = NIL) THEN BEGIN  { einziges Element? }
  256.     _ResetList (@self, NIL);  { _root und _currPtr auf NIL; _isEoL, _isBoL = TRUE }
  257.   END ELSE BEGIN  { mehr als ein Element.. }
  258.     IF (_currPtr^.next <> NIL)          { kommt noch was nach? }
  259.     THEN _currPtr := _currPtr^.next     { -> move forward }
  260.     ELSE _currPtr := _currPtr^.prev;    { else move backward }
  261.     IF (_currPtr = NIL) THEN Error (1); { das darf nicht sein! }
  262.   END;
  263.  
  264.   FreeMem (p^.elementPtr, _elemSize);
  265.   Dispose (p);
  266.   Dec (_anzElem);
  267. END;
  268.  
  269. {****** NO INIT ******}
  270. END.
  271.  
  272. { LISTS.T Testprogramm fuer Unit LISTS }
  273. Program TestLists;
  274. USES Lists;
  275.  
  276. CONST MAX = 100;
  277. VAR
  278.     liste : eineListe;
  279.     element : Word;
  280.     i : Integer;
  281. BEGIN
  282.  liste.Create (SizeOf (element));
  283.  liste.GoTop;
  284.  liste.SeekEoL;
  285.  for element:=1 to MAX do BEGIN
  286.    liste.Append (element);
  287.  END;
  288.  liste.GoTop;
  289.  liste.Get (element);
  290.  liste.Delete;
  291.  liste.Get (element);
  292.  liste.SeekEoL;
  293.  liste.Skip (-1);
  294.  liste.Get (element); WriteLn (element);
  295.  While NOT liste.IsEmpty do BEGIN
  296.    liste.Delete;
  297.  END;
  298.  liste.Remove;
  299.  
  300. (** hier noch ein praktisches Beispiel aus meiner Windows-Unit:
  301.  Suche das angegebene Window in der Window-Liste und aktiviere es.
  302.  
  303. PROCEDURE GotoWindow (handle : einHandle);
  304. { activeWindow setzen }
  305. VAR done : Boolean;
  306. BEGIN
  307.  SaveScreenParms;                                { Cursor, Farben etc. sichern }
  308.  wList^.GoTop;                                               { Suche von vorne }
  309.  REPEAT
  310.    wList^.Get (activeWindow);                      { hole Handle aus der Liste }
  311.    done := (activeWindow = handle) OR (wList^.EoL);    { found or End of list? }
  312.    wList^.Skip (1);                                                { setzt EoL }
  313.  UNTIL done;
  314.  
  315.  IF (activeWindow <> handle)
  316.  THEN GotoWindow (firstWindow);    { falsches Handle -> FullScreen (rekursiv!) }
  317.  SetScreenParms;   {setze neue Cursorposition, Farben}
  318. END;
  319. **)
  320. END.
  321.  
  322.  
  323.