#include Once "window9.bi"

Type TLISTNODE
	
	xValue As Any Ptr
	
	pPrev As TLISTNODE Ptr =0
	
	pNext As TLISTNODE Ptr =0
	
End Type

Type TLIST
	
	pFirst As TLISTNODE Ptr =0
	
	pLast As TLISTNODE Ptr =0
	
	pCurent As TLISTNODE Ptr =0
	
	iSize As Long =0
	
	iCurentIndex As Long
	
	Declare Destructor()
	
	Declare Sub Add(xValue As Any Ptr)
	
	Declare Sub InsertItemIndex(iIndex As Long , xValue As Any Ptr)
	
	Declare Sub InsertItem(pItem As TLISTNODE Ptr, xValue As Any Ptr, iIndex As Long =-1)
	
	Declare Sub DeleteItemIndex(iIndex As Long, bFlagFreeMemoryStrings As Long = 0)
	
	Declare Sub DeleteItem(pItem As TLISTNODE Ptr, bFlagFreeMemoryStrings As Long = 0)
	
	Declare Sub DeleteAll(bFlagFreeMemoryStrings As Long = 0)
	
	Declare Sub SetValueIndex(iIndex As Long , xValue As Any Ptr)
	
	Declare Sub SetValue(pItem As TLISTNODE Ptr , xValue As Any Ptr)
	
	Declare Sub MoveItemIndex(iIndexFrom As Long , iIndexTo As Long)
	
	Declare Sub MoveItem(pItemFrom As TLISTNODE Ptr , pItemTo As TLISTNODE Ptr , iIndex As Long =-1)
	
	Declare Function GetFirst() As TLISTNODE Ptr
	
	Declare Function GetLast() As TLISTNODE Ptr
	
	Declare Function GetNext(pItem As TLISTNODE Ptr) As TLISTNODE Ptr
	
	Declare Function GetPrev(pItem As TLISTNODE Ptr) As TLISTNODE Ptr
	
	Declare Function GetSize() As Long
	
	Declare Function GetValueIndex(iIndex As Long) As Any Ptr
	
	Declare Function GetValue(pItem As TLISTNODE Ptr) As Any Ptr
	
	Declare Sub SetCurent(iIndex As Long)
	
End Type

Destructor TLIST()
	
	DeleteAll()
	
End Destructor

Sub TLIST.Add(xValue As Any Ptr)
	
	Dim As TLISTNODE Ptr pTemp = New TLISTNODE
	
	if pTemp then
		
		pTemp->xValue =xValue
		
		If pFirst =0 Then
			
			pFirst =pTemp
			
			pLast =pTemp
			
		Else
			
			pLast->pNext =pTemp
			
			pTemp->pPrev =pLast
			
			pLast =pTemp
			
		Endif
		
		pCurent =pLast
		
		iCurentIndex =iSize
		
		iSize+=1
		
	endif
	
End Sub

Sub TLIST.InsertItemIndex(iIndex As Long , xValue As Any Ptr)
	
	If pFirst =0 Orelse iIndex >= iSize Then
		
		This.Add(xValue)
		
		Exit Sub
		
	Endif
	
	If iIndex <0 Then
		
		Exit Sub
		
	Endif
	
	SetCurent(iIndex)
	
	InsertItem(pCurent , xValue , iIndex)
	
End Sub

Sub TLIST.InsertItem(pItem As TLISTNODE Ptr, xValue As Any Ptr , iIndex As Long =-1)
	
	If pFirst =0 Orelse pItem =0 Then
		
		This.Add(xValue)
		
		Exit Sub
		
	Endif
	
	Dim As TLISTNODE Ptr pTemp = New TLISTNODE
	
	if pTemp then
		
		pTemp->xValue =xValue
		
		If pItem =pFirst Then
			
			pTemp->pNext =pFirst
			
			pFirst->pPrev =pTemp
			
			pFirst =pTemp
			
		Else
			
			pTemp->pNext =pItem
			
			pTemp->pPrev =pItem->pPrev
			
			pItem->pPrev->pNext =pTemp
			
			pItem->pPrev =pTemp
			
		Endif
		
		If iIndex =-1 Then
			
			pCurent =pFirst
			
			iCurentIndex =0
			
		Else
			
			pCurent =pTemp
			
			iCurentIndex =iIndex
			
		Endif
		
		iSize+=1
		
	endif
	
End Sub

Sub TLIST.DeleteItemIndex(iIndex As Long , bFlagFreeMemoryStrings As Long = 0)
	
	If pFirst =0 Orelse iIndex >= iSize Orelse iIndex <0 Orelse iSize =0 Then
		
		Exit Sub
		
	Endif
	
	SetCurent(iIndex)
	
	DeleteItem(pCurent , bFlagFreeMemoryStrings)
	
End Sub

Sub TLIST.DeleteItem(pItem As TLISTNODE Ptr, bFlagFreeMemoryStrings As Long = 0)
	
	If pItem =0 Orelse iSize =0 Then
		
		Exit Sub
		
	Endif
	
	If pItem =pFirst Then
		
		pFirst =pFirst->pNext
		
		If pFirst Then
			
			pFirst->pPrev =0
			
		Endif
		
		If pItem =pLast Then
			
			pLast =pFirst
			
		Endif
		
	Elseif pItem =pLast Then
		
		pLast =pLast->pPrev
		
		pLast->pNext =0
		
	Else
		
		pItem->pPrev->pNext =pItem->pNext
		
		pItem->pNext->pPrev =pItem->pPrev
		
	Endif
	
	If bFlagFreeMemoryStrings Andalso pItem->xValue Then
		
		Deallocate(pItem->xValue)
		
	Endif
	
	Delete pItem
	
	iSize -=1
	
	If iSize =0 Then
		
		pFirst =0
		
		pLast =0
		
		pCurent =0
		
		iCurentIndex =0
		
	Else
		
		pCurent =pFirst
		
		iCurentIndex =0
		
	Endif
	
End Sub

Sub TLIST.DeleteAll(bFlagFreeMemoryStrings As Long = 0)
	
	Dim As TLISTNODE Ptr pDel , pTemp =pFirst
	
	While pTemp
		
		pDel =pTemp
		
		pTemp =pTemp->pNext
		
		If bFlagFreeMemoryStrings Andalso pDel->xValue Then
			
			Deallocate(pDel->xValue)
			
		Endif
		
		Delete pDel
		
	Wend
	
	iSize =0
	
	pFirst =0
	
	pLast =0
	
	pCurent =0
	
	iCurentIndex =0
	
End Sub

Sub TLIST.SetValueIndex(iIndex As Long , xValue As Any Ptr)
	
	If pFirst =0 Orelse iIndex >= iSize Orelse iIndex <0 Orelse iSize =0 Then
		
		Exit Sub
		
	Endif
	
	SetCurent(iIndex)
	
	pCurent->xValue =xValue
	
End Sub

Sub TLIST.SetValue(pItem As TLISTNODE Ptr , xValue As Any Ptr)
	
	If pItem =0 Orelse pFirst =0 Then
		
		Exit Sub
		
	Endif
	
	pItem->xValue =xValue
	
End Sub

Sub TLIST.MoveItemIndex(iIndexFrom As Long , iIndexTo As Long)
	
	If pFirst =0 Orelse iIndexFrom >= iSize Orelse iIndexFrom <0 Orelse iIndexTo >=iSize Orelse iIndexTo <0 Orelse iSize <2 Orelse iIndexFrom =iIndexTo Then
		
		Exit Sub
		
	Endif
	
	SetCurent(iIndexTo)
	
	Dim pResultTo As TLISTNODE Ptr =pCurent
	
	SetCurent(iIndexFrom)
	
	MoveItem(pCurent , pResultTo , iIndexTo)
	
	iCurentIndex =iIndexTo
	
End Sub

Sub TLIST.MoveItem(pItemFrom As TLISTNODE Ptr , pItemTo As TLISTNODE Ptr , iIndex As Long =-1)
	
	If pItemFrom =0 Orelse pItemTo =0 Orelse pItemFrom =pItemTo Orelse pFirst =0 Orelse iSize <2 Then
		
		Exit Sub
		
	Endif
	
	If pItemFrom =pFirst Andalso pItemTo =pLast Then
		
		pFirst =pFirst->pNext
		
		pFirst->pPrev =0
		
		pItemFrom->pPrev =pLast
		
		pLast->pNext =pItemFrom
		
		pItemFrom->pNext =0
		
		pLast =pItemFrom
		
	Elseif pItemFrom =pLast Andalso pItemTo =pFirst Then
		
		pLast =pLast->pPrev
		
		pLast->pNext =0
		
		pItemFrom->pNext =pFirst
		
		pFirst->pPrev =pItemFrom
		
		pItemFrom->pPrev =0
		
		pFirst =pItemFrom
		
	Elseif pItemFrom =pLast Then
		
		pLast =pLast->pPrev
		
		pItemFrom->pPrev =pItemTo->pPrev
		
		pItemTo->pPrev->pNext =pItemFrom
		
		pItemFrom->pNext =pItemTo
		
		pItemTo->pPrev =pItemFrom
		
		pLast->pNext =0
		
	Elseif pItemFrom =pFirst Then
		
		pFirst =pFirst->pNext
		
		pItemFrom->pNext =pItemTo->pNext
		
		pItemTo->pNext->pPrev =pItemFrom
		
		pItemFrom->pPrev =pItemTo
		
		pItemTo->pNext =pItemFrom
		
		pFirst->pPrev =0
		
	Elseif pItemTo =pFirst Then
		
		pItemFrom->pNext->pPrev =pItemFrom->pPrev
		
		pItemFrom->pPrev->pNext =pItemFrom->pNext
		
		pItemFrom->pNext =pItemTo
		
		pItemTo->pPrev =pItemFrom
		
		pItemFrom->pPrev =0
		
		pFirst =pItemFrom
		
	Elseif pItemTo =pLast Then
		
		pItemFrom->pNext->pPrev =pItemFrom->pPrev
		
		pItemFrom->pPrev->pNext =pItemFrom->pNext
		
		pItemFrom->pPrev =pItemTo
		
		pItemTo->pNext =pItemFrom
		
		pItemFrom->pNext =0
		
		pLast =pItemFrom
		
	Else
		
		pItemFrom->pPrev->pNext =pItemFrom->pNext
		
		pItemFrom->pNext->pPrev =pItemFrom->pPrev
		
		If pItemFrom<pItemTo Then
			
			pItemFrom->pNext =pItemTo->pNext
			
			pItemTo->pNext->pPrev =pItemFrom
			
			pItemTo->pNext =pItemFrom
			
			pItemFrom->pPrev =pItemTo
			
		Else
			
			pItemTo->pPrev->pNext =pItemFrom
			
			pItemFrom->pPrev =pItemTo->pPrev
			
			pItemFrom->pNext =pItemTo
			
			pItemTo->pPrev =pItemFrom
			
		Endif
		
	Endif
	
	If iIndex =-1 Then
		
		iCurentIndex =0
		
		pCurent =pFirst
		
	Endif
	
End Sub

Function TLIST.GetFirst() As TLISTNODE Ptr
	
	Return pFirst
	
End Function

Function TLIST.GetLast() As TLISTNODE Ptr
	
	Return pLast
	
End Function

Function TLIST.GetNext(pItem As TLISTNODE Ptr) As TLISTNODE Ptr
	
	Return pItem->pNext
	
End Function

Function TLIST.GetPrev(pItem As TLISTNODE Ptr) As TLISTNODE Ptr
	
	Return pItem->pPrev
	
End Function

Function TLIST.GetSize() As Long
	
	Return iSize
	
End Function

Function TLIST.GetValueIndex(iIndex As Long) As Any Ptr
	
	If iIndex <0 Orelse iIndex >= iSize Orelse pFirst =0 Then
		
		Exit Function
		
	Endif
	
	SetCurent(iIndex)
	
	Return pCurent->xValue
	
End Function

Function TLIST.GetValue(pItem As TLISTNODE Ptr) As Any Ptr
	
	Return pItem->xValue
	
End Function

Sub TLIST.SetCurent(iIndex As Long)
	
	If iCurentIndex =iIndex Then Exit Sub
	
	Dim As Long iE =iSize-iIndex-1
	
	Dim As Long iC =Abs(iCurentIndex -iIndex)
	
	Dim As Long iStep =1
	
	If iE <iIndex Then
		
		iStep =-1
		
	Else
		
		iE =iIndex
		
	Endif
	
	If iE <iC Then
		
		If iStep =1 Then
			
			pCurent =pFirst
			
			For i As Long =0 To iIndex-1
				
				pCurent =pCurent->pNext
				
			Next
			
		Else
			
			pCurent =pLast
			
			For i As Long =iSize To iIndex+2 Step -1
				
				pCurent =pCurent->pPrev
				
			Next
			
		Endif
		
	Else
		
		If iIndex >iCurentIndex Then
			
			For i As Long =iCurentIndex To iIndex-1
				
				pCurent =pCurent->pNext
				
			Next
			
		Else
			
			For i As Long =iCurentIndex-1 To iIndex Step -1
				
				pCurent =pCurent->pPrev
				
			Next
			
		Endif
		
	Endif
	
	iCurentIndex =iIndex
	
End Sub

Function CreateList() As Any Ptr
	
	Return New TLIST
	
End Function

Function GetSizeList(p As Any Ptr) As Long
	
	If p Then
		
		Return Cast(TLIST Ptr,p)->iSize
		
	Endif
	
End Function

Sub AddList(p As Any Ptr , anyValue As Any Ptr)
	
	If p Then
		
		Cast(TLIST Ptr,p)->Add(anyValue)
		
	Endif
	
End Sub

Sub AddStrList(p As Any Ptr , anyValue As USTRING)
	
	If p Then
		
		#ifdef UNICODE
			Dim As Long iLen = Len(anyValue)
		#else
			Dim As Long iLen = Len(anyValue)
		#endif
		
		If iLen Then
			
			#ifdef UNICODE
				
				Dim As Wstring Ptr pws = Allocate(Sizeof(Wstring)*(iLen+1))
				
			#else
				
				Dim As Zstring Ptr pws = Allocate(iLen+1)
				
			#endif
			
			if pws then
				
				*pws = anyValue
				
				(*pws)[iLen] = 0
				
			endif
			
			Cast(TLIST Ptr , p)->Add(pws)
			
		Else
			
			Cast(TLIST Ptr , p)->Add(0)
			
		Endif
		
	Endif
	
End Sub

Function GetValueList(p As Any Ptr , iIndex As Long) As Any Ptr
	
	If p Then
		
		Return Cast(TLIST Ptr,p)->GetValueIndex(iIndex)
		
	Endif
	
End Function

Function GetValueStrList(p As Any Ptr , iIndex As Long) As USTRING
	
	If p Then
		
		Dim As USTRING sRet
		
		#ifdef UNICODE
			Dim As Wstring Ptr pTemp = Cast(TLIST Ptr , p)->GetValueIndex(iIndex)
		#else
			Dim As Zstring Ptr pTemp = Cast(TLIST Ptr , p)->GetValueIndex(iIndex)
		#endif
		
		If pTemp Then
			
			sRet = *pTemp
			
		Endif
		
		Return sRet
		
	Endif
	
End Function

Sub InsertItemList(p As Any Ptr , iIndex As Long , anyValue As Any Ptr)
	
	If p Then
		
		Cast(TLIST Ptr,p)->InsertItemIndex(iIndex , anyValue)
		
	Endif
	
End Sub

Sub InsertItemStrList(p As Any Ptr , iIndex As Long , anyValue As USTRING)
	
	If p Then
		
		#ifdef UNICODE
			Dim As Long iLen = Len(anyValue)
		#else
			Dim As Long iLen = Len(anyValue)
		#endif
		
		If iLen Then
			
			#ifdef UNICODE
				
				Dim As Wstring Ptr pws = Allocate(Sizeof(Wstring)*(iLen+1))
				
			#else
				
				Dim As Zstring Ptr pws = Allocate(iLen+1)
				
			#endif
			
			if pws then
				
				*pws = anyValue
				
				(*pws)[iLen] = 0
				
			endif
			
			Cast(TLIST Ptr , p)->InsertItemIndex(iIndex , pws)
			
		Else
			
			Cast(TLIST Ptr , p)->InsertItemIndex(iIndex , 0)
			
		Endif
		
	Endif
	
End Sub

Sub SetValueList(p As Any Ptr , iIndex As Long , anyValue As Any Ptr)
	
	If p Then
		
		Cast(TLIST Ptr,p)->SetValueIndex(iIndex , anyValue)
		
	Endif
	
End Sub

Sub SetValueStrList(p As Any Ptr , iIndex As Long , anyValue As USTRING)
	
	If p Then
		
		#ifdef UNICODE
			Dim As Long iLen = Len(anyValue)
		#else
			Dim As Long iLen = Len(anyValue)
		#endif
		
		Dim As Any Ptr pPrevData = Cast(TLIST Ptr , p)->GetValueIndex(iIndex)
		
		If pPrevData Then
			
			Deallocate(pPrevData)
			
		Endif
		
		If iLen Then
			
			#ifdef UNICODE
				
				Dim As Wstring Ptr pws = Allocate(Sizeof(Wstring)*(iLen+1))
				
			#else
				
				Dim As Zstring Ptr pws = Allocate(iLen+1)
				
			#endif
			
			if pws then
				
				*pws = anyValue
				
				(*pws)[iLen] = 0
				
			endif
			
			Cast(TLIST Ptr , p)->SetValueIndex(iIndex , pws)
			
		Else
			
			Cast(TLIST Ptr , p)->SetValueIndex(iIndex , 0)
			
		Endif
		
	Endif
	
End Sub

Sub MoveItemList(p As Any Ptr , iIndexFrom As Long , iIndexTo As Long)
	
	If p Then
		
		Cast(TLIST Ptr,p)->MoveItemIndex(iIndexFrom  , iIndexTo)
		
	Endif
	
End Sub

Sub DeleteItemList(p As Any Ptr , iIndex As Long , bFlagFreeMemoryStrings As Long = 0)
	
	If p Then
		
		Cast(TLIST Ptr,p)->DeleteItemIndex(iIndex , bFlagFreeMemoryStrings)
		
	Endif
	
End Sub

Sub FreeList(p As Any Ptr , bFlagFreeMemoryStrings As Long = 0)
	
	If p Then
		
		Cast(TLIST Ptr,p)->DeleteALL(bFlagFreeMemoryStrings)
		
	Endif
	
End Sub

Sub DeleteList(p As Any Ptr, bFlagFreeMemoryStrings As Long = 0)
	
	If p Then
		
		Cast(TLIST Ptr,p)->DeleteALL(bFlagFreeMemoryStrings)
		
		Delete Cast(TLIST Ptr,p)
		
	Endif
	
End Sub
