(* Link list stuff. Not wrote by me. And these should be removed sometime *)
unit linklist;

Interface

Uses DOS, CRT;


Type
  DLLNodePtr = ^DLLNodeObj;
  pDLLNodeOBJ = ^DLLNodeOBJ;
  DLLNodeOBJ = Object         {this object is not extensible}
                 vNextPtr: DLLNodePtr;
                 vPrevPtr: DLLNodePtr;
                 vDataPtr: Pointer;
                 vSize: LongInt;
                 vStatus: Byte;   {selectable, selected}
                 {methods...}
                 Procedure FreeData;
                 Function  NextPtr: DLLNodePtr;
                 Function  PrevPtr: DLLNodePtr;
                 Function  GetStatus (BitPos: Byte): Boolean;
                 Procedure SetStatus (BitPos: Byte; On: Boolean);
                 Function  GetStatusByte: Byte;
                 Procedure SetStatusByte (Val: Byte);
               End; {DLLNodeOBJ}

  DLLPtr = ^DLLOBJ;
  pDLLOBJ = ^DLLOBJ;
  DLLOBJ = Object
             vStartNodePtr:  DLLNodePtr;
             vEndNodePtr:    DLLNodePtr;
             vActiveNodePtr: DLLNodePtr;
             vTotalNodes:       LongInt;
             vActiveNodeNumber: LongInt;
             vSortID:           ShortInt;
             vSortAscending:    Boolean;
             vSorted:           Boolean;
             vMaxNodeSize :     LongInt;
             {methods...}
             Constructor Init;
             Function    Add (Var TheData; Size: LongInt): Integer;
             Function    Change (Node: DLLNodePtr; Var TheData; Size: LongInt): Integer;
             Function    InsertBefore (Node: DLLNodePtr; Var TheData; Size: LongInt): Integer;
             Procedure   Get (Var TheData);
             Procedure   GetNodeData (Node: DLLNodePtr; Var TheData);
             Function    GetNodeDataSize (Node: DLLNodePtr): LongInt;
             Function    GetMaxNodeSize: LongInt;
             Procedure   Advance (Amount: LongInt);
             Procedure   Retreat (Amount: LongInt);
             Function    NodePtr (NodeNumber: LongInt): DLLNodePtr;
             Procedure   Jump (NodeNumber: LongInt);
             Procedure   ShiftActiveNode (NewNode: DLLNodePtr; NodeNumber: LongInt);
             Procedure   DelNode (Node: DLLNodePtr);
             Procedure   DelAllStatus (BitPos: Byte; On: Boolean);
             Function    TotalNodes: LongInt;
             Function    ActiveNodeNumber: LongInt;
             Function    ActiveNodePtr: DLLNodePtr;
             Function    StartNodePtr: DLLNodePtr;
             Function    EndNodePtr: DLLNodePtr;
             Procedure   EmptyList;
             Procedure   Sort (SortID: ShortInt; Ascending: Boolean);
             Function    WrongOrder (Node1, Node2: DLLNodePtr; Asc: Boolean): Boolean; Virtual;
             Procedure   SwapNodes (Node1, Node2: DLLNodePtr);                       Virtual;
             Function    GetStr (Node: DLLNodePtr; Start, Finish: LongInt): String;    Virtual;
             Destructor  Done;
           End; {DLLOBJ}

Function Subdirectory (B : Byte): Boolean;
Function Drive (B : Byte): Boolean;
Function FileAttribs (B: Byte): String;

Implementation

Function Subdirectory (B : Byte): Boolean;
Begin
  Subdirectory := (B And Directory) = Directory;
End; {Subdirectory}

Function Drive (B : Byte): Boolean;
Begin
  Drive := (B And VolumeID) = VolumeID;
End; {Subdirectory}

Function FileAttribs (B: Byte): String;
Var
  S : String;
Begin
  S := '    ';
  If ( (B And ReadOnly) = ReadOnly) Then
    S [1] := 'R';
  If ( (B And Hidden) = Hidden) Then
    S [2] := 'H';
  If ( (B And SysFile) = SysFile) Then
    S [3] := 'S';
  If ( (B And Archive) = Archive) Then
    S [4] := 'A';
  FileAttribs := S;
End; {FileAttribs}

Procedure DLLNodeObj. FreeData;
{}
Begin
  If (vDataPtr <> Nil) And (vSize > 0) Then
  Begin
    FreeMem (vDataPtr, vSize);
    vDataPtr := Nil;
    vSize := 0;
  End;
End; {DLLNodeObj.FreeData}

Function DLLNodeObj. NextPtr: DLLNodePtr;
{}
Begin
  NextPtr := vNextPtr;
End; {DLLNodeOBJ.NextPtr}

Function DLLNodeObj. PrevPtr: DLLNodePtr;
{}
Begin
  PrevPtr := vPrevPtr;
End; {DLLNodeOBJ.PrevPtr}

Function DLLNodeObj. GetStatus (BitPos: Byte): Boolean;
{}
Var TestByte: Byte;
Begin
  If BitPos > 7 Then
    GetStatus := False
  Else
  Begin
    Testbyte := vStatus;
    TestByte := TestByte ShR BitPos; {move to end bit}
    GetStatus := Odd (TestByte);
  End;
End; {DLLNodeOBJ.GetStatus}

Procedure DLLNodeObj. SetStatus (BitPos: Byte; On: Boolean);
{}
Var
  Test : Integer;
Begin
  If BitPos <= 7 Then
  Begin
    If On Then
    Begin
      Test := 1 ShL BitPos;
      vStatus := vStatus Or Test
    End
    Else
    Begin
      Test := Not (1 ShL BitPos);
      vStatus := vStatus And Test;
    End;
  End;
End; { DLLNodeObj.SetStatus }

Function DLLNodeObj. GetStatusByte: Byte;
{}
Begin
  GetStatusByte := vStatus;
End; {DLLNodeObj.GetStatusByte}

Procedure DLLNodeObj. SetStatusByte (Val: Byte);
{}
Begin
  vStatus := Val;
End; {DLLNodeObj.SetStatusByte}

Constructor DLLOBJ. Init;
{}
Begin
  vStartNodePtr := Nil;
  vEndNodePtr := Nil;
  vActiveNodePtr := Nil;
  vTotalNodes := 0;
  vActiveNodeNumber := 0;
  vSortID := 0;
  vSortAscending := True;
  vSorted := True;
  vMaxNodeSize := 0;
End; {DLLOBJ.Init}

Function DLLOBJ. Add (Var TheData; Size: LongInt): Integer;
Var
  Temp: DLLNodePtr;
Begin
  If MaxAvail < SizeOf (vStartNodePtr^) Then
  Begin
    Add := 1;  {not enough memory}
    Exit;
  End;
  If vStartNodePtr = Nil Then
  Begin
    GetMem (vStartNodePtr, SizeOf (vStartNodePtr^) );
    vStartNodePtr^. vPrevPtr := Nil;
    vActiveNodePtr := vStartNodePtr;
    vActiveNodePtr^. vNextPtr := Nil;
    vActiveNodeNumber := 1;
    vEndNodePtr := vActiveNodePtr;
  End
  Else
  Begin
    If vActiveNodePtr^. vNextPtr = Nil Then
    Begin
      GetMem (vActiveNodePtr^. vNextPtr, SizeOf (vActiveNodePtr^) );
      vActiveNodePtr^. vNextPtr^. vPrevPtr := vActiveNodePtr;
      vActiveNodePtr := vActiveNodePtr^. vNextPtr;
      vActiveNodePtr^. vNextPtr := Nil;
      Inc (vActiveNodeNumber);
      vEndNodePtr := vActiveNodePtr;
    End
    Else  {insert a node}
    Begin
      GetMem (Temp, SizeOf (temp^) );
      vActiveNodePtr^. vNextPtr^. vPrevPtr := Temp;
      Temp^. vNextPtr := vActiveNodePtr^. vNextPtr;
      Temp^. vPrevPtr := vActiveNodePtr;
      vActiveNodePtr^. vNextPtr := Temp;
      vActiveNodePtr := Temp;
      Inc (vActiveNodeNumber);
    End;
  End;
  Inc (vTotalNodes);
  {now add the data to the node data pointer}
  If MemAvail < Size Then
  Begin
    Add := 2;   {not enough memory for data}
    vActiveNodePtr^. vSize := 0;
    vActiveNodePtr^. vDataPtr := Nil;
    Exit;
  End;
  If Size > 0 Then
  Begin
    GetMem (vActiveNodePtr^. vDataPtr, Size);
    Move (TheData, vActiveNodePtr^. vDataPtr^, Size);
    If Size > vMaxNodeSize Then
      vMaxNodeSize := Size;
  End
  Else
    vActiveNodePtr^. vDataPtr := Nil;
  vActiveNodePtr^. vSize := Size;
  vActiveNodePtr^. vStatus := 0;
  vSorted := False;  {1.00d}
  Add := 0;
End; {DLLOBJ.Add}

Function DLLOBJ. Change (Node: DLLNodePtr; Var TheData; Size: LongInt): Integer;

Begin
  If node = Nil Then
    Change := 3
  Else
  Begin
    Node^. FreeData;
    If MaxAvail < Size Then
      Change := 2
    Else
    Begin
      Change := 0;
      GetMem (Node^. vDataPtr, Size);
      Move (TheData, Node^. vDataPtr^, Size);

      Node^. vSize := Size;
      vSorted := False;  {1.00d}
    End;
  End;
End; {DLLOBJ.Change}

Function DLLOBJ. InsertBefore (Node: DLLNodePtr; Var TheData; Size: LongInt): Integer;

Var
  Temp: DLLNodePtr;
Begin
  If node = Nil Then
    InsertBefore := 3
  Else If MaxAvail < SizeOf (Node^) Then
    InsertBefore := 1  {not enough memory}
  Else
  Begin
    If Node = vStartNodePtr Then {add to head of list}
    Begin
      GetMem (Node^. vPrevPtr, SizeOf (Node^) );
      Node^. vPrevPtr^. vNextPtr := Node;
      Node := Node^. vPrevPtr;
      Node^. vPrevPtr := Nil;
      vStartNodePtr := Node;
    End
    Else
    Begin
      GetMem (Temp, SizeOf (Temp^) );
      Node^. vPrevPtr^. vNextPtr := Temp;
      Temp^. vPrevPtr := Node^. PrevPtr;
      Node^. vPrevPtr := Temp;
      Temp^. vNextPtr := Node;
      Node := Temp;
    End;
    Inc (vTotalNodes);
    vActiveNodeNumber := 1;
    vActiveNodePtr := vStartNodePtr;
    if MemAvail < Size Then
    Begin
      InsertBefore := 2;   {not enough memory for data}
      Node^. vSize := 0;
      Node^. vDataPtr := Nil;
    End
    Else
    Begin
      If Size > 0 Then
      Begin
        GetMem (Node^. vDataPtr, Size);
        Move (TheData, Node^. vDataPtr^, Size);
      End
      Else
        Node^. vDataPtr := Nil;
      Node^. vSize := Size;
      InsertBefore := 0;
    End;
  End;
  vSorted := False;  {1.00d}
End; {DLLOBJ.InsertBefore}

Procedure DLLOBJ. Get (Var TheData);
Begin
  With vActiveNodePtr^ do
    If vDataPtr <> Nil Then
      Move (vDataPtr^, TheData, vSize);
End; {DLLOBJ.Get}

Procedure DLLOBJ. GetNodeData (Node: DLLNodePtr; Var TheData);
Begin
  With Node^ do
    If vDataPtr <> Nil Then
      Move (vDataPtr^, TheData, vSize);
End; {DLLOBJ.GetNodedata}

Function DLLOBJ. GetNodeDataSize (Node: DLLNodePtr): LongInt;
{}
Begin
  With Node^ do
  Begin
    If vDataPtr = Nil Then
      GetNodeDataSize := 0
    Else
      GetNodeDataSize := vSize;
  End;
End; {DLLOBJ.GetNodeDataSize}

Function DLLOBJ. GetMaxNodeSize: LongInt;
{}
Begin
  GetMaxNodeSize := vMaxNodeSize;
End; {DLLOBJ.GetMaxNodeSize}

Function DLLOBJ. GetStr (Node: DLLNodePtr; Start, Finish: LongInt): String;
Var temp: String;
Begin
  If Start < 0 Then Start := 0;
  If Finish < 0 Then Finish := 0;
  If ( (Finish = 0) And (Start = 0) )
     Or (Start > Finish)
  Then   {get full string}
  Begin
    Start := 1;
    Finish := 255;
  End
  Else If Finish - Start > 254 Then      {too long to fit in string}
    Finish := Start + 254;

  If (Node = Nil)
     Or (Node^. vDataPtr = Nil)
     Or (Node^. vSize = 0)
     Or (Start > Node^. vSize)
  Then
    GetStr := ''
  Else
  Begin
    If Finish > Node^. vSize Then
      Finish := Node^. vSize;
    If Start = 0 Then
      Inc (Start);
    Move (mem [Seg (Node^. vDataPtr^): Ofs (Node^. vDataPtr^) + Pred (Start) ], Temp [1], Succ (Finish - Start) );
    Temp [0] := Chr (Succ (Finish - Start) );
    GetStr := Temp;
  End;
End; {DLLOBJ.GetStr}

Procedure DLLOBJ. Advance (Amount: LongInt);
{}
Var
  I : LongInt;
Begin
  for I := 1 to Amount do
    If vActiveNodePtr^. vNextPtr <> Nil Then
    Begin
      vActiveNodePtr := vActiveNodePtr^. vNextPtr;
      Inc (vActiveNodeNumber);
    End;
End; {DLLOBJ.Advance}

Procedure DLLOBJ. Retreat (Amount: LongInt);
{}
Var
  I : LongInt;
Begin
  for I := 1 to Amount do
    If vActiveNodePtr^. vPrevPtr <> Nil Then
    Begin
      vActiveNodePtr := vActiveNodePtr^. vPrevPtr;
      Dec (vActiveNodeNumber);
    End;
End; {DLLOBJ.Retreat}

Procedure DLLOBJ. Jump (NodeNumber: LongInt);
{}
Begin
  If NodeNumber = 1 Then
  Begin
    vActiveNodePtr := vStartNodePtr;
    vActiveNodeNumber := 1;
  End
  Else
  Begin
    If NodeNumber < vActiveNodeNumber Then
      Retreat (vActiveNodeNumber - NodeNumber)
    Else
      Advance (NodeNumber - vActiveNodeNumber);
  End;
End; {DLLOBJ.Jump}

Procedure DLLOBJ. ShiftActiveNode (NewNode: DLLNodePtr; NodeNumber: LongInt);
{}
Begin
  vActiveNodePtr := NewNode;
  vActiveNodeNumber := NodeNumber;
End; {DLLOBJ.ShiftActiveNode}

Function DLLOBJ. NodePtr (NodeNumber: LongInt): DLLNodePtr;
{}
Var
  StartNode: DLLNodePtr;
  DistanceA,
  DistanceB,
  DistanceC,
  Counter,
  I: LongInt;
  Forwards : Boolean;
  Indicator : Byte;
Begin
  If (NodeNumber < 1) Or (NodeNumber > vTotalNodes) Then
    NodePtr := Nil
  Else
  Begin
    If NodeNumber = 1 Then
      NodePtr := vStartNodePtr
    Else If NodeNumber = vTotalNodes Then
      NodePtr := vEndNodePtr
    Else If NodeNumber = vActiveNodeNumber Then
      NodePtr := vActiveNodePtr
    Else
    Begin
      {check for the nearest node ptr, and jump from there}
      DistanceA := Abs (NodeNumber - vActiveNodeNumber);
      DistanceB := NodeNumber;
      DistanceC := vTotalNodes - NodeNumber;
      If DistanceA < DistanceB Then
      Begin
        If DistanceA < DistanceC Then
        Begin
          StartNode := vActiveNodePtr;
          Forwards := (vActiveNodeNumber < NodeNumber);
          Counter := DistanceA;
        End
        Else
        Begin
          StartNode := vEndNodePtr;
          Forwards := False;
          Counter := DistanceC;
        End;
      End
      Else      {DA > DB}
      Begin
        If DistanceB < DistanceC Then
        Begin
          StartNode := vStartNodePtr;
          Forwards := True;
          Counter := Pred (DistanceB);
        End
        Else
        Begin
          StartNode := vEndNodePtr;
          Forwards := False;
          Counter := DistanceC;
        End;
      End;
      If Forwards Then
        for I := 1 to Counter do
          StartNode := StartNode^. NextPtr
      Else
        for I := 1 to Counter do
          StartNode := StartNode^. PrevPtr;
      NodePtr := StartNode;

    End;
  End;
End; {DLLOBJ.NodePtr}

Function DLLOBJ. TotalNodes: LongInt;
{}
Begin
  TotalNodes := vTotalNodes;
End;

Function DLLOBJ. ActiveNodeNumber: LongInt;
{}
Begin
  ActiveNodeNumber := vActiveNodeNumber;
End;

Function DLLOBJ. StartNodePtr: DLLNodePtr;
{}
Begin
  StartNodePtr := vStartNodePtr;
End; {DLLOBJ.StartNodePtr}

Function DLLOBJ. EndNodePtr: DLLNodePtr;
{}
Begin
  EndNodePtr := vEndNodePtr;
End; {DLLOBJ.EndNodePtr}

Function DLLOBJ. ActiveNodePtr: DLLNodePtr;
{}
Begin
  ActiveNodePtr := vActiveNodePtr;
End; {DLLOBJ.ActiveNodePtr}

Procedure DLLOBJ. SwapNodes (Node1, Node2: DLLNodePtr);
{}
Var
  Ptr1: Pointer;
  Size1, Size2: LongInt;
  Status1: Byte;
  Ecode: Integer;
Begin
  Status1 := Node1^. GetStatusByte;
  Node1^. SetStatusByte (Node2^. GetStatusByte);
  Node2^. SetStatusByte (Status1);
  Size1 := GetNodeDataSize (Node1);
  If Size1 > 0 Then
  Begin
   GetMem (Ptr1, Size1);
   GetNodeData (Node1, Ptr1^);
  End;
  Size2 := GetNodeDataSize (Node2);
  Ecode := Change (Node1, Node2^. vDataPtr^, Size2);
  Ecode := Change (Node2, Ptr1^, Size1);
  If Size1 > 0 Then
    FreeMem (Ptr1, Size1);
End; {DLLOBJ.SwapNodes}

Procedure DLLOBJ. DelNode (Node: DLLNodePtr);
{}
Begin
  If Node <> Nil Then  {1.00b}
  Begin
    If vActiveNodePtr = Node Then   {move active ptr to next entry in list}
    Begin
      If vActiveNodePtr^. vNextPtr = Nil Then
      Begin
        Dec (vActiveNodeNumber);
        vActiveNodePtr := vActiveNodePtr^. vPrevPtr;
      End
      Else
        vActiveNodePtr := vActiveNodePtr^. vNextPtr;
    End;
    If Node = vStartNodePtr Then
    Begin
      If Node^. vNextPtr = Nil Then {only node in list}
      Begin
        Node^. FreeData;
        FreeMem (vStartNodePtr, SizeOf (vStartNodePtr^) );
        vStartNodePtr := Nil;
        vEndNodePtr := Nil;
      End
      Else
      Begin
        vStartNodePtr := vStartNodePtr^. vNextPtr;
        vStartNodePtr^. vPrevPtr := Nil;
        Node^. FreeData;
        FreeMem (Node, SizeOf (Node^) );
      End;
    End
    Else
    Begin
      Node^. vPrevPtr^. vNextPtr := Node^. vNextPtr;
      If Node = vEndNodePtr Then
        vEndNodePtr := vEndNodePtr^. vPrevPtr
      Else
        Node^. vNextPtr^. vPrevPtr := Node^. vPrevPtr;
      Node^. FreeData;
      FreeMem (Node, SizeOf (Node^) );
    End;
    Dec (vTotalNodes);
    vSorted := False;  {1.00d}
  End;
End; {DLLOBJ.DelNode}

Procedure DLLOBJ. DelAllStatus (BitPos: Byte; On: Boolean);
{}
Var
  TempPtr, TempNextPtr: DLLNodePtr;
Begin
  If vStartNodePtr <> Nil Then
  Begin
    TempPtr := vStartNodePtr;
    TempNextPtr := TempPtr^. NextPtr;
    While TempNextPtr <> Nil do
    Begin
      If TempNextPtr^. GetStatus (BitPos) = On Then
        DelNode (TempNextPtr)
      Else
        TempPtr := TempPtr^. NextPtr;
      TempNextPtr := TempPtr^. NextPtr;
    End;
    If vStartNodePtr^. GetStatus (BitPos) = On Then
      DelNode (vStartNodePtr);
    vSorted := False;  {1.00d}
  End;
End; {DLLOBJ.DelAllStatus}

Function DLLOBJ. WrongOrder (Node1, Node2: DLLNodePtr; Asc: Boolean): Boolean;
{abstract}
Begin
  WrongOrder := False;
End; {DLLOBJ.WrongOrder}

Procedure DLLOBJ. Sort (SortID: ShortInt; Ascending: Boolean);
{Shell sort}
Var
  I, J, Delta : LongInt;
  Swapped : Boolean;
  Ptr1, Ptr2 : DLLNodePtr;
Begin
  If ( (vSortID <> SortID) Or (vSortAscending <> Ascending) Or (vSorted = False) )
     And (vTotalNodes >= 2)
  Then
  Begin
    vSortID := SortID;
    vSortAscending := Ascending;
    Delta := vTotalNodes Div 2;
    Repeat
      Repeat
        Swapped := False;
        Ptr1 := vStartNodePtr;
        Ptr2 := Ptr1;
        for I := 1 to Delta do
          Ptr2 := Ptr2^. vNextPtr;
        for I := 1 to vTotalNodes - Delta do
        Begin
          If I > 1 Then
          Begin
            Ptr1 := Ptr1^. vNextPtr;
            Ptr2 := Ptr2^. vNextPtr;
          End;
          If WrongOrder (Ptr1, Ptr2, vSortAscending) Then
          Begin
            SwapNodes (Ptr1, Ptr2);
            Swapped := True;
          End;
        End;
      Until (Not Swapped);
      Delta := Delta Div 2;
    Until Delta = 0;
  End;
  vSorted := True;
End; {DLLOBJ.Sort}

Procedure DLLOBJ. EmptyList;
Var TempPtr: DLLNodePtr;
Begin
  TempPtr := vEndNodePtr;
  If vEndNodePtr <> Nil Then
    While TempPtr^. vPrevPtr <> Nil do
    Begin
      TempPtr^. FreeData;
      TempPtr := TempPtr^. vPrevPtr;
      FreeMem (TempPtr^. vNextPtr, SizeOf (TempPtr^) );
    End;
  If vStartNodePtr <> Nil Then
  Begin
    vStartNodePtr^. FreeData;
    FreeMem (vStartNodePtr, SizeOf (vStartNodePtr^) );
    vStartNodePtr := Nil;
  End;
  vEndNodePtr := Nil;
  vActiveNodePtr := Nil;
  vTotalNodes := 0;
  vActiveNodeNumber := 0;
  vSorted := False;  {1.00d}
End; {DLLOBJ.EmptyList}

Destructor DLLOBJ. Done;
{}
Begin
  EmptyList;
End; {of dest DLLOBJ.Done}

BEGIN
End.
