Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/LISTS12.ZIP/LISTS12.PAS

Pascal/Delphi Source File | 1993-01-04 | 6.5 KB | 275 lines

(*****************************************************************************
   Program:  Lists.Pas
   Author:   Mark Addleman
   Version:  1.2
   Date:     June 27, 1988
   Note:     Public domain software
             Please distribute in complete form


VERSION RECORD
1.0 - Gosh, I thought everything was right!
1.1 - Minor bug found in DisposeOfList routine
      If no windows were created, DisposeOfList would try to
      dispose of a NIL variable (List.FirstItem).  This is a no-no
1.2 - Bug in DeleteItemFromList routine
      If list contained only 1 item, the routine would not properly
      reclaim the used memory
******************************************************************************)







{$R-,S-,I-,D-,T-,F-,V+,B-,N-,L+ }
{$M 16384,0,655360 }
Unit Lists;

INTERFACE
Type
   ItemPtr                   =   ^ItemRec;
   ItemRec                   =   Record
                                    PrevItem   :   ItemPtr;
                                    NextItem   :   ItemPtr;
                                    Ptr        :   Pointer;
                                 End;

   ListRec                   =   Record
                                    FirstItem  :   ItemPtr;
                                    LastItem   :   ItemPtr;
                                    Item       :   ItemPtr;
                                    ListOK     :   Boolean;
                                 End;

Procedure InitList(Var List:ListRec);
Procedure AddToList(NewItem:Pointer; Var List:ListRec);
Procedure InsertInList(NewItem:Pointer; Var List:ListRec);
Procedure DeleteItemFromList(Var List:ListRec);

Function NextItemPtr(List:ListRec):Pointer;
Function PrevItemPtr(List:ListRec):Pointer;
Function LastItemPtr(List:ListRec):Pointer;
Function FirstItemPtr(List:ListRec):Pointer;
Function CurrentItemPtr(List:ListRec):Pointer;
Function ItemInList(Item:Pointer; List:ListRec):Boolean;

Procedure MoveToNextItem(Var List:ListRec);
Procedure MoveToPrevItem(Var List:ListRec);
Procedure MoveToFirstItem(Var List:ListRec);
Procedure MoveToLastItem(Var List:ListRec);
Procedure MoveToItem(Item:Pointer; Var List:ListRec);
Procedure DisposeOfList(Var List:ListRec);

IMPLEMENTATION

Procedure InitList(Var List:ListRec);
Begin
   With List Do Begin
      FirstItem:=nil; FirstItem^.PrevItem:=nil;
      LastItem:=nil;  LastItem^.NextItem:=nil;
      Item:=nil;
      With Item^ Do Begin
         NextItem:=nil;
         PrevItem:=nil;
         Ptr:=nil;
      End;
      ListOK:=True;
   End;
End;

Procedure AddToList(NewItem:Pointer; Var List:ListRec);
Begin
   With List Do
   If FirstItem=nil Then Begin
      New(FirstItem);

      With FirstItem^ Do Begin
         NextItem:=nil;
         PrevItem:=nil;
         Ptr:=NewItem;
      End;
      Item:=FirstItem;
      LastItem:=FirstItem;
   End
   Else Begin
      New(LastItem^.NextItem);

      LastItem^.NextItem^.PrevItem:=LastItem;

      LastItem:=LastItem^.NextItem;
      LastItem^.NextItem:=nil;
      LastItem^.Ptr:=NewItem;
   End;
End;

Procedure InsertInList(NewItem:Pointer; Var List:ListRec);
Var
   NewItemPtr                :   ItemPtr;

Begin
   With List Do
   If (Item=LastItem) or (Item=nil) Then AddToList(NewItem, List)
   Else
   If Not (FirstItem=nil) Then Begin
      New(NewItemPtr);

      With NewItemPtr^ Do Begin
         Ptr:=NewItem;
         PrevItem:=Item^.PrevItem;
         NextItem:=Item;
      End;

      With Item^ Do Begin
         PrevItem^.NextItem:=NewItemPtr;
         PrevItem:=NewItemPtr;
      End;

      If Item=FirstItem Then FirstItem:=NewItemPtr;
   End
   Else ListOK:=False;
End;

Function NextItemPtr(List:ListRec):Pointer;
Begin
   With List Do
   If Item^.NextItem=nil Then NextItemPtr:=nil
   Else NextItemPtr:=Item^.NextItem^.Ptr;
End;

Function PrevItemPtr(List:ListRec):Pointer;
Begin
   With List Do
   If Item^.PrevItem=nil Then PrevItemPtr:=nil
   Else PrevItemPtr:=Item^.PrevItem^.Ptr;
End;

Function FirstItemPtr(List:ListRec):Pointer;
Begin
   FirstItemPtr:=List.FirstItem^.Ptr;
End;

Function LastItemPtr(List:ListRec):Pointer;
Begin
   LastItemPtr:=List.LastItem^.Ptr;
End;

Function CurrentItemPtr(List:ListRec):Pointer;
Begin
   With List Do
   If Not (Item=nil) Then CurrentItemPtr:=Item^.Ptr
   Else ListOK:=False;
End;





Procedure MoveToNextItem(Var List:ListRec);
Begin
   With List Do
   If Not (Item^.NextItem=nil) Then Begin
      Item:=Item^.NextItem;
      ListOK:=True;
   End
   Else ListOK:=False;
End;

Procedure MoveToPrevItem(Var List:ListRec);
Begin
   With List Do
   If Not (Item^.PrevItem=nil) Then Begin
      Item:=Item^.PrevItem;
      ListOK:=True;
   End
   Else ListOK:=False;
End;

Procedure MoveToFirstItem(Var List:ListRec);
Begin
   With List Do
   If FirstItem=nil Then ListOK:=False
   Else Begin
      Item:=FirstItem;
      ListOK:=True;
   End;
End;

Procedure MoveToLastItem(Var List:ListRec);
Begin
   With List Do
   If FirstItem^.NextItem=nil Then ListOK:=False
   Else Begin
      Item:=LastItem;
      ListOK:=True;
   End;
End;

Procedure DeleteItemFromList(Var List:ListRec);
Var
   TempItem                  :   Pointer;

Begin
   With List Do Begin
      TempItem:=Item^.NextItem;
      If TempItem=nil Then TempItem:=Item^.PrevItem;

      If Not (Item=nil) Then Dispose(Item)
      Else ListOK:=False;

      If LastItem=FirstItem Then InitList(List)
      Else
      If Item=LastItem Then Begin
         LastItem:=LastItem^.PrevItem;
         LastItem^.NextItem:=nil;
      End
      Else
      If Item=FirstItem Then Begin
         FirstItem:=FirstItem^.NextItem;
         FirstItem^.PrevItem:=nil;
      End
      Else Begin
         Item^.PrevItem^.NextItem:=Item^.NextItem;
         Item^.NextItem^.PrevItem:=Item^.PrevItem;
      End;

      Item:=TempItem;
   End;
End;

Procedure DisposeOfList(Var List:ListRec);
Begin
   MoveToLastItem(List);
   If List.ListOK Then Begin
      Repeat
         DeleteItemFromList(List);
         MoveToPrevItem(List);
      Until Not List.ListOK;

      Dispose(List.FirstItem);
   End;

   InitList(List);
End;

Procedure MoveToItem(Item:Pointer; Var List:ListRec);
Begin
   If CurrentItemPtr(List)=Item Then Exit;

   MoveToFirstItem(List);
   While List.ListOK Do Begin
      If CurrentItemPtr(List)=Item Then Exit;
      MoveToNextItem(List);
   End;
End;

Function ItemInList(Item:Pointer; List:ListRec):Boolean;
Begin
   MoveToItem(Item, List);
   ItemInList:=List.ListOK;
End;

Begin
End.