Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/LSTS20.ZIP/LISTS.PAS

Pascal/Delphi Source File | 1988-07-16 | 8.9 KB | 351 lines

(*****************************************************************************
   Program:  Lists.Pas
   Author:   Mark Addleman
   Version:  2.0
   Date:     July 14, 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 items were added, 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

2.0 - Revision to make life easier
      - Renames of procedures/variables
        - AddToList              becomes   AddItem
        - InsertInList           becomes   InsertItem
        - DeleteItemFromList     becomes   DeleteItem
        - ListOK                 becomes   OK
      - Replaced routines
        - MoveTo______ routines replaced with MoveToItem
        - _____ItemPtr routines replaced with Item
      - New routines to process Stacks and Queues
        - PUSH and POP provided to act as a Last In First Out stack
        - Queue and Dequeue provided to act as a First In Last Out queue
      - No external routines are needed to process lists
        - Size of the Item is now taken as an argument
        - DeleteItem now truly deletes the item and its reference in the list
        - Pointers no longer necessary as arguments to AddItem and InsertItem
      - The name of the list ALWAYS comes first in the arguments
      - ItemInList is no longer implemented
******************************************************************************)



{$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;
                                    Size       :   Word;
                                 End;

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

Procedure InitList(Var List:ListRec);
Procedure AddItem(Var List:ListRec; Var _Item; _Size:Word);
Procedure InsertItem(Var List:ListRec; Var _Item; _Size:Word;Location:Pointer);

Procedure DeleteItem(Var List:ListRec; _Item:Pointer);
Procedure DeleteList(Var List:ListRec);

Function Item(List:ListRec; Location:ItemPtr):Pointer;

Procedure GetItem(Var List:ListRec; Location:ItemPtr; Var _Item);

Procedure MoveToItem(Var List:ListRec; Location:ItemPtr);

Function CurrentItem(List:ListRec):Pointer;
Function FirstItem(List:ListRec):Pointer;
Function LastItem(List:ListRec):Pointer;
Function NextItem(_Item:Pointer):Pointer;
Function PrevItem(_Item:Pointer):Pointer;

Procedure InitStack(Var Stack:ListRec);
Procedure Push(Var Stack:ListRec; Var Item; Size:Word);
Procedure Pop(Var Stack:ListRec; Var Item);
Procedure Queue(Var Stack:ListRec; Var Item; Size:Word);
Procedure DeQueue(Var Stack:ListRec; Var Item);


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;
      OK:=True;
   End;
End;

Procedure AddItem(Var List:ListRec; Var _Item; _Size:Word);
Begin
   With List Do
   If FirstItem=nil Then Begin
      New(FirstItem);

      With FirstItem^ Do Begin
         NextItem:=nil;
         PrevItem:=nil;

         GetMem(Ptr, _Size);
         Move(_Item, Ptr^, _Size);

         Size:=_Size;
      End;
      Item:=FirstItem;
      LastItem:=FirstItem;
   End
   Else Begin
      New(LastItem^.NextItem);

      LastItem^.NextItem^.PrevItem:=LastItem;

      LastItem:=LastItem^.NextItem;
      LastItem^.NextItem:=nil;

      GetMem(LastItem^.Ptr, _Size);
      Move(_Item, LastItem^.Ptr^, _Size);

      LastItem^.Size:=_Size;
   End;
End;

Procedure InsertItem(Var List:ListRec; Var _Item; _Size:Word;
                     Location:Pointer);
Var
   NewItem                   :   ItemPtr;

Begin
   If Location=nil Then Begin
      List.OK:=False;
      Exit;
   End
   Else List.OK:=True;

   With List Do Begin
      New(NewItem);
      With NewItem^ Do Begin
         GetMem(Ptr, _Size);
         Move(_Item, Ptr^, _Size);
         Size:=_Size;

         NextItem:=Location;
         PrevItem:=ItemRec(Location^).PrevItem;
      End;

      With ItemRec(Location^) Do Begin
         PrevItem^.NextItem:=NewItem;
         PrevItem:=NewItem;
      End;

      If FirstItem=nil Then Begin
         FirstItem:=NewItem;
         Item:=FirstItem;
      End;

      If LastItem=nil Then Begin
         LastItem:=NewItem;
         Item:=LastItem;
      End;

      If Location=FirstItem Then FirstItem:=NewItem;
   End;
End;


Procedure GetItem(Var List:ListRec; Location:ItemPtr; Var _Item);
Begin
   With Location^ Do Begin
      List.OK:=Not (Location=nil);
      If List.OK Then Move(Ptr^, _Item, Size);
   End;
End;



Function Item(List:ListRec; Location:ItemPtr):Pointer;
Begin
   Item:=ItemRec(Location^).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,List.Item^ Do
   If Not (Item=nil) Then CurrentItemPtr:=Ptr
   Else OK:=False;
End;




Procedure MoveToItem(Var List:ListRec; Location:ItemPtr);
Begin
   With List Do Begin
      OK:=Not (Location=nil);
      If OK Then Item:=Location;
   End;
End;

Function CurrentItem(List:ListRec):Pointer;
Begin
   CurrentItem:=List.Item;
End;

Function PrevItem(_Item:Pointer):Pointer;
Begin
   PrevItem:=ItemRec(_Item^).PrevItem;
End;

Function NextItem(_Item:Pointer):Pointer;
Begin
   NextItem:=ItemRec(_Item^).NextItem;
End;

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

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

Procedure DeleteItem(Var List:ListRec; _Item:Pointer);
Var
   TempItem                  :   Pointer;

Begin
   If (_Item=nil) or Not (List.OK) Then Begin
      List.OK:=False;
      Exit;
   End;

   With List Do
   If LastItem=FirstItem Then Begin
      FreeMem(LastItem^.Ptr, LastItem^.Size);
      Dispose(LastItem);
      InitList(List);
      TempItem:=nil;
   End
   Else Begin
      If (_Item=LastItem) or (_Item=FirstItem) Then Begin
         If _Item=LastItem Then Begin
            LastItem:=LastItem^.PrevItem;
            Dispose(LastItem^.NextItem);
            LastItem^.NextItem:=nil;
            TempItem:=LastItem;
         End;

         If _Item=FirstItem Then Begin
            FirstItem:=FirstItem^.NextItem;
            Dispose(FirstItem^.PrevItem);
            FirstItem^.PrevItem:=nil;
            TempItem:=FirstItem;
         End;
      End
      Else Begin
         With ItemRec(_Item^) Do Begin
            PrevItem^.NextItem:=NextItem;
            NextItem^.PrevItem:=PrevItem;
            TempItem:=PrevItem;
         End;
      End;

      FreeMem(_Item, SizeOf(ItemRec));
      FreeMem(ItemRec(_Item^).Ptr, ItemRec(_Item^).Size);
      OK:=True;
   End;

   If List.Item=_Item Then List.Item:=TempItem;
End;

Procedure DeleteList(Var List:ListRec);
Begin
   MoveToItem(List, FirstItem(List));

   With List Do
   While OK Do Begin
       FreeMem(Item^.Ptr, Item^.Size);
       Dispose(Item);
       MoveToItem(List, PrevItem(CurrentItem(List)));
   End;

   InitList(List);
End;



Procedure InitStack(Var Stack:ListRec);
Begin
   InitList(Stack);
End;

Procedure Push(Var Stack:ListRec; Var Item; Size:Word);
Begin
   AddItem(Stack, Item, Size);
End;

Procedure Pop(Var Stack:ListRec; Var Item);
Begin
   GetItem(Stack, LastItem(Stack), Item);
   DeleteItem(Stack, Pointer(Stack.Item));
End;

Procedure Queue(Var Stack:ListRec; Var Item; Size:Word);
Begin
   InsertItem(Stack, Item, Size, FirstItem(Stack));
End;

Procedure DeQueue(Var Stack:ListRec; Var Item);
Begin
   GetItem(Stack, FirstItem(Stack), Item);
   DeleteItem(Stack, Pointer(Stack.Item));
End;

END.