Howdy. For the project I'm working on, I really needed a way to get a dynamically sized array in my structures. Can't happen with PB. Okay. And I can't use the LinkedList functions because I need the array inside of my structure, and sometimes the dynamic array would be a structure type with another dynamic array (of a different type). Possible in VB, not PB.
So, I threw together a home brew linked list 'class'. The main difference (aside from ugly, unoptimized and bug-ridden code) is that you create this linked list and obtain an address to the whole linked list. So you can reference the whole linked list via a long variable. Which is easily stored in a structure. So you could have...
Code: Select all
;- Notes
; 1. Took some notes from PolyVector on how to make improvements and how using the address of procedures works.
; I was always wondering why you would want the address of a procedure and what you'd do with it ^_^
; 2. Sorting example uses QuickSort.pb code from the "Sources - Advanced" examples.
;- Updates
; 1/27/2005
; 1. Added xlPosition() to return the index of the current element. Maybe I'll think
; about adding a Position variable to each element to speed this part up? More
; memory usage that way, however.
; 2. Fixed up a few more minor bugs.
; 1/24/2005
; 1. Put in some minor bug checking to make sure a non-zero *xList value is passed
; to our public functions. Still some to add and other things to check.
; 2. Changed AddAt() to Insert(). Actually might have been in a previous example.
; 1/7/2005
; 1. Some bug fixes. For example, deleting the last item wasn't setting the Last item address.
; 2. Additional examples - how to have a linked list of just long values.
; 3. Updated the QuickSort routines. Moved the Current/Bookmark swapping routines
; to xl_Swap() as an 'optional' parameter. Also, listing an example of how you
; would sort a linked list of long values. You'll want to update any of your
; older Quicksort routines to work with this.
; 12/27/2004
; 1. Updated to include xlUpdate() function to update the value for an existing
; element.
; 2. Cleaned xlAdd() and xlAddAt() functions to remove variables not used.
; 3. Fixed how the Current field is used when sorting.
; 4. Fixed xlValue() to actually do what it's supposed to do.
; 5. Added xlBookmark() to remember a position and xlRecall() to go back to that bookmark.
;- Constants
#xlNull = -1
#xlEmpty = 0
;- Structures
Structure s_Test
Named.s
lVar.l
bVar.b
sVar.s
EndStructure
Structure s_xListInfo
Count.l
; A count of the nodes in the list.
CurrentIndex.l
; Holds the index of the current element.
Current .l
; Points to the address for our last selected node.
Last.l
; A pointer to the last node.
Bookmark.l
; A bookmark pointer. This is used if we want to remember our 'Current' place
; while looping through the linked list. Possibly make into a static array?
; Like 10 bookmarks and pass index 1-10 to retrieve/set whatever bookmark?
StructureSize.l
; The size of our value structure.
AddChangesCurrent.b
; Controls the behavior of the Current pointer when adding a node. If True, will set
; the Current pointer to our new node. If False, will not change the Current pointer.
AddCausesSort.b
; Controls whether our sorting routine is called when adding a new item. If True, our
; sort function will be called every time a new element is added. Probably not the
; best way to do this. Maybe two separate functions? One for just sorting and one
; for sorting when adding a new element? If your list is already sorted and this is
; called would it be faster to resort the whole thing or make a smart sorting procedure?
;
; Not implemented yet.
;
AddressCopy.l
; The address of our CopyStructure Procedure. When using structures with xList there
; needs to be two custom procedures - a procedure to copy the structure and a procedure
; to 'clear' the structure.
AddressEmpty.l
; This will hold the address of our clearing routine. Use this to set defaults or just
; to set an empty structure. When we look for an item based on it's index and don't find
; it, we return an emptied structure - using this procedure. So if you want to return
; a certain set of values, set them in this procedure.
AddressSort.l
; This will hold the address of our custom sorting routine. Tailored to the structure.
EndStructure
Structure s_xList
; Our linked list structure.
Left.l
; Points to our previous node (or the information structure if at the root).
Right.l
; Points to the next node (or an #xlEmpty constant if there is no next node).
Value.l
; Holds the pointer to our structure
EndStructure
;- Private Procedures
;/ This block of procedures are the 'private' functions that shouldn't be called by the user.
Procedure xl_Value(*xlNode.s_xList) ; A simple 'Private' function that returns the address of our value structure based on a node's address.
If *xlNode <> #xlNull : ProcedureReturn *xlNode\Value : Else : ProcedureReturn 0 : EndIf
EndProcedure
Procedure.s xl_SetValue(*xlNode.s_xList, inValueAddress) ; A simple 'Private' function that set's a node's value based on the node's address.
If *xlNode <> #xlNull : *xlNode\Value = inValueAddress : EndIf
EndProcedure
Procedure xl_SetLAddress(*xlNode.s_xList, Address) ; A 'Private' function to set the left pointer address of a node.
If *xlNode > 0 : *xlNode\Left = Address : EndIf
; Make sure we aren't trying to set an #xlEmpty (non-node) item's address.
EndProcedure
Procedure xl_SetRAddress(*xlNode.s_xList, Address) ; A 'Private' function to set the right pointer address of a node.
If *xlNode > 0 : *xlNode\Right = Address : EndIf
; Make sure we aren't trying to set an #xlEmpty (non-node) item's address.
EndProcedure
Procedure xl_NodeLeft(*xlNode.s_xList) ; A 'Private' function to return the address of the Node left of *xlNode
If *xlNode > 0 : ProcedureReturn *xlNode\Left : EndIf
EndProcedure
Procedure xl_NodeRight(*xlNode.s_xList) ; A 'Private' function to return the address of the Node right of *xlNode
If *xlNode > 0 : ProcedureReturn *xlNode\Right : EndIf
EndProcedure
Procedure xl_InsertItem(*xlNode.s_xList, inValue, bInserting.b) ; A 'Private' function to insert a new node. Not to be called by the user.
;
Protected *xlNewNode.s_xList
;
*xlNewNode = AllocateMemory(SizeOf(s_xList))
; Create space for our new item in memory.
*xlNewNode\Left = *xlNode
; Make sure the left points to the item before this one.
If bInserting = #False : *xlNewNode\Right = #xlEmpty : Else : *xlNewNode\Right = *xlNode\Right : EndIf
; If we are inserting a value in the middle of our list then we need to make sure our right pointer
; points to the next item in the list. Otherwise, we're adding at the end so the next item is an
; empty pointer.
If bInserting = #True : xl_SetLAddress(*xlNewNode\Right, *xlNewNode) : EndIf
; Since we're inserting a new node, we're replacing the old node with the information from the added node.
; We're then calling xl_InsertItem to add the *old* item back as a right node to the added node. Since the
; old node (which is being created here) is using a new address we have to update it's next item's left
; address pointer to this 'old' node.
*xlNewNode\Value = inValue
; We're passing the address of our value structure so just store it here.
ProcedureReturn *xlNewNode
;
EndProcedure
Procedure xl_IndexFromAddress(*xList.s_xList, inAddress)
Protected iLoop
If *xList
Repeat
If *xList = inAddress : ProcedureReturn iLoop : EndIf
*xList = *xList\Right
iLoop + 1
Until *xList\Right = #xlEmpty
EndIf
ProcedureReturn -1
EndProcedure
Procedure xl_Swap(*Element01.s_xList, *Element02.s_xList, *xList.s_xList) ; Swap the two nodes based on addresses. Pass *xlInfo to swap current & bookmark.
Protected lHold
; A variable to hold one of our values.
Protected *xlInfo.s_xListInfo
;
If *Element01 = *Element02 : ProcedureReturn : EndIf
; Can't swap the same indexes.
*xlInfo = *xList\Left
;
lHold = *Element01\Value
*Element01\Value = *Element02\Value
*Element02\Value = lHold
;
If *xList
; If non-zero we want to check the Current and Bookmark fields to see
; if they need to be swapped as well. Although we move the addresses
; of the values and not the addresses of the elements themselves, we
; are setting Current and Bookmark based on the index of the values.
If *xlInfo\Current = *Element01
*xlInfo\Current = *Element02
ElseIf *xlInfo\Current = *Element02
*xlInfo\Current = *Element01
EndIf
;
If *xlInfo\Bookmark = *Element01
*xlInfo\Bookmark = *Element02
ElseIf *xlInfo\Bookmark = *Element02
*xlInfo\Bookmark = *Element01
EndIf
;
If *xlInfo\CurrentIndex = xl_IndexFromAddress(*xList, *Element01)
*xlInfo\CurrentIndex = xl_IndexFromAddress(*xList, *Element02)
ElseIf *xlInfo\CurrentIndex = xl_IndexFromAddress(*xList, *Element02)
*xlInfo\CurrentIndex = xl_IndexFromAddress(*xList, *Element01)
EndIf
; Ouch. That last block is going to be slow :(
EndIf
;
EndProcedure
;- Public Procedures - Order Importance
;/ This is needed for the sorting routine and other functions so I'm putting it at the top.
Procedure xlAddress(*xList.s_xList, index) ; Return the address of a node based on it's Index
Protected NodeCount
If *xList
If *xList\Right <> #xlNull
While *xList\Right <> #xlEmpty And NodeCount <> index
*xList = *xList\Right
NodeCount + 1
Wend
If NodeCount = index
ProcedureReturn *xList
; Return our address.
EndIf
Else
ProcedureReturn -1
; Empty list, return -1
EndIf
;
EndIf
;
ProcedureReturn -1
; We didn't find our node.
EndProcedure
;- Custom Procedures
;/ These four procedures are needed for each structure. So for every different list we create, we have to create
;/ new functions using these as templates. For demonstration purposes I list two sort routines but only one is
;/ 'needed'. It's okay to change the procedure names and procedure variable names but you must keep the same
;/ number of variables in the procedure line. For example, you can call the copy procedures variables
;/ "*sCopyTo.whatever_your_structure_is" & "*sCopyFrom.whatever_your_structure_is"
;/ instead of
;/ "*strctCopyTo.s_Test" & "*strctCopyFrom.s_Test"
;/ but the first variable *must* be the structure you are copying to and the second must be the structure you are
;/ copying from and they both must be pointers. So, basically, changing the names are okay but not the number or
;/ type.
Procedure xl_LongCopyStructure(*strctCopyTo, *strctCopyFrom)
PokeL(*strctCopyTo, PeekL(*strctCopyFrom))
; Since we're dealing with the address of the long variable and not the
; long variable itself, we need to 'peek' at the "Copy From" variable to
; get the value and then poke that value into the "Copy To" variable.
EndProcedure
Procedure xl_LongEmptyStructure(*StructureToEmpty)
PokeL(*StructureToEmpty, 0)
; Poke a 0 (zero) value into the value 'structure' (a long var, really)
EndProcedure
Procedure xl_LongQuickSort(*xList.s_xList, g, d) ; See description in procedure.
; This is a customized quicksort routine to sort by the LVar field in our
; 'Test' structure. Mainly to show you how sorting by structures will work.
; You can use this as a template and just change the structure and field names
; to match what you are doing. Don't forget to change v's variable type to
; the same type of variable you are testing against. See xl_TestLVarQuickSort
; to see how sorting based on a string field in the same structure works.
;
Protected *xlHold
Protected *Element.s_xList
Protected *Element02.s_xList
Protected *xlHold02
Protected *xlInfo.s_xListInfo
;
*xlInfo = *xList\Left
;
If g < d
*Element = xlAddress(*xList, d)
*xlHold = xl_Value(*Element)
v = PeekL(*xlHold)
i = g-1
j = d
Repeat
Repeat
i=i+1
*Element = xlAddress(*xList, i)
*xlHold = xl_Value(*Element)
Until PeekL(*xlHold) >= v
ok = 0
Repeat
If j>0 : j=j-1 : Else : ok=1 : EndIf
*Element = xlAddress(*xList, j)
*xlHold = xl_Value(*Element)
If PeekL(*xlHold) <= v : ok=1 : EndIf
Until ok<>0
*Element = xlAddress(*xList, i)
*Element02 = xlAddress(*xList, j)
xl_Swap(*Element, *Element02, *xList)
;
Until j <= i
;
xl_Swap(*Element, *Element02, *xList)
;
*Element02 = xlAddress(*xList, d)
xl_Swap(*Element, *Element02, *xList)
;
xl_LongQuickSort(*xList, g, i-1)
xl_LongQuickSort(*xList, i+1, d)
;
EndIf
;
EndProcedure
Procedure xl_LongSort(*xList.s_xList)
Protected *xlInfo.s_xListInfo
*xlInfo = *xList\Left
xl_LongQuickSort(*xList, 0, *xlInfo\Count-1)
EndProcedure
;/
Procedure xl_TestCopyStructure(*strctCopyTo.s_Test, *strctCopyFrom.s_Test)
*strctCopyTo\Named = *strctCopyFrom\Named
*strctCopyTo\lVar = *strctCopyFrom\lVar
*strctCopyTo\bVar = *strctCopyFrom\bVar
*strctCopyTo\sVar = *strctCopyFrom\sVar
EndProcedure
Procedure xl_TestEmptyStructure(*StructureToEmpty.s_Test)
*StructureToEmpty\Named = ""
*StructureToEmpty\lVar = -1 ; In our test, this will help identify bad return values.
*StructureToEmpty\bVar = 0
*StructureToEmpty\sVar = "Empty"
EndProcedure
Procedure xl_TestLVarQuickSort(*xList.s_xList, g, d) ; See description in procedure.
; This is a customized quicksort routine to sort by the LVar field in our
; 'Test' structure. Mainly to show you how sorting by structures will work.
; You can use this as a template and just change the structure and field names
; to match what you are doing. Don't forget to change v's variable type to
; the same type of variable you are testing against. See xl_TestLVarQuickSort
; to see how sorting based on a string field in the same structure works.
;
Protected *xlHold.s_Test
Protected *Element.s_xList
Protected *xlHold02.s_Test
Protected *xlInfo.s_xListInfo
;
*xlInfo = *xList\Left
;
If g < d
*Element = xlAddress(*xList, d)
*xlHold = xl_Value(*Element)
v = *xlHold\lVar
i = g-1
j = d
Repeat
Repeat
i=i+1
*Element = xlAddress(*xList, i)
*xlHold = xl_Value(*Element)
Until *xlHold\lVar >= v
ok = 0
Repeat
If j>0 : j=j-1 : Else : ok=1 : EndIf
*Element = xlAddress(*xList, j)
*xlHold = xl_Value(*Element)
If *xlHold\lVar <= v : ok=1 : EndIf
Until ok<>0
*xlHold = xlAddress(*xList, i)
*xlHold02 = xlAddress(*xList, j)
xl_Swap(*xlHold, *xlHold02, *xList)
;
Until j <= i
;
xl_Swap(*xlHold, *xlHold02, *xList)
;
*xlHold02 = xlAddress(*xList, d)
xl_Swap(*xlHold, *xlHold02, *xList)
;
xl_TestLVarQuickSort(*xList, g, i-1)
xl_TestLVarQuickSort(*xList, i+1, d)
;
EndIf
;
EndProcedure
Procedure xl_TestNamedQuickSort(*xList.s_xList, g, d) ; See description in procedure
;
Protected *xlHold.s_Test
Protected *Element.s_xList
Protected *xlHold02.s_Test
Protected *xlInfo.s_xListInfo
;
*xlInfo = *xList\Left
;
If g < d
*Element = xlAddress(*xList, d)
*xlHold = xl_Value(*Element)
v.s = *xlHold\Named
i = g-1
j = d
Repeat
Repeat
i=i+1
*Element = xlAddress(*xList, i)
*xlHold = xl_Value(*Element)
Until *xlHold\Named >= v
ok = 0
Repeat
If j>0 : j=j-1 : Else : ok=1 : EndIf
*Element = xlAddress(*xList, j)
*xlHold = xl_Value(*Element)
If *xlHold\Named <= v : ok=1 : EndIf
Until ok<>0
*xlHold = xlAddress(*xList, i)
*xlHold02 = xlAddress(*xList, j)
xl_Swap(*xlHold, *xlHold02, *xList)
Until j <= i
;
xl_Swap(*xlHold, *xlHold02, *xList)
*xlHold02 = xlAddress(*xList, d)
xl_Swap(*xlHold, *xlHold02, *xList)
;
xl_TestNamedQuickSort(*xList, g, i-1)
xl_TestNamedQuickSort(*xList, i+1, d)
;
EndIf
;
EndProcedure
Procedure xl_TestSortBylVar(*xList.s_xList)
; Note that we can create as many sort routines as we want, to sort on different values. Just be sure to call
; xlSetSortProcedure with the sorting procedure you wish to use before sorting. So if you want to sort by lVar
;
; xlSetSortProcedure(q, @xl_TestSortBylVar())
; xlSort(q)
;
; Or, if you want to sort by Named...
;
; xlSetSortProcedure(q, @xl_TestSortBylNamed())
; xlSort(q)
;
Protected *xlInfo.s_xListInfo
*xlInfo = *xList\Left
xl_TestLVarQuickSort(*xList, 0, *xlInfo\Count-1)
; Hopefully you get the idea. Just put whatever sorting routines you prefer here.
EndProcedure
Procedure xl_TestSortByNamed(*xList.s_xList)
; Set xlTestSortBylVar for description.
Protected *xlInfo.s_xListInfo
*xlInfo = *xList\Left
xl_TestNamedQuickSort(*xList, 0, *xlInfo\Count-1)
EndProcedure
;- Public Procedures
Procedure xlSetCopyProcedure(*xList.s_xList, AddressOfCopyProcedure)
; Set the pointer to the copy structure procedure. Shouldn't need to call this since
; we set it from xlCreate.
Protected *xlInfo.s_xListInfo
If *xList = 0 : ProcedureReturn : EndIf
*xlInfo = *xList\Left
*xlInfo\AddressCopy = AddressOfCopyProcedure
EndProcedure
Procedure xlSetEmptyProcedure(*xList.s_xList, AddressOfEmptyProcedure)
; Set the pointer to the empty structure procedure.
Protected *xlInfo.s_xListInfo
If *xList = 0 : ProcedureReturn : EndIf
*xlInfo = *xList\Left
*xlInfo\AddressEmpty = AddressOfEmptyProcedure
EndProcedure
Procedure xlSetSortProcedure(*xList.s_xList, AddressOfSortProcedure)
; Set the pointer to the sorting procedure.
Protected *xlInfo.s_xListInfo
If *xList = 0 : ProcedureReturn : EndIf
*xlInfo = *xList\Left
*xlInfo\AddressSort = AddressOfSortProcedure
EndProcedure
Procedure xlSetAddBehavior(*xList.s_xList, AddChangesCurrent.b) ; If #True, the current node pointer will point to any newly added value.
Protected *xlInfo.s_xListInfo
If *xList = 0 : ProcedureReturn : EndIf
*xlInfo = *xList\Left
*xlInfo\AddChangesCurrent = AddChangesCurrent
EndProcedure
Procedure xlSetSortBehavior(*xList.s_xList, SortOnAdd.b) ; If #True, the list will be sorted every time an element is added.
Protected *xlInfo.s_xListInfo
If *xList = 0 : ProcedureReturn : EndIf
*xlInfo = *xList\Left
If *xlInfo\AddressSort : *xlInfo\AddCausesSort = SortOnAdd : EndIf
; Check To make sure our sort procedure address isn't 0. That should be the case if we
; haven't set our sort procedure yet with xlSetSortProcedure.
EndProcedure
Procedure xlCreate(*inStructureAddress, inStructureSize, AddressOfCopyProcedure)
;
; Call like xlCreate(@StructureVariable, SizeOf(Whatever_Your_Structure_Is_Named))
;
Protected *xList.s_xList
;Protected *xlHold.s_classLines_Section
Protected *xlInfo.s_xListInfo
;
If *inStructureAddress = 0 Or inStructureSize = 0 Or AddressOfCopyProcedure = 0 : ProcedureReturn 0 : EndIf
; None of the passed values can be zero. If so, exit.
*xList = AllocateMemory(SizeOf(s_xList))
;
*xlInfo = AllocateMemory(SizeOf(s_xListInfo))
; The fake root will not point to a parent node but will instead
; point to our information structure. We'll use this to access
; optional parameters within the tree.
*xList\Left = *xlInfo
; Our root should always point to our information structure on the left.
*xlInfo\Count = 1
; Set the defaults for our information structure. 1 based.
*xlInfo\CurrentIndex = 0
; Initially the current index is our only element. Index 0.
*xlInfo\Current = *xList
; Set our default Current pointer. Points to the only node.
*xlInfo\AddChangesCurrent = #True
; By default, when a new node is added we change our current pointer to the node.
*xlInfo\AddCausesSort = #False
; Be default, we do not sort when a new element is added.
*xlInfo\StructureSize = inStructureSize
; Hold the size of our value structure.
*xlInfo\AddressCopy = AddressOfCopyProcedure
;
*xList\Right = #xlEmpty
; The root is the only item so this points to nothing.
*xlHold = AllocateMemory(inStructureSize)
; Create our initial structure.
CallFunctionFast(AddressOfCopyProcedure, *xlHold, *inStructureAddress)
; Copy the structure into our list item.
*xList\Value = *xlHold
;
ProcedureReturn *xList
;
EndProcedure
Procedure xlIndex(*xList.s_xList, index, *inStructureAddress) ; Fills the structure with our value.
;
; Could be used like...
;
; MyTest.s_Test
; xlIndex(q, 0, @MyTest)
; Where 'q' is the pointer return from xlCreate and '0' is the first element in our list (zero based)
; 'MyTest' would hold the values from *PointerToHoldStructure
;
Protected NodeCount
;
Protected *xlInfo.s_xListInfo
;
If *xList
*xlInfo = *xList\Left
;
While *xList\Right <> #xlEmpty And index <> NodeCount
; Check to see if we've hit the last item or the index of the item we're looking for.
*xList = *xList\Right
; Move right through our list.
NodeCount + 1
Wend
;
If index = NodeCount
CallFunctionFast(*xlInfo\AddressCopy, *inStructureAddress, *xList\Value)
; Copy our value into the passed parameter.
ProcedureReturn #True
EndIf
; Return the address of our value structure if we found the index.
CallFunctionFast(*xlInfo\AddressEmpty, *inStructureAddress)
; Return an empty/bad structure.
EndIf
;
ProcedureReturn #False
; If we got here, we didn't find our item.
EndProcedure
Procedure xlSelectIndex(*xList.s_xList, index, *inStructureAddress) ; Fills the structure with our value and selects it as Current.
; See xlIndex for example usage.
Protected NodeCount
Protected *xlInfo.s_xListInfo
;
If *xList
*xlInfo = *xList\Left
; Get our information structure.
While *xList\Right <> #xlEmpty And index <> NodeCount
; Check to see if we've hit the last item or the index of the item we're looking for.
*xList = *xList\Right
; Move right through our list.
NodeCount + 1
Wend
;
If index = NodeCount
; We found the index we were looking for.
*xlInfo\CurrentIndex = index
; Set the current index.
*xlInfo\Current = *xList
; Select it...
CallFunctionFast(*xlInfo\AddressCopy, *inStructureAddress, *xList\Value)
; Copy the item's value into our passed parameter.
ProcedureReturn #True
; ...fill our structure and return True since everything went okay.
EndIf
;
CallFunctionFast(*xlInfo\AddressEmpty, *inStructureAddress)
; Return an empty structure since we didn't find what we were looking for.
EndIf
;
ProcedureReturn #False
; If we got here, we didn't find our item.
EndProcedure
Procedure xlValue(*xList.s_xList, *inStructureAddress) ; Returns the address for the value structure for the Current Node (last selected).
;
Protected *xlInfo.s_xListInfo
;
If *xList
*xlInfo = *xList\Left
*xList = *xlInfo\Current
CallFunctionFast(*xlInfo\AddressCopy, *inStructureAddress, *xList\Value)
EndIf
;
EndProcedure
Procedure xlAdd(*xList.s_xList, *inStructureAddress) ; Inserts an item at the end of our list.
;
Protected *xlInfo.s_xListInfo
;
If *xList
;
*xlInfo = *xList\Left
;
*xlHold = AllocateMemory(*xlInfo\StructureSize)
; Create our value structure in memory.
CallFunctionFast(*xlInfo\AddressCopy, *xlHold, *inStructureAddress)
; Create a space for our value structure and copy our incoming values into it.
If *xList\Right = #xlNull
; Add the item as our new root.
*xList\Right = #xlEmpty
; As our list was empty and this was added as our new root, let the list know our
; next item is empty.
*xList\Value = *xlHold
; Set our value structure.
*xlInfo\Last = *xList
; Our last node is the root node.
*xlInfo\Count = 1
; And now we have 1 item on our linked list.
*xlInfo\CurrentIndex = 0
; This needs to be set regardless of AddChangesCurrent() behavior.
Else
If *xList\Right = #xlEmpty
*xList\Right = xl_InsertItem(*xList, *xlHold, #False)
*xlInfo\Count + 1
Else
; Adding to the end.
*xList = *xlInfo\Last
*xList\Right = xl_InsertItem(*xList, *xlHold, #False)
*xlInfo\Count + 1
EndIf
*xlInfo\Last = *xList\Right
EndIf
;
If *xlInfo\AddChangesCurrent = #True
*xlInfo\Current = *xList\Right
*xlInfo\CurrentIndex = *xlInfo\Count-1
; Our count is 1 based. Since we're adding at the end (or the root), subtract one.
EndIf
;
ProcedureReturn *xList\Right
;
EndIf
;
EndProcedure
Procedure xlInsert(*xList.s_xList, *inStructureAddress, InsertAt) ; InsertAt=The position to insert. 0 for the root (first element)
;
Protected NodeCount
Protected *xlInfo.s_xListInfo
;
If *xList
*xlRoot = *xList
*xlInfo = *xList\Left
;
*xlHold = AllocateMemory(*xlInfo\StructureSize)
; Create our value structure
CallFunctionFast(*xlInfo\AddressCopy, *xlHold, *inStructureAddress)
; Create a space for our value structure and copy our incoming values into it.
If *xList\Right = #xlNull
; Add the item as our new root.
*xList\Right = #xlEmpty
; As our list was empty and this was added as our new root, let the list know our
; next item is empty.
*xList\Value = *xlHold
; Set our the
*xlInfo\Current = *xList
;
*xlInfo\Last = *xList
;
*xlInfo\Count = 1
; The count is now 1 sine we have an item on our list.
*xlInfo\CurrentIndex = 0
; We need to set this regardless of the AddChangesCurrent() behavior.
Else
If InsertAt <> -1
If InsertAt = 0
; Insert at the root.
*xList\Right = xl_InsertItem(*xList, *xList\Value, #True)
*xList\Value = *xlHold
; We're inserting at the root so insert the current
; root values as a new item and set the root to the
; node and the right value to the old node.
*xlInfo\Count + 1
; Increment our node counter
If *xlInfo\AddChangesCurrent = #True
*xlInfo\Current = *xList
*xlInfo\CurrentIndex = 0
EndIf
;
If *xlInfo\Last = *xList : *xlInfo\Last = *xList\Right : EndIf
;
Else
Repeat
NodeCount + 1
*xList = *xList\Right
If NodeCount = InsertAt
; Found our insertion point.
NodeCount = -1
; This will let the procedure know we found the insertion point.
*xList\Right = xl_InsertItem(*xList, *xList\Value, #True)
; Since we're inserting, create a new item based on the current node and
; set it to the current node's right pointer. So if we're inserting '3'
; at index two (value 10) then we'll add a new node based on the existing
; '10' and set it to '10's right pointer. Once we do that...
*xList\Value = *xlHold
; ...we'll set the current node (which was 10) to our new value ('3', in our
; example).
*xlInfo\Count + 1
; Increment our list counter.
If *xlInfo\AddChangesCurrent = #True
*xlInfo\Current = *xList
*xlInfo\CurrentIndex = InsertAt
EndIf
;
If *xlInfo\Last = *xList : *xlInfo\Last = *xList\Right : EndIf
;
Break
; And exit the loop.
EndIf
Until *xList\Right = #xlEmpty
; If we break at this point then we didn't find our insertion point - passed a value
; greater than the number of nodes.
If NodeCount <> -1
*xList\Right = xl_InsertItem(*xList, *xlHold, #False)
; We moved past our InsertAt position so add the value at the end.
*xlInfo\Count + 1
;
If *xlInfo\AddChangesCurrent = #True
*xlInfo\Current = *xList\Right
*xlInfo\CurrentIndex = *xlInfo\Count-1
EndIf
;
*xlInfo\Last = *xList\Right
;
EndIf
EndIf
Else
If *xList\Right = #xlEmpty
*xList\Right = xl_InsertItem(*xList, *xlHold, #False)
*xlInfo\Count + 1
If *xlInfo\AddChangesCurrent = #True
*xlInfo\Current = *xList\Right
*xlInfo\CurrentIndex = *xlInfo\Count-1
EndIf
*xlInfo\Last = *xList\Right
Else
; Adding to the end.
*xList = *xlInfo\Last
*xList\Right = xl_InsertItem(*xList, *xlHold, #False)
*xlInfo\Count + 1
If *xlInfo\AddChangesCurrent = #True
*xlInfo\Current = *xList\Right
*xlInfo\CurrentIndex = *xlInfo\Count-1
EndIf
*xlInfo\Last = *xList\Right
EndIf
EndIf
EndIf
;
ProcedureReturn *xList\Right
;
EndIf
;
EndProcedure
Procedure xlUpdate(*xList.s_xList, *inStructureAddress, ElementIndex) ; Updates the structure stored at position 'ElementIndex'
;
Protected NodeCount
Protected *xlInfo.s_xListInfo
;
If *xList
*xlInfo = *xList\Left
;
If *xList\Right = #xlNull
; The list is uninitialized. Don't update anything.
Else
If ElementIndex >= 0
; Make sure we passed a non-negative index.
If ElementIndex = 0
; Update the root.
CallFunctionFast(*xlInfo\AddressCopy, *xList\Value, *inStructureAddress)
; Copy the values from the passed structure (*inStructureAddress) into our
; existing value structure.
Else
Repeat
NodeCount + 1
*xList = *xList\Right
If NodeCount = ElementIndex
; Found the node to update.
CallFunctionFast(*xlInfo\AddressCopy, *xList\Value, *inStructureAddress)
; Copy the values from the passed structure (*inStructureAddress) into our
; existing value structure.
Break
; And exit the loop.
EndIf
Until *xList\Right = #xlEmpty
; If we break at this point then we didn't find our update point - passed a value
; greater than the number of nodes.
EndIf
Else
; Passed -1 as our ElementIndex, update the current element.
*xList = *xlInfo\Current
; Get our current element.
CallFunctionFast(*xlInfo\AddressCopy, *xList\Value, *inStructureAddress)
; Copy the values from the passed structure (*inStructureAddress) into our
; existing value structure.
EndIf
EndIf
EndIf
;
EndProcedure
Procedure xlDestroy(*xList.s_xList) ; Completely destroys our list.
Protected lHold
Protected *xRoot.s_xList
;
If *xList = 0 : ProcedureReturn : EndIf
; Make sure we passed a non null value.
*xRoot = *xList
If *xList\Right <> #xlEmpty
*xList = *xList\Right
While *xList\Right <> #xlEmpty
;
lHold = *xList
; Hold our current node.
FreeMemory(*xList\Value)
; Clear the memory for our value structure
*xList = *xList\Right
; Get the next item.
FreeMemory(lHold)
; Now clear our node from memory.
Wend
FreeMemory(*xList)
EndIf
FreeMemory(*xRoot\Left)
; Free the xList information structure.
FreeMemory(*xRoot\Value)
; Clear the root's value structure.
FreeMemory(*xRoot)
; Free the root.
EndProcedure
Procedure xlClear(*xList.s_xList) ; Clears all items from our list.
;
Protected lHold
;
Protected *xRoot.s_xList
Protected *xlInfo.s_xListInfo
;
If *xList = 0 : ProcedureReturn : EndIf
; Make sure we aren't trying to clear a null linked list.
*xRoot = *xList
; Hold our root.
*xlInfo = *xRoot\Left
; Hold our information structure.
If *xList\Right <> #xlNull
; Make sure the list isn't already empty.
If *xList\Right <> #xlEmpty
; This block will delete only the non-root nodes from memory.
*xList = *xList\Right
; Move to the next item after our root, without deleting the root.
While *xList\Right <> #xlEmpty
lHold = *xList
; Hold the current node.
FreeMemory(*xList\Value)
; Clear the memory for our value structure
*xList = *xList\Right
; Update our pointer with the next node in our list. This will not be empty since our While loop already checked.
FreeMemory(lHold)
; Now delete our held node.
Wend
; We exit here when we find the last non-empty node.
FreeMemory(*xList)
; Delete the last non-empty, non-root node.
EndIf
; The root is the only item left.
FreeMemory(*xRoot\Value)
; Clear the value structure. We'll recreate it when we add a value.
*xRoot\Right = #xlNull
; Let the routines know that the list is unpopulated.
*xlInfo\Count = 0
; No items left since we cleared everything.
*xlInfo\Current = *xRoot
; Select our root item - just to be safe.
*xlInfo\CurrentIndex = 0
; Same as above.
EndIf
EndProcedure
Procedure xlRemove(*xList.s_xList, index) ; Removes a node from our list.
;
Protected NodeCount
;
Protected *xlRoot.s_xList
Protected *xlNext.s_xList
Protected *xlPrevious.s_xList
Protected *xlInfo.s_xListInfo
;
If *xList
*xlRoot = *xList
*xlInfo = *xList\Left
;
If *xList\Right = #xlNull
; The list is uninitialized. Don't delete anything.
Else
If index >= 0
; Make sure we passed a non-negative index.
If index = 0
; Delete the root.
If *xList\Right <> #xlEmpty
; There are more items than the root item.
*xlNext = *xlRoot\Right
; Get the address for the next item in our list.
*xlRoot\Right = *xlNext\Right
; We can't just delete the node because then our root address would change. That would cause
; the xList pointer to be invalidated (the xList pointer is the pointer returned from xlCreate())
; So, instead, we will copy the next node into our root, leaving the address the same.
xl_SetLAddress(*xlNext\Right, *xlRoot)
; Make sure the "Next Node"'s next node is pointing back to our root item.
FreeMemory(*xlRoot\Value)
; Since we're copying the 'Next Node' structure into our root structure, clear the old root value
; structure from memory.
*xlRoot\Value = *xlNext\Value
; Set our root value pointer to our next item value pointer.
If *xlInfo\Current = *xlNext : *xlInfo\Current = *xlRoot : EndIf
; If our current node was the node after the root, set the current node to the root (which was the node after the root).
If *xlInfo\CurrentIndex > 0 : *xlInfo\CurrentIndex -1 : EndIf
; Since we're deleting the root, all of the indexes will shift down.
FreeMemory(*xlNext)
; Now, delete the next node since we've copied it's values to the root. We effectively spliced it out.
*xlInfo\Count - 1
; Decrement our node counter
Else
; The root is the only item.
FreeMemory(*xList\Value)
; Clear our value structure.
*xList\Right = #xlNull
; Let the routines know that the list is unpopulated.
*xlInfo\Count = 0
; Set our node count to 0 since there are no more items.
*xlInfo\Current = *xList
; Set the current node pointer to our empty root. Just to be safe.
*xlInfo\CurrentIndex = 0
; Don't really need this here but might as well. Should already be 0.
*xlInfo\Last = *xList
; This won't matter since our 'Right' pointer is #xlNull but might as well.
EndIf
Else
; Passed a non-zero index value so we're going to delete something
; other than the root if we find it.
Repeat
NodeCount + 1
*xList = *xList\Right
If NodeCount = index
; Found the node to delete.
If *xList\Right <> #xlEmpty
; There's another item after this.
*xlNext = *xList\Right
; Grab our pointer
*xlPrevious = *xList\Left
;
*xlNext\Left = *xlPrevious
; Dereference our current node by setting the next item's left pointer
; to the current node's left item.
*xlPrevious\Right = *xlNext
; Make sure our previous item points to the next item (the one after the deleted item).
If *xlInfo\Current = *xList : *xlInfo\Current = *xlPrevious : EndIf
; If we're deleting the currently selected node then set the previous node as current.
If *xlInfo\CurrentIndex > index : *xlInfo\CurrentIndex - 1 : EndIf
; Since there is an item before this we only need to modify if the current index
; is set after the element to be deleted. We'll decrement the current index
; because we're deleting an item before it.
FreeMemory(*xList\Value)
; Free our value structure from memory.
FreeMemory(*xList)
; Free the node from memory.
*xlInfo\Count - 1
; Decrement our item counter.
Else
; This is the last item.
*xlPrevious = *xList\Left
; Okay, yes, I'm cheating. Rather than pointing to the next item in our list, it's
; pointing to the previous item.
*xlPrevious\Right = #xlEmpty
; Dereference our current item.
If *xlInfo\Current = *xList : *xlInfo\Current = *xlPrevious : EndIf
; If we're deleting the currently selected node then set the previous node as current.
If *xlInfo\CurrentIndex = index : *xlInfo\CurrentIndex -1 : EndIf
; If we're deleting the current index item, set it to the previous element. Should
; work okay since this is not the root and won't be less than 0.
FreeMemory(*xList\Value)
; Free our value structure from memory.
FreeMemory(*xList)
; And free it from memory.
*xlInfo\Last = *xlPrevious
; Since we're deleting the last item in our linked list we need
; to update our Last element address.
*xlInfo\Count - 1
; Decrement our item counter.
EndIf
;
Break
; And exit the loop.
EndIf
Until *xList\Right = #xlEmpty
; If we break at this point then we didn't find our index to delete - passed a value
; greater than the number of nodes.
EndIf
EndIf
EndIf
EndIf
;
EndProcedure
Procedure xlCount(*xList.s_xList)
; Returns a 1 based count of our items.
Protected *xlInfo.s_xListInfo
If *xList = 0 : ProcedureReturn 0 : EndIf
; Make sure we're checking a non-null linked list.
*xlInfo = *xList\Left
ProcedureReturn *xlInfo\Count
EndProcedure
Procedure xlReset(*xList.s_xList) ; Reset our Current pointer to -1 so xlNext will move to the root node.
;
Protected *xlInfo.s_xListInfo
;
If *xList
*xlInfo = *xList\Left
*xlInfo\Current = -1
; No selected node.
*xlInfo\CurrentIndex = -1
; No item is current.
EndIf
;
EndProcedure
Procedure xlFirst(*xList.s_xList) ; Sets our current pointer to the first node and returns it's address...
; ...which, incidentally, is useless as the value passed to the procedure is the address ^_^
Protected *xlInfo.s_xListInfo
;
If *xList
*xlInfo = *xList\Left
*xlInfo\Current = *xList
*xlInfo\CurrentIndex = 0
EndIf
;
ProcedureReturn *xList
;
EndProcedure
Procedure xlLast(*xList.s_xList) ; Sets our current pointer to the last node and returns it's address
;
Protected *xlInfo.s_xListInfo
;
If *xList
*xlInfo = *xList\Left
;
While *xList\Right <> #xlEmpty And *xList\Right <> #xlNull
*xList = *xList\Right
Wend
;
*xlInfo\Current = *xList
*xlInfo\CurrentIndex = *xlInfo\Count-1
; Since the count is 1 based and our index is not.
EndIf
ProcedureReturn *xList
;
EndProcedure
Procedure xlNext(*xList.s_xList) ; Sets our current pointer to the next node (after the current pointer).
;
Protected *xlNode.s_xList
Protected *xlInfo.s_xListInfo
;
If *xList
*xlInfo = *xList\Left
If *xlInfo\Current = -1
; We have no selected node.
If *xList\Right = #xlNull
; Uninitialized list. No next node.
ProcedureReturn #False
Else
*xlInfo\Current = *xList
; Since our Current pointer is invalidated, move to the root item and return true.
*xlInfo\CurrentIndex = 0
; And set the current index to the root.
ProcedureReturn #True
; So return
EndIf
Else
*xlNode = *xlInfo\Current
EndIf
;
If *xlNode\Right <> #xlEmpty And *xlNode\Right <> #xlNull
; Make sure there is a next items.
*xlNode = *xlNode\Right
; Select it.
Else
ProcedureReturn #False
; Return False since there is no next element.
EndIf
;
*xlInfo\Current = *xlNode
;
*xlInfo\CurrentIndex + 1
; We successfully moved right, increment our current index.
ProcedureReturn #True
; There is a next node so return True.
EndIf
;
ProcedureReturn #False
; Return False since there is no next element.
EndProcedure
Procedure xlPrevious(*xList.s_xList) ; Sets our current pointer to the previous node (before the current pointer).
;
Protected *xlNode.s_xList
Protected *xlInfo.s_xListInfo
;
If *xList
*xlInfo = *xList\Left
If *xlInfo\Current = -1
; No current node.
ProcedureReturn #False
; We've reset the list - there is no previous item.
Else
*xlNode = *xlInfo\Current
EndIf
;
If *xList <> *xlNode
; Make sure the Current item is not the root item. The root address is passed to xlPrevious.
*xlNode = *xlNode\Left
; Select it.
Else
ProcedureReturn #False
; Return False since there is no previous element.
EndIf
;
*xlInfo\Current = *xlNode
;
*xlInfo\CurrentIndex -1
; Decrement our current index.
ProcedureReturn #True
; There is a next node so return True.
EndIf
;
ProcedureReturn #False
; Return False since there is no previous element.
EndProcedure
Procedure xlSort(*xList.s_xList) ; Call our custom sorting procedure.
Protected *xlInfo.s_xListInfo
If *xList
*xlInfo = *xList\Left
If *xlInfo\AddressSort : CallFunctionFast(*xlInfo\AddressSort,*xList) : EndIf
; Make sure we have set the sorting procedure before sorting.
EndIf
EndProcedure
Procedure xlSwap(*xList.s_xList, Index01, Index02) ; Swap the two nodes.
;
Protected lHold
; A variable to hold one of our values.
If *xList
If Index01 = Index02 : ProcedureReturn : EndIf
; Can't swap the same indexes.
lAddress01 = xlAddress(*xList,Index01)
; Get the first address.
If lAddress01 <> -1
; Make sure we found it.
lAddress02 = xlAddress(*xList, Index02)
; Get the second address.
If lAddress02 <> -1
; Make sure we found it.
lHold = xl_Value(lAddress01)
xl_SetValue(lAddress01, xl_Value(lAddress02))
xl_SetValue(lAddress02, lHold)
EndIf
EndIf
EndIf
EndProcedure
Procedure xlBookmark(*xList.s_xList) ; Will bookmark the current element.
Protected *xlInfo.s_xListInfo
If *xList
*xlInfo = *xList\Left
*xlInfo\Bookmark = *xlInfo\Current
EndIf
EndProcedure
Procedure xlRecall(*xList.s_xList) ; Will return the current element to the bookmarked position.
Protected *xlInfo.s_xListInfo
If *xList
*xlInfo = *xList\Left
*xlInfo\Current = *xlInfo\Bookmark
*xlInfo\CurrentIndex = xl_IndexFromAddress(*xList, *xlInfo\Current)
; Since we know the address of the current node, retrieve it's index.
EndIf
EndProcedure
Procedure xlPosition(*xList.s_xList) ; Will return the index of the current element.
; Useful for returning the index while using xlNext/xlPrevious/xlLast.
Protected *xlInfo.s_xListInfo
If *xList
*xlInfo = *xList\Left
ProcedureReturn *xlInfo\CurrentIndex
EndIf
EndProcedure
Procedure xlTestPrint(*xList.s_xList) ; Prints your list. For debug purposes primarily.
Protected lCount
Protected sHold.s
Protected *xlHold.s_Test
If *xList\Right = #xlNull
Debug "o-*"
Else
If *xList\Right = #xlEmpty
*xlHold = *xList\Value
; Hold our value structure.
Debug "o-'"+*xlHold\Named+"("+Str(*xlHold\lVar)+")'"
Else
Repeat
*xlHold = *xList\Value
If lCount = 0
sHold = "*-->'"+*xlHold\Named+"("+Str(*xlHold\lVar)+")'"
Else
sHold = sHold+"-->'"+*xlHold\Named+"("+Str(*xlHold\lVar)+")'"
EndIf
*xList = *xList\Right
lCount + 1
Until *xList\Right = #xlEmpty
*xlHold = *xList\Value
Debug sHold+"-->'"+*xlHold\Named+"("+Str(*xlHold\lVar)+")'-->*"
EndIf
EndIf
EndProcedure
Procedure xlLongPrint(*xList.s_xList) ; Prints your list. For debug purposes primarily.
Protected lCount
Protected sHold.s
If *xList\Right = #xlNull
Debug "o-*"
Else
If *xList\Right = #xlEmpty
Debug "o-'"+Str(PeekL(*xList\Value))+"'"
Else
Repeat
If lCount = 0
sHold = "o-->'"+Str(PeekL(*xList\Value))+"'"
Else
sHold = sHold+"-->'"+Str(PeekL(*xList\Value))+"'"
EndIf
*xList = *xList\Right
lCount + 1
Until *xList\Right = #xlEmpty
Debug sHold+"-->'"+Str(PeekL(*xList\Value))+"'-->*"
EndIf
EndIf
EndProcedure
;/
lHold = 69
q = xlCreate(@lHold, SizeOf(LONG), @xl_LongCopyStructure())
xlSetEmptyProcedure(q, @xl_LongEmptyStructure())
xlSetSortProcedure(q, @xl_LongSort())
xlLongPrint(q)
lHold = 26
xlAdd(q, @lHold)
lHold = 200221
xlAdd(q, @lHold)
lHold = 2
xlAdd(q, @lHold)
lHold = 999
xlAdd(q, @lHold)
lHold = 100
xlAdd(q, @lHold)
xlLongPrint(q)
xlSort(q)
xlLongPrint(q)
xlReset(q)
While xlNext(q)
xlValue(q, @lHold)
Debug Str(lHold)+" is in position "+Str(xlPosition(q))
Wend
xlRemove(q, 5)
xlLongPrint(q)
lHold = 4
xlAdd(q, @lHold)
xlLongPrint(q)
xlSort(q)
xlLongPrint(q)
xlDestroy(q)
;/
holdTest.s_Test
holdTest\Named = "Hi"
holdTest\lVar = 1
holdTest\bVar = 5
holdTest\sVar = "One"
;
q = xlCreate(@holdTest, SizeOf(s_Test), @xl_TestCopyStructure())
xlSetEmptyProcedure(q, @xl_TestEmptyStructure())
xlSetSortProcedure(q, @xl_TestSortBylVar())
;
holdTest\Named = "Ten"
holdTest\lVar = 10
xlAdd(q, @holdTest)
;
holdTest\Named = "Four"
holdTest\lVar = 4
xlAdd(q, @holdTest)
;
holdTest\Named = "Twenty"
holdTest\lVar = 20
xlAdd(q, @holdTest)
;
holdTest\Named = "Eight"
holdTest\lVar = 8
xlAdd(q, @holdTest)
;
xlTestPrint(q)
;
xlSort(q)
xlTestPrint(q)
;
xlSetSortProcedure(q, @xl_TestSortByNamed())
xlSort(q)
xlTestPrint(q)
;
xlDestroy(q)
The code I'll post here is just storing string values but you could easily modify it to store whatever you want. Longs, floats.... structures.... Okay, so the way I hacked it together it's not as cool as the PB LinkedList structures where you reference them like "MyLinkedList()\StructureVar01" etc... but you can store them. And.... you can create a structure with a long that points to yet another linked list structure.
So, you can have a structure that stores information about your restaurant with a long that points to a linked list that dynamically holds info about your different foods. And each item in that linked list can have another long that points to yet another linked list that dynamically contains the ingredients for your food. Yes, I'm making that up as a horrible example.
Also - my code demonstrates a way you can store 'options' for each individual linked list. You could easily adapt this method to other code if you like it. Simple put - the root (head) of the linked list points to an informational structure. Since we call the linked list functions with the address of the root (passed from the xlCreate() function), we just have to grab the left item (pointer to the informational structure) and make changes.
Anyway, here's the code for simply storing strings. WARNING! Like I said earlier - it's unoptimized, ugly and there are barely any error checking code going on. I tried to comment it up so other people can see what's going on but .... ehhh...
Be gentle 
(Edit: Code removed to save space. See last post for link to new code using PureStorage)
... I didn't even think of implimenting copy procedures....