{############################################################################
 #  LINKED LIST IMPLEMENTATION        +----+   +----+   +----+   +----+
 #  WITH HEADER CELL              +-> | HD |<=>| E1 |<=>| E2 |<=>| E3 |<-+
 #                                |   +----+   +----+   +----+   +----+  |
 #                                |______________________________________|
 #                                          (Double linked list)
 #  by DAVE HEYLIGER - AMUS STAFF
 #
 #        1)  For the Driver Program, use a file called LIST.EXT that will
 #            define all necessary external func/proc of this module. LIST.
 #            EXT contains:  external function listmakenull....
 #                           external procudure listinsert.....
 #                             |          |         |
 #        2)  For this module, an INCLUDE file that contains the TYPE 
 #            declarations and a COMPARE and PRINT section must also be
 #            copied. It is in this file that you would change the TYPE
 #            meaning of listelement (a change in the listelement type
 #            would also require a change in PRINT/COMPARE). Include this
 #            file in your Driver program also.
 #
 #  LAST UPDATE: 08/20/85
 #
 ############################################################################}


MODULE LISTMOD;

{+-- Operations provided are the following:
 |
 |     listmakenull      - creates an empty list
 |
 |     listinsert        - inserts element x into list l right BEFORE the
 |                          p'th element in the list.
 |
 |     listretrieve      - retrieves from list l the element at position p
 |
 |     listdelete        - deletes from list l the element at position p
 |
 |     listfirst         - returns the first position of list l
 |
 |     listnext          - given a position p and list l it returns the next
 |                          position in l
 |
 |     listprevious      - given a position p and list l it returns the 
 |                          previous position in l
 |
 |     listend           - returns the postion list'end
 |
 |     listlocate        - returns position of first occurence of element x
 |                          in list l if existent, otherwise returns list'end
 |
 |     listprint         - outputs entire list l on file out using print
 |                          routine print to output an individual element
 |
 +--------------------------------------------------------------------------}

{$I list.typ}

function listmakenull(var l: list): listposition;
{+--- on entry - l list to be created and emptied
 |    on exit -  l is made empty, position list'end is returned
 +-------------------------------------------------------------}

begin { makenull }
new(l);
l^.right := l;
l^.left := l;
listmakenull := l;
end; { makenull }


procedure listinsert(x: listelement; p:listposition; var l: list);
{+--- on entry - x element to be inserted into list at position p
 |    on exit - x is inserted right BEFORE the p'th element in list l
 +---------------------------------------------------------------------}

var
  temp: listlink;

begin { listinsert }
new(temp);
p^.left^.right := temp;
temp^.left := p^.left;
temp^.right := p;
p^.left := temp;
temp^.element := x;
end; { listinsert }


function listretrieve(p: listposition; l: list): listelement;
{+--- on entry - retrieve p'th element from list l
 |    on exit  - returns p'th element from list l
 +---------------------------------------------------------------}

begin { listretrieve }
listretrieve := p^.element;
end; { listretrieve }


procedure listdelete(p: listposition; var l: list);
{+--- on entry -  delete p'th element from list l
 |    on exit - p'th element deleted from list l
 +----------------------------------------------------}

begin { listdelete }
p^.left^.right := p^.right;
p^.right^.left := p^.left;
end; { listdelete }


function listfirst(l: list): listposition;
{+--- on entry - return first postion of list l 
 |    on exit - returned first postion of list l
 +-----------------------------------------------------}

begin { listfirst }
listfirst := l^.right;
end; { listfirst }


function listnext(p: listposition; l: List): listposition;
{+-- on entry - with respect to postion p return the next position of list l
 |   on exit -  returned the next position
 +--------------------------------------------------------------------------}

begin { listnext }
listnext := p^.right;
end; { listnext }


function listprevious(p: listposition; l: list): listposition;
{+-- on entry - with respect to position p return the previous element in list l
 |   on exit -  returned the previous position in list l
 +---------------------------------------------------------------------------}

begin { listprevious }
listprevious := p^.left;
end; { listprevious }


function listend(l: list): listposition;
{+-- on entry - return the list'end posiiton of list l
 |   on exit - returned the list'end position of list l
 +-----------------------------------------------------}

begin  { listend }
listend := l;
end;  { listend }


function listlocate(x: listelement; l: list): listposition;
{+-- on entry - return the posiiton of first occurrence of x in list l,
 |               if x is not in l return list'end,
 |               compare determines equality of elements...IMPORTED.
 |    on exit  - returned position of first occurrence of x or list'end
 |
 |    compare is defined in  $I list.typ 
 +---------------------------------------------------------------------------}

var
  temp: listlink;
  found: boolean;
 
begin { listlocate }
temp := l^.right;
found := false;
while (temp <> l) and not found do
   if compare(x,temp^.element) = 0 then found := true
                                   else temp := temp^.right;
if found then listlocate := temp
         else listlocate := l;
end; { listlocate }


procedure listprint(l: list; var out:text);
{+- on entry - print list l on file out using routine print to each individual
 |             element 
 |  on exit - list is printed on file out
 |
 |  print is defined in  $I list.typ 
 +--------------------------------------------------------------------------}
var
  temp: listlink;

begin { listprint }
temp := l^.right;
while temp <> l do
   begin { print element }
   print(out,temp^.element);
   temp := temp^.right;
   end; { print element }
end; { listprint }
.

.