home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / PROGJRN / PJ_7_6.ARC / ULIST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-08-18  |  3.6 KB  |  164 lines
  1. (* ulist.pas -- (c) 1989 by Tom Swan *)
  2.  
  3. unit ulist;
  4.  
  5. interface
  6.  
  7. uses uitem;
  8.  
  9. type
  10.  
  11.    listPtr = ^list;
  12.    list = object( item )
  13.       anchor : itemPtr;    { Addresses list head }
  14.       cip : itemPtr;       { Current item pointer }
  15.       constructor init;
  16.       destructor done; virtual;
  17.       function listEmpty : Boolean;
  18.       function atHeadOfList : Boolean;
  19.       function atEndOfList : Boolean;
  20.       function currentItem : itemPtr;
  21.       procedure prevItem;
  22.       procedure nextItem;
  23.       procedure resetList;
  24.       procedure insertItem( ip : itemPtr ); virtual;
  25.       procedure removeItem( ip : itemPtr ); virtual;
  26.       procedure processItems; virtual;
  27.       procedure disposeList; virtual;
  28.    end;
  29.  
  30. implementation
  31.  
  32. { ----- Initialize an empty list. }
  33.  
  34. constructor list.init;
  35. begin
  36.    anchor := nil;
  37.    cip := nil;
  38.    item.init;
  39. end;
  40.  
  41. { ----- Dispose any listed items and the list object itself. }
  42.  
  43. destructor list.done;
  44. begin
  45.    if anchor <> nil
  46.       then disposeList;
  47.    item.done;
  48. end;
  49.  
  50. { ----- Return true if list is empty. }
  51.  
  52. function list.listEmpty : Boolean;
  53. begin
  54.    listEmpty := ( anchor = nil );
  55. end;
  56.  
  57. { ----- Return true if current item is at the head of the list. }
  58.  
  59. function list.atHeadOfList : Boolean;
  60. begin
  61.    atHeadOfList := ( anchor <> nil ) and ( cip = anchor );
  62. end;
  63.  
  64. { ----- Return true if current item is at the end of the list. }
  65.  
  66. function list.atEndOfList : Boolean; 
  67. begin
  68.    atEndOfList := ( anchor <> nil ) and ( cip = anchor^.left );
  69. end;
  70.  
  71. { ----- Return item addressed by current item pointer (cip). }
  72.  
  73. function list.currentItem : itemPtr;
  74. begin
  75.    currentItem := cip;
  76. end;
  77.  
  78. { ----- Move current pointer to previous item in list. }
  79.  
  80. procedure list.prevItem;
  81. begin
  82.    if cip <> nil
  83.       then cip := cip^.left;
  84. end;
  85.  
  86. { ----- Move current pointer to next item in list. }
  87.  
  88. procedure list.nextItem;
  89. begin
  90.    if cip <> nil
  91.       then cip := cip^.right;
  92. end;
  93.  
  94. { ----- Reset list. currentItem will return first item inserted. }
  95.  
  96. procedure list.resetList;
  97. begin
  98.    cip := anchor;
  99. end;
  100.  
  101. { ----- Insert item addressed by ip ahead of current item. }
  102.  
  103. procedure list.insertItem( ip : itemPtr );
  104. begin
  105.    if ip <> nil then       { Prevent out-of-memory disasters }
  106.    if anchor = nil then    { If list is empty ... }
  107.    begin
  108.       anchor := ip;        {  then start a new list }
  109.       resetList;           {  and initialize current item }
  110.    end else
  111.       ip^.link( cip );     {  else link item into list at cip }
  112. end;
  113.  
  114. { ----- Remove listed item addressed by ip and adjust anchor if
  115. necessary to make sure that anchor and cip don't address the removed
  116. item. }
  117.  
  118. procedure list.removeItem( ip : itemPtr );
  119. begin
  120.    if ip^.right = ip then  { If only one list item ... }
  121.    begin
  122.       anchor := nil;       {  then empty the list }
  123.       cip := nil;
  124.    end else                {  else adjust anchor and cip }
  125.    begin
  126.       if ip = anchor 
  127.          then anchor := anchor^.right; 
  128.       if cip = ip
  129.          then cip := cip^.right;
  130.    end;
  131.    ip^.unlink;
  132. end;
  133.  
  134. { ----- Process all listed items. }
  135.  
  136. procedure list.processItems;
  137. begin
  138.    resetList;
  139.    if currentItem <> nil then
  140.    repeat
  141.       currentItem^.processItem;
  142.       nextItem;
  143.    until atHeadOfList;
  144. end;
  145.  
  146. { ----- Dispose items in a list. }
  147.  
  148. procedure list.disposeList;
  149. var
  150.    ip : itemPtr;
  151. begin
  152.    while not listEmpty do
  153.    begin
  154.       ip := currentItem;
  155.       removeItem( ip );
  156.       if ( seg( ip^ ) <> DSeg ) and ( seg( ip^ ) <> SSeg )
  157.          then dispose( ip, done )
  158.          else ip^.done;
  159.    end; { while }
  160. end;
  161.  
  162. end.
  163.  
  164.