A doubly linked list

User projects written in or related to FreeBASIC.
Post Reply
sancho3
Posts: 358
Joined: Sep 30, 2017 3:22

A doubly linked list

Post by sancho3 »

This is a doubly linked list.
It has three main components:
1. Type TList
This is the generic list that uses a TNode type which is just a pointer to the next node, a pointer to the previous node and a pointer to the data.
Only pointers to the items are kept in this list and they are stored is an Any pointer. So any kind of data can be stored but you must manage that items memory.
Nodes are created for each item using the New keyword. Those node memory is freed using delete in the destructor (or in the delete_node method).
2 #Macro __MAKE_LIST__(V, T, CT)
This is a macro to make it easier to use the list. This macro creates a separate type that extends the TList type and implements various methods that utilize the type of data you are storing.
The macro parameters are:
V - the name of the list variable ex my_list
T - the type of the variable ex string
CT - the type cast used in comparison operations
V for Variable name requires no explanation. T for type are is the type of object you are storing. This can be an intrinsic type, like a String or an Integer, or it can be a UDT. CT for Cast Type is used to tell the macro what to cast the pointer to the item as when making comparisons.
In the following example the type test is used for paramter T. The cast operator must be overloaded in the type and that must be supplied to the macro. In this case the cast to string is overloaded.

Code: Select all

Type test 
	As String s
	As Integer x, y
	Declare Operator cast()
End Type
Operator test.cast() As String 
	Return this.s 
End Operator 
Comparisons are used to find matches in the list. For example this line in Find_Item():

Code: Select all

If item = Cast(CT , *Cast(T Ptr, node->pData)) Then
3.#Macro __MAKE_ICTLIST__(V, T, CT)
This macro is identical to __MAKE_LIST__ except that it requires that the UDT data type stored in the list extends the type IComparable. Type IComparable is defined at the top of the code. It declares an abstract function called compareto. Your UDT must declare and define that funcion. The function is used for comparison operations. The function returns a -1 if instance (this) item is < search iitem ( o), 0 if instance item = search item, or 1 if instance item > search item. The function has a return type of the enum ComparisonResult which is also defined at the top of the code.

The macro versions have the advantage of managing the item memory for you. New T items are created and deleted without the user necessarily having to handle it. So you don't have to create new objects and remember to free their memory.

TList defines these methods:

Code: Select all

	' for_each 	- Iterate each element of the list. 
	'					- Each element is passed as a parameter to the call_back sub  
	Declare Sub for_each(Byval call_back As Sub(Byval node As Any Ptr))

	' get_node_at_inex 	- return the n-1th (index) node from root_node
	Declare Function get_node_at_index(Byval index as Integer) As TNode Ptr 

	' sink 	- set node as the root node
	' 			- Returns true if successful 
	Declare Function sink(Byval node as TNode Ptr) as Boolean
	
	' sink 	- set the node that contains item as the root node 
	'			- compareto is a sub used to compare item with node->pdata items until a match is found
	' 			- Returns true if successful 
	Declare Function sink(Byval item as Any Ptr, Byval compareto As Function(Byval list_item As Any Ptr, Byval search_item As Any Ptr ) As Boolean) As Boolean		' float item to top (front) of list
	
	' float	- set node as the front_node
	' 			- Returns true if successful 
	Declare Function float(Byval node As TNode Ptr) as Boolean 
	
	' float 	- set the node that contains item as the front node 
	'			- compareto is a sub used to compare item with node->pdata items until a match is found
	' 			- Returns true if successful 
	Declare Function float(Byval item as Any Ptr, Byval compareto As Function(Byval list_item As Any Ptr, Byval search_item As Any Ptr ) As Boolean) As Boolean		' float item to top (front) of list

	' push	- append a new node to the tail of the list (this is the same as append_item() and in fact simply calls append_item)
	'			- returns true is successful 
	Declare Function push(Byval item As Any Ptr) As Boolean

	' insert_head	- insert a new node with pdata = item as a root node
	' 						- Returns true if successful 
	Declare Function insert_head(Byval item As Any Ptr) As Boolean
	
	' insert_before	- insert a new node with pdata = item into the list immediately prior to next_node
	' 						- Returns true if successful 
	Declare Function insert_before(Byval next_node As TNode Ptr,  Byval item As Any Ptr) As Boolean

	' insert_after	- insert a new node with pdata = item into the list immediately after prev_node
	' 						- Returns true if successful 
	Declare Function insert_after(Byval prev_node As TNode Ptr, Byval item as Any Ptr) As Boolean

	' append_item	- append a new node with pdata = item onto the list
	' 						- Returns true if successful 
	Declare Function append_item(Byval item As Any Ptr) As Boolean

	' delete_node	- remove node from the list and free its memory
	' 						- Returns true if successful 
	Declare Function delete_node(Byval node As TNode Ptr) as Boolean

	' pop	- delete the front_node from the list, free its memory, and return a pointer to its pdata item
	Declare Function pop() As Any Ptr

	' find_item	- iterate the node list until a pdata item matches parameter item. 
	'					- the call back sub parameter is used to compare items 
	'					- returns the pdata item or null if no match is found
	Declare Function find_item(Byval item As Any Ptr, Byval compareto As Function(Byval list_item As Any Ptr, Byval search_item As Any Ptr ) As Boolean) As Any Ptr

	' find_item	- iterate the node list until a pdata item matches parameter item. 
	'					- paramter item is a type that extends IComparable and therefore defines a compareto sub used to find a match
	'					- returns the pdata item or null if no match is found
	Declare Function find_item(Byval item As IComparable Ptr, Byref node As TNode Ptr = NULL) As Any Ptr 
The macro further defines these methods:

Code: Select all

	' item_at	- returns a reference to an item that is at index 
	Declare Property item_at(Byval index as integer) Byref As T 

	' clear_items	- delete all nodes and their items and free their memory
	'						- returns true if successful 
	Declare Function clear_items() As Boolean

	' delete_item	- delete the node->pdata item that matches parameter item and delete that node as well
	'						- returns true if successful
	Declare Function delete_item(Byval item as T) As Boolean 
	
	' append_item	- create a new node and new pdata item 
	'						- set the new items values to the parameter item values
	'						- set byref parameter pItem to the new item
	'						- return true if successful
	Declare Function append_item(Byval item as T, Byval pItem As T Ptr = 0) as Boolean

	' append_item	- create a new node and set its pdata to parameter item
	'						- return true if successful
	Declare Function append_item(Byval item as T Ptr) As Boolean

	' for_each	- iterate the item list by sending each nodes pdata item to the parameter call_back sub
	Declare Sub for_each(Byval Call_back As Sub(Byval item as T Ptr))
	
	' get_item_at_node	- return the item at parameter index
	Declare Function get_item_at_index(Byval index As Uinteger) As T Ptr

	' sink	- set the node containing paramter item as the root node
	'			- return true if successful
	Declare Function sink(Byval item as T) As Boolean 
	
	' sink	- set the node at parameter index as the root node
	'			- return true if successful 
	Declare Function sink(Byval index as integer) As Boolean 
	
	' float	- set the node containing parameter item as the root node
	' 			- return true if successful	
	Declare Function float(Byval item as T) As Boolean

	' float 	- set the node at parameter index as the root node
	'			- return true if successful
	Declare Function float(Byval index as integer) As Boolean

	' insert_head	- create a new node and a new item for its pdata
	'						- set the new items data to the parameter items data
	'						- return true if successful
	Declare Function insert_head(Byval item As T, Byval pitem As T Ptr = 0)  As Boolean
	
	' insert_head	- create a new node and set its pdata to parameter item
	'						- set the new node as the root node
	'						- return true if successful
	Declare Function insert_head(Byval item As T Ptr) As Boolean

	' insert_after	- create a new node and a new item for its pdata
	'						- set the items data to parameter new_item
	'						- insert the new node after the node containing prev_item as its pdata
	'						- return true if successful
	Declare Function insert_after(Byval prev_item As T, Byval new_item As T) As Boolean 
	
	' insert_after	- create a new node and set its pdata to parameter new_item
	'						- insert the new node after the node containing prev_item as its pdata
	'						- return true if successful
	Declare Function insert_after(Byval prev_item As T, Byval new_item As T ptr) As Boolean 

	' insert_before	- create a new node and a new item for its pdata
	'						- set the items data to parameter new_item
	'						- insert the new node before the node containing prev_item as its pdata
	'						- return true if successful
	Declare Function insert_before(Byval next_item As T, Byval new_item As T) As Boolean 

	' insert_after	- create a new node and set its pdata to parameter new_item
	'						- insert the new node before the node containing prev_item as its pdata
	'						- return true if successful
	Declare Function insert_before(Byval next_item As T, Byval new_item As T ptr) As Boolean 

	' pop	- delete the tail node return its item
	Declare Function pop() As T ptr

	' push	- create a new node and a new T item for its pdata 
	'			- set the new items data to the parameter item data
	'			- append new node to list
	'			- return true if successful 
	Declare Function push(Byval item As T) As Boolean 
	
	' push	- create a new node and set its pdata item to the parameter item
	'			- append the new node to the list
	'			- return true if successful
	Declare Function push(Byval item As T Ptr) As Boolean 

#Ifndef __ICTList__
	' find_item	- return item that matches parameter item using cast to CT (cast type) for comparison
	'					- set byref parameter node to the node containing matching item 
	Declare Function find_item(Byval item As CT, Byref node As TNode Ptr = 0) As T Ptr	' node will be filled with a pointer to a TNode that contains item
#Endif 
	' find_item	- return item that matches parameter item using parameter items comparison function
	Declare Function find_item(Byval item As IComparable Ptr, Byref node As TNode Ptr = 0) As T Ptr
Next post is the list with some sample code at the end.
sancho3
Posts: 358
Joined: Sep 30, 2017 3:22

Re: A doubly linked list

Post by sancho3 »

Code: Select all

' TList.bas
#Define CRLF Chr(13) & Chr(10)

#Define NULL 0

Enum CompareResult
	crLess = -1
	crEqual
	crGreater
End Enum

' IComparable is used like an interface that your class/object should inherit. It simply enforces that your class/object 
' contains a method called compareto that returns -1 if instance (this) item is < search iitem ( o), 0 if instance item = search item, 
' or 1 if instance item > search item
Type IComparable Extends Object
	Declare abstract Function compareto(Byval o As Any Ptr) As CompareResult
End Type

'-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' TList - A doubly linked list 
'  head = root = 1st item added to the list, tail = newest appended item = last item added to list (appended) 
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Type TNode
	As Any Ptr pdata
	As TNode Ptr prev_node
	As TNode Ptr next_node

End Type

Type TList
	As Integer item_count
	As TNode Ptr root_node
	As TNode Ptr tail_node

	Declare Function append_item(Byval item As Any Ptr) As Boolean
	Declare Function delete_node(Byval node As TNode Ptr) as Boolean
	Declare Function insert_after(Byval prev_node As TNode Ptr, Byval item as Any Ptr) As Boolean
	Declare Function find_item(Byval item As Any Ptr, Byval compareto As Function(Byval list_item As Any Ptr, Byval search_item As Any Ptr ) As Boolean) As Any Ptr
	Declare Function find_item(Byval item As IComparable Ptr, Byref node As TNode Ptr = NULL) As Any Ptr 
	Declare Function float(Byval node As TNode Ptr) as Boolean 
	Declare Function float(Byval item as Any Ptr, Byval compareto As Function(Byval list_item As Any Ptr, Byval search_item As Any Ptr ) As Boolean) As Boolean		' float item to top (front) of list
	Declare Sub for_each(Byval call_back As Sub(Byval node As Any Ptr))
	Declare Function get_node_at_index(Byval index as Integer) As TNode Ptr 
	Declare Function insert_before(Byval next_node As TNode Ptr,  Byval item As Any Ptr) As Boolean
	Declare Function insert_head(Byval item As Any Ptr) As Boolean
	Declare Function pop() As Any Ptr
	Declare Function push(Byval item As Any Ptr) As Boolean
	Declare Function sink(Byval node as TNode Ptr) as Boolean
	Declare Function sink(Byval item as Any Ptr, Byval compareto As Function(Byval list_item As Any Ptr, Byval search_item As Any Ptr ) As Boolean) As Boolean		' float item to top (front) of list
	
	Declare Constructor()
	Declare Destructor()
End Type
Constructor TList()
	'
End Constructor
Destructor TList()
	'
	Dim As TNode Ptr node = this.root_node

	While node<> NULL

		Dim As TNode Ptr temp = node
		node = node->next_node
		Delete temp
		temp = 0
 	Wend
	If this.tail_node <> NULL Then this.tail_node = 0 
End Destructor
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function TList.append_item(Byval item As Any Ptr) As Boolean
	'
	Dim As TNode Ptr new_node = New TNode
	Dim As TNode Ptr last  = This.root_node
	
	this.item_count += 1
	This.tail_node = new_node
	new_node->pdata = item
	new_node->next_node = NULL
	If This.root_node = NULL Then
		new_node->prev_node = NULL
		This.root_node = new_node
		Return True 
	Endif
	While (last->next_node <> NULL)
		last = last->next_node
	Wend
	last->next_node = new_node
	new_node->prev_node = last
End Function
Function TList.delete_node(Byval node As TNode Ptr) as Boolean
	' This deletes a node from the list. It does not delete the pdata pointer to item data. 
	' Only call this sub after you have deleted the pdata pointer or if you have a pointer to that data that can be subsequently deleted
	If This.root_node = NULL or node = NULL Then
		Return False 
	Endif
	If This.root_node = node Then 
		This.root_node = node->next_node
	Endif
	If node->next_node <> NULL Then
		node->next_node->prev_node = node->prev_node
	Endif 
	if node->prev_node <> NULL Then
		node->prev_node->next_node = node->next_node
	Endif
	If This.tail_node = node Then				' adjust the top node
		This.tail_node = node->prev_node
	End If
	Delete node
End Function
Function TList.find_item(Byval item As IComparable Ptr, Byref node As TNode Ptr = NULL) As Any Ptr 
	'
	node = This.root_node
	While node <> NULL
		if item->compareto(node->pdata) = crEqual Then
			Return node->pdata
		End If
		node = node->next_node
	Wend
	node = NULL
	Return NULL
End Function
Function TList.find_item(Byval item As Any Ptr, Byval compareto As Function(Byval list_item As Any Ptr, Byval search_item As Any Ptr ) As Boolean) As Any Ptr
	'
		Dim As TNode Ptr node = This.root_node
		While node <> NULL
			If compareto(node->pdata, item) = True Then
				Return node->pdata
			End If
			node = node->next_node
		Wend
			
		Return NULL
End Function
Function TList.float(Byval node As TNode Ptr) As Boolean
	'
	If node = NULL Then Return False	' its pproblem
	If node = This.tail_node Then Return True 	

	If node <> This.root_node Then 
		node->prev_node->next_node = node->next_node	' if float node isnt root then point its predecessor to float node + 1
	Else
		This.root_node = node->next_node		' make float node ->next the new root node prior to floating node to front
	Endif

	This.tail_node->next_node = node			' point old front->next to float node
	node->prev_node = this.tail_node			' point float node->prev to old front
	node->next_node = NULL 
	This.tail_node = node
	Return True 
	
End Function
Function TList.float(Byval item as Any Ptr, Byval compareto As Function(Byval list_item As Any Ptr, Byval search_item As Any Ptr ) As Boolean) As Boolean
	'  float node with pdata = item
	Dim As TNode Ptr node = This.find_item(item, compareto)
	Return This.float(node)
End Function
Sub TList.for_each(Byval call_back As Sub(Byval item As Any Ptr))
	'
	Dim as TNode Ptr node = This.root_node
	While node <> NULL
		call_back(node->pdata)
		node = node->next_node
	Wend
End Sub 
Function TList.get_node_at_index(Byval index as Integer) As TNode Ptr 
	'
	Dim As TNode ptr node 

	If index = 1 Then Return This.root_node
	If index = this.item_count Then Return This.tail_node	
	if index > This.item_count Orelse index < 1 Then Return NULL 
	
	
	If index > (this.item_count \ 2) Then
		node = This.tail_node
		For x as Integer = This.item_count To index + 1 Step -1 
			node = node->prev_node
		Next
	Else 
		node = this.root_node
		For x as Integer = 2 To index
			node = node->next_node
		Next
	Endif
	Return node 
End Function
Function TList.insert_after(Byval prev_node As TNode Ptr, Byval item as Any Ptr) As Boolean
	'
	if prev_node = NULL Then
		Return False
	Endif
	
	Dim As TNode Ptr new_node = New TNode
	this.item_count += 1
	new_node->pdata = item
	new_node->next_node = prev_node->next_node
	prev_node->next_node = new_node
	new_node->prev_node = prev_node
	if new_node->next_node<>NULL Then
		new_node->next_node->prev_node = new_node
	Endif
	Return True 	
	
End Function
Function TList.insert_before(Byval next_node As TNode Ptr,  Byval item As Any Ptr) As Boolean
	'
	if next_node = NULL Then
		Return False
	Endif
	
	Dim As TNode Ptr new_node = New TNode
	this.item_count += 1
	new_node->pdata = item
	
	new_node->prev_node = next_node->prev_node
	new_node->next_node = next_node
	next_node->prev_node = new_node
	If new_node->prev_node <> NULL Then
		new_node->prev_node->next_node = new_node
	Else
		This.root_node = new_node
	Endif 
	Return True 
End Function
Function TList.insert_head(Byval item As Any Ptr) As Boolean
	'
	If item = NULL then Return False 
	Dim As TNode Ptr  new_node = New TNode
	new_node->pdata = item
	new_node->next_node = This.root_node
	new_node->prev_node = NULL
	If This.root_node <> NULL Then
		This.root_node->prev_node = new_node
	Endif
	This.root_node = new_node	
	this.item_count += 1
	Return True 
End Function
Function TList.pop() As Any ptr 
	' this function deletes a node but like the delete function it does not delete the pdata pointer 
	' this function returns a reference to that data
	Function = This.tail_node->pdata
	Dim As TNode ptr node =  This.tail_node->prev_node
	node->next_node = NULL 
	Delete This. tail_node
	This.tail_node = node
	This.item_count -= 1
end Function 
Function TList.push(Byval item As Any Ptr) As Boolean
	'
	Return this.append_item(item)
End Function
Function TList.sink(Byval item as Any Ptr, Byval compareto As Function(Byval list_item As Any Ptr, Byval search_item As Any Ptr ) As Boolean) As Boolean		' float item to top (front) of list
	' 
	Dim As TNode Ptr node = This.find_item(item, compareto)
	Return This.sink(node)
	
End Function 
Function TList.sink(Byval node as TNode Ptr) as Boolean
	' 
	Dim ddd As  Boolean
	If node = NULL Then Return False	' its problem
	If node = This.root_node Then Return True 	

	' bridge gap between moving node
	node->prev_node->next_node = node->next_node 	

	If node <> this.tail_node Then
		' we have to change next node->prev node only if the moving node is not the tail node
		node->next_node->prev_node = node->prev_node
	Else
		' if the moving node is the tail node we have to change it
		this.tail_node = node->prev_node
		this.tail_node->next_node = NULL
	Endif 

	Dim As TNode Ptr temp = this.root_node	' store a ref to old root node
	this.root_node = node 	' place the moved node as root
	this.root_node->next_node = temp	' next to the new root is the old root 
	temp->prev_node = this.root_node 	' prev to the old root is the new root
	
	Return True 
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Use this macro to make a list of types that do not extend ICompare 
' V is the variable name for your list
' T is the type you are going to store in the list
' CT is the pdata cast type to use in comparing items
' Ex. to make a list of strings called my_list use __MAKE_LIST__(my_list, string, string)
#Macro __MAKE_LIST__(V, T, CT)
	Type __TLIST__##V Extends TList
		Declare Property item_at(Byval index as integer) Byref As T 

		Declare Function append_item(Byval item as T, Byval pItem As T Ptr = 0) as Boolean
		Declare Function append_item(Byval item as T Ptr) As Boolean
		Declare Function clear_items() As Boolean
		Declare Function delete_item(Byval item as T) As Boolean 
		Declare Function float(Byval item as T) As Boolean
		Declare Function float(Byval index as integer) As Boolean
		Declare Sub for_each(Byval Call_back As Sub(Byval item as T Ptr))
		Declare Function get_item_at_index(Byval index As Uinteger) As T Ptr
		Declare Function insert_after(Byval prev_item As T, Byval new_item As T) As Boolean 
		Declare Function insert_after(Byval prev_item As T, Byval new_item As T ptr) As Boolean 
		Declare Function insert_before(Byval next_item As T, Byval new_item As T) As Boolean 
		Declare Function insert_before(Byval next_item As T, Byval new_item As T ptr) As Boolean 
		Declare Function insert_head(Byval item As T, Byval pitem As T Ptr = 0)  As Boolean
		Declare Function insert_head(Byval item As T Ptr) As Boolean
		Declare Function pop() As T ptr
		Declare Function push(Byval item As T) As Boolean 
		Declare Function push(Byval item As T Ptr) As Boolean 
		Declare Function sink(Byval item as T) As Boolean 
		Declare Function sink(Byval index as integer) As Boolean 

#Ifndef __ICTList__
		' find_item	- return item that matches parameter item using cast to CT (cast type) for comparison
		'					- set byref parameter node to the node containing matching item 
		Declare Function find_item(Byval item As CT, Byref node As TNode Ptr = 0) As T Ptr	' node will be filled with a pointer to a TNode that contains item
#Endif 
		' find_item	- return item that matches parameter item using parameter items comparison function
		Declare Function find_item(Byval item As IComparable Ptr, Byref node As TNode Ptr = 0) As T Ptr

		Declare Constructor()		
		Declare Destructor()
	End Type
	Constructor __TLIST__##V()
		'
		Base()
	End Constructor
	Destructor __TLIST__##V()
		'
		Dim As TNode Ptr node = this.root_node
		While node <> NULL
			Dim As TNode Ptr temp = node->next_node

			Dim As T Ptr tdata = Cast(T Ptr,  node->pdata)
			Delete tdata
			node = temp
		Wend
	End Destructor
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
	Property __TLIST__##V.item_at(Byval index as integer) Byref As T 
		'
		Return *(this.get_item_at_index(index))
	End Property

	' There are two methods of adding items to the list. You can send a pointer to your item and it will be stored in node->pData or you 
	' can add the item via byval parameter. The function then creates a new item and store that at node->pData. That item is pointed to 
	' in the byref parameter pItem
	Function __TLIST__##V.append_item(Byval item as T Ptr) As Boolean
		' add existing item to tail of list
		Return Base.append_item(@item)
	End Function
	Function __TLIST__##V.append_item(Byval item As T, Byval pItem as T Ptr = 0) As Boolean 
		' add new item to tail of list  
		' this sets the parameter pitem to point to the new'd item
		pitem = New T
		*pitem = item
		Return Base.append_item(pItem)
	End Function 
	Function __TLIST__##V.clear_items() As Boolean
		'
		dim As TNode Ptr node = this.root_node
		While node <> NULL 
			Dim As TNode Ptr temp = node
			If node->pdata <> NULL Then
				Dim As T Ptr item = Cast(T ptr, node->pdata)
				delete item
			Endif 
			node = node->next_node
			Delete temp
		Wend
		this.item_count = 0
		this.root_node = NULL
		this.tail_node = NULL
		Return True 
	End Function
	Function __TLIST__##V.delete_item(Byval item as T) As Boolean 
		' This is the function you should use to delete from the list. 
		' This function will delete both the node and the node->pData. 
		Dim As TNode Ptr node 
' If T is does not extend IComparable then we use the find_item function defined in this macro. 
' It casts the item to CT (cast type) to make the comparisons and find a matching list item.
#Ifndef __ICTList__	' if this is not an icompare type then
		Dim As T Ptr pdata = this.find_item(item, node)
#Else
' If T does extend IComparable then T will have defined a function called compareto() which is used to find a match to item. 
' In this case we use the Base version of find_item
		Dim As T Ptr pdata = base.find_item(@item, node)
#Endif 
		if pdata <> NULL Then 
			Delete pdata
		endif 
		Function = Base.delete_node(node)
		Return True 
	End Function
	Function __TLIST__##V.float(Byval item as T) As Boolean
		' This function will move the item/node to the tail of the list
		Dim As TNode Ptr node 
' see __TLIST__.DeleteItem() for a description of how this preprocessor if statement is used
#Ifndef __ICTLIST__ ' if this is not an icompare type then
		Dim As T Ptr item_node = This.find_item(item, node)
#Else
		Dim As T Ptr item_node = Base.find_item(@item, node)
#Endif 		
		If item_node =NULL Then Return False
		Return Base.float(node)
	End Function
	Function __TLIST__##V.float(Byval index as integer) As Boolean
		'
		Dim As TNode Ptr node = Base.get_node_at_index(index)
		If node = NULL Then Return False 
		Return Base.float(node)
	End Function
	Sub __TLIST__##V.for_each(Byval Call_back As Sub(Byval item as T Ptr))
		'
		Dim as TNode Ptr node = This.root_node
		While node <> NULL
			call_back(Cast(T Ptr,  node->pdata))
			node = node->next_node
		Wend
	End Sub 
	Function __TLIST__##V.get_item_at_index(Byval index As Uinteger) As T Ptr
		'
		Dim as TNode Ptr node = Base.get_node_at_index(index)
		Return Cast(T Ptr, node->pdata)
	End Function
	Function __TLIST__##V.insert_after(Byval prev_item As T, Byval new_item As T) As Boolean 
		'
		dim As T Ptr pitem = New T
		*pitem = new_item

		Dim As TNode Ptr node
' see __TLIST__.DeleteItem() for a description of how this preprocessor if statement is used
#Ifndef __ICTList__	' if this is not an icompare type then
		Dim As T Ptr item_node = This.find_item(prev_item, node)
#Else
		Dim As T Ptr item_node = Base.find_item(@prev_item, node)
#Endif 		
		If item_node <> NULL Then 
			Return Base.insert_after(node, pitem)
		Else 
			Return False
		Endif 
	End Function
	Function __TLIST__##V.insert_after(Byval prev_item As T, Byval new_item As T ptr) As Boolean 
		'
		Dim As TNode Ptr node
' see __TLIST__.DeleteItem() for a description of how this preprocessor if statement is used
#Ifndef __ICTList__	' if this is not an icompare type then
		Dim As T Ptr item_node = This.find_item(prev_item, node)
#Else
		Dim As T Ptr item_node = Base.find_item(@prev_item, node)
#Endif 		
		If item_node <> NULL Then 
			Return Base.insert_after(node, new_item)
		Else 
			Return False
		Endif 
	End Function
	Function __TLIST__##V.insert_before(Byval next_item As T, Byval new_item As T) As Boolean 
		'
		dim As T Ptr pitem = New T
		*pitem = new_item

		Dim As TNode Ptr node
' see __TLIST__.DeleteItem() for a description of how this preprocessor if statement is used
#Ifndef __ICTList__	' if this is not an icompare type then
		Dim As T Ptr item_node = This.find_item(next_item, node)
#Else
		Dim As T Ptr item_node = Base.find_item(@next_item, node)
#Endif 		
		If item_node <> NULL Then 
			Return Base.insert_before(node, pitem)
		Else 
			Return False
		Endif 
		
	End Function
	Function __TLIST__##V.insert_before(Byval next_item As T, Byval new_item As T ptr) As Boolean 
		'
		Dim As TNode Ptr node
' see __TLIST__.DeleteItem() for a description of how this preprocessor if statement is used
#Ifndef __ICTList__	' if this is not an icompare type then
		Dim As T Ptr item_node = This.find_item(next_item, node)
#Else
		Dim As T Ptr item_node = Base.find_item(@next_item, node)
#Endif 		
		If item_node <> NULL Then 
			Return Base.insert_before(node, new_item)
		Else 
			Return False
		Endif 
		
	End Function
	Function __TLIST__##V.insert_head(Byval item As T, Byval pitem As T Ptr = 0)  As Boolean
		'
		pitem = New T
		*pitem = item
		Return Base.insert_head(pitem)
	End Function 
	Function __TLIST__##V.insert_head(Byval item As T ptr) As Boolean
		'
		Return Base.insert_head(item)
	End Function
	Function __TLIST__##V.pop() As T Ptr
		'
		Dim As TNode Ptr node = Base.pop()
		Return Cast(T ptr, node->pdata)
	End Function
	Function __TLIST__##V.push(Byval item As T) As Boolean 
		' 
		Return this.append_item(item)
	End Function
	Function __TLIST__##V.push(Byval item As T Ptr) As Boolean 
		'
		return this.append_item(item)
	End Function
	Function __TLIST__##V.sink(Byval item as T) As Boolean 
		' this function moves the item/node to the head of the list
		Dim As TNode Ptr node 
' see __TLIST__.DeleteItem() for a description of how this preprocessor if statement is used
#Ifndef __ICTList__	' if this is not an icompare type then
		Dim As T Ptr item_node = This.find_item(item, node)
#Else
		Dim As T Ptr item_node = Base.find_item(@item, node)
#Endif 		
 		If item_node =NULL Then Return False
		Return Base.sink(node)

	End Function
	Function __TLIST__##V.sink(Byval index as integer) As Boolean 
		'
		Dim As TNode Ptr node = Base.get_node_at_index(index)
		If node = NULL Then Return False 
		Return Base.sink(node)
	End Function

#Ifndef __ICTList__
	Function __TLIST__##V.find_item(Byval item As CT, Byref node As TNode Ptr = 0) As T Ptr
		' 
		node = This.root_node
		While node<>NULL
			If item = Cast(CT , *Cast(T Ptr, node->pData)) Then 
				Return  Cast(T Ptr, node->pData)
			Endif 
			node = node->next_node
		Wend
		Return NULL
	End Function 
#Endif 
'
	Function __TLIST__##V.find_item(Byval item As IComparable Ptr, Byref node As TNode Ptr = 0) As T Ptr
		'
		Dim as T Ptr pdata  = Base.find_item(item, node) 
		Return pdata
	End Function
	
	Dim As __TLIST__##V V
	#Ifdef __ICTList__
		#Undef __ICTList__
	#Endif
#Endmacro
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Use this macro to make a list of a type that extends the IComparable type or that defines a function named compareto() and in this format: 
' 	Declare Function compareto(Byval o As Any Ptr) As CompareResult
' CompareResult can be an integer where instance_value <  parameter_value = -1,  instance_value = parameter_value = 0, 
' 	instance_value > parameter_value = 1

#Macro __MAKE_ICTLIST__(V, T, CT)
	#Define __ICTList__ 
	__MAKE_LIST__(V,T,CT)
#Endmacro
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Using the list
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Sub Print_item(Byval item As String  Ptr ) 
	' 
	print "-> "; *item
End Sub

Screenres 800, 600, 32
'Dim As Integer x = 12

	__MAKE_LIST__(list, String, String)
	list.append_item("meloow")
	list.append_item("peow")
	list.append_item("sow")
	list.append_item("now")
	list.append_item("How")
	list.append_item("brow")
	list.for_each(@Print_item)

	? "item at index 3 "; *(list.get_item_at_index(3))

	list.sink("How")
	?
	? "after sinking How"
	list.for_each(@Print_item)

	?
	? "item at index 6 "; *(list.get_item_at_index(6))

	list.sink(6)
	?
	? "after siniking 6 (brow)"
	list.for_each(@Print_item)

	list.float("sow")
	?
	? "after floating sow"
	list.for_each(@Print_item)

	list.insert_head("new head")
	?
	?"after insert_head new head"
	list.for_each(@Print_item)

	list.insert_after("peow", "sea cow")
	?
	? "after insert_after(peow) sea cow"
	list.for_each(@Print_item)

	list.insert_before("now", "four seas")
	?
	? "after insert_before(now) four seas"
	list.for_each(@Print_item)

	?
	?"sixth item: "; *(list.get_item_at_index(1))

	'--
	list.clear_items()

?
?"end of intrinsic type"
Sleep
cls
? " start of UDT test"

Type SpaceShip Extends IComparable
	As String name
	As Integer speed
	As Integer shields
	As Integer ammo
	Declare Function compareto(Byval o As Any Ptr) As CompareResult
	Declare Operator Cast() As String 
End Type
Function SpaceShip.compareto(Byval o As Any Ptr) As CompareResult
	If Cast(SpaceShip ptr, o)->name = this.name Then Return CompareResult.crEqual 
	Return Iif(This.name < Cast(SpaceShip Ptr, o)->name, crLess, crGreater)
End Function
Operator SpaceShip.cast() As String
	'
	Dim As String s 
	s = "Name: " & this.name & CRLF
	s &= "Speed: " & this.speed & CRLF
	s &= "Shields: " & this.shields & CRLF
	s &= "Ammo: " & this.ammo & CRLF
	
	Return s
End Operator
Sub Print_Ship(Byval  pship As SpaceShip ptr)
	'
	? Cast(String, *pship)
End Sub 


dim As SpaceShip ss

__MAKE_ICTLIST__(ship_list, SpaceShip, String)

With ss
	.name = "Transport"
	.speed = 5
	.shields = 100
	.ammo = 100
End With

ship_list.append_item(ss)
?
? "after appending first item Transport"
ship_list.for_each(@Print_ship)

With ss
	.name = "Battleship"
	.speed = 3
	.shields = 500
	.ammo = 1000
End With
ship_list.append_item(ss)

With ss
	.name = "Destroyer"
	.speed = 7
	.shields = 300
	.ammo = 500
End With
ship_list.append_item(ss)

With ss
	.name = "Fighter"
	.speed = 10
	.shields = 200
	.ammo = 200
End With
ship_list.append_item(ss)

With ss
	.name = "Starbase"
	.speed = 1
	.shields = 10000
	.ammo = 10000
End With
ship_list.append_item(ss)

With ss
	.name = "Cruiser"
	.speed = 8
	.shields = 200
	.ammo = 100
End With
ship_list.append_item(ss)

?
? "after appending 5 items"
ship_list.for_each(@Print_ship)

?
? "item at index 4"
?*(ship_list.get_item_at_index(4))
Sleep
Cls

With ss
	.name = "Escape Pod"
	.speed = 3
	.shields = 100
	.ammo = 0
End With
ship_list.insert_head(ss)

?
? "after inserting Escape pod at head"
ship_list.for_each(@Print_ship)

Sleep
Cls

ship_list.sink(6)
?
? "after sinking item 6 (starbase)"
ship_list.for_each(@Print_ship)

ship_list.float(2)
?
? "after floating item 2 (Escape pod)"
ship_list.for_each(@Print_ship)
 
ss = ship_list.item_at(4)
? Cast(string, ss)
?"-----------------------------End of UDT testing -----------------"
Sleep 
Type testtype
	As String s
	declare Operator Cast() As String 
	'Declare Function compareto(Byval o As any ptr) As CompareResult
End Type
Operator testtype.cast() As String 
	Return ""
End Operator
__MAKE_LIST__(ooo, testtype, string)

Post Reply