Imports System.Collections.Concurrent
Imports System.ComponentModel
Imports System.Reflection
Imports System.Runtime.CompilerServices
Imports System.Text
Namespace More.Windows.Forms.Collections
''' <summary>
''' The tree structure is simultaneously a tree, and a node in a tree. The interface to
''' get children occurs through the tree itself implementing itself as a dictionary. This
''' tree is not terribly efficient, and is meant to be accomodate additions, deletions,
''' and change of values. Because it is implemented as a dictionary, there is an unfortunate
''' collision in naming between the dictionary type of "values" (which in this case are
''' child trees) and the tree type of values, called "node values."
''' </summary>
''' <typeparam name="TKey">Children are keyed with values of this type</typeparam>
''' <typeparam name="TValue">The type of the node value</typeparam>
<Serializable()>
Public NotInheritable Class ConcurrentTree(Of TKey, TValue)
Implements IDictionary(Of TKey, ConcurrentTree(Of TKey, TValue)), ICollection(Of KeyValuePair(Of TKey, ConcurrentTree(Of TKey, TValue))), IEnumerable(Of KeyValuePair(Of TKey, ConcurrentTree(Of TKey, TValue))), IEnumerable
#Region " .............................. Events ......................."
'Events
Public Event NodeAdded As EventHandler(Of NodeAddedEventArgs)
Public Event NodeDetached As EventHandler(Of NodeAddedEventArgs)
#End Region
#Region " ................ Properties .................."
''' <summary>
''' Name
''' </summary>
''' <returns></returns>
Public Property Name As String = Guid.NewGuid.ToString
''' <summary>
''' comparer As IEqualityComparer(Of TKey)
''' </summary>
''' <returns></returns>
Public Property Comparer As IEqualityComparer(Of TKey) = New ItemComparer(EqualityComparer(Of TKey).[Default])
Public ReadOnly Property HasNodeValue As Boolean
Get
Return IsNothing(_nodeValue)
End Get
End Property
''' <summary>
''' Either the node value, or the default of the value type,
''' if <see cref="P:Tree`2.HasNodeValue" /> is false.
''' </summary>
Public Property NodeValue As TValue
Get
Return Me._nodeValue
End Get
Set(value As TValue)
Me._nodeValue = value
End Set
End Property
Default Public Property Item(key As TKey) As ConcurrentTree(Of TKey, TValue) Implements System.Collections.Generic.IDictionary(Of TKey, ConcurrentTree(Of TKey, TValue)).Item
Get
Return Me._children(key)
End Get
Set(value As ConcurrentTree(Of TKey, TValue))
Me.Add(key, value)
End Set
End Property
''' <summary>
''' This is the key for this child node in its parent, if any. If this is not
''' a child of any parent, that is, it is the root of its own tree, then
''' </summary>
Public ReadOnly Property Key As TKey
Get
Return Me._key
End Get
End Property
''' <summary>
''' The parent for this tree, or <c>null</c> if it has no parent.
''' </summary>
<Category("Hierarchy"), Description("Ordered number render position"), RefreshProperties(RefreshProperties.Repaint)>
Public ReadOnly Property Parent As ConcurrentTree(Of TKey, TValue)
Get
Return Me._parent
End Get
End Property
''' <summary>
''' All child keys for this node.
''' </summary>
Public ReadOnly Property Keys As ICollection(Of TKey) Implements System.Collections.Generic.IDictionary(Of TKey, ConcurrentTree(Of TKey, TValue)).Keys
Get
Return Me._children.Keys
End Get
End Property
''' <summary>
''' All children for this node.
''' </summary>
Public ReadOnly Property Values As ICollection(Of ConcurrentTree(Of TKey, TValue)) Implements System.Collections.Generic.IDictionary(Of TKey, ConcurrentTree(Of TKey, TValue)).Values
Get
Return Me._children.Values
End Get
End Property
''' <summary>
''' The number of children with this node as a parent.
''' </summary>
Public ReadOnly Property Count As Integer Implements System.Collections.Generic.ICollection(Of System.Collections.Generic.KeyValuePair(Of TKey, ConcurrentTree(Of TKey, TValue))).Count
Get
Return Me._children.Count
End Get
End Property
Public ReadOnly Property IsReadOnly As Boolean Implements System.Collections.Generic.ICollection(Of System.Collections.Generic.KeyValuePair(Of TKey, ConcurrentTree(Of TKey, TValue))).IsReadOnly
Get
Return False
End Get
End Property
<Category("Hierarchy"), Description("Ordered number render position"), RefreshProperties(RefreshProperties.Repaint)>
Public ReadOnly Property IsChild As Boolean
Get
Return Not IsNothing(_parent)
End Get
End Property
<Category("Hierarchy"), Description("Ordered number render position"), RefreshProperties(RefreshProperties.Repaint)>
Public ReadOnly Property HierarchyDepth As Integer
Get
Return If((Me._parent Is Nothing), 0, (Me._parent.HierarchyDepth + 1))
End Get
End Property
<Category("Tag"), Description("Tag")>
Public Property Tag As Object
<Category("Hierarchy"), Description("Parent child details.")>
Public Property Children() As ConcurrentDictionary(Of TKey, ConcurrentTree(Of TKey, TValue))
Get
If IsNothing(Me._children) Then
Me._children = New ConcurrentDictionary(Of TKey, ConcurrentTree(Of TKey, TValue))
End If
Return Me._children
End Get
Set(value As ConcurrentDictionary(Of TKey, ConcurrentTree(Of TKey, TValue)))
Me._children = value
End Set
End Property
<Category("Hierarchy"), Description("Parent child details.")>
Public ReadOnly Iterator Property ChildrenDeep As IEnumerable(Of ConcurrentTree(Of TKey, TValue))
Get
If Me.Children IsNot Nothing Then
For Each c As ConcurrentTree(Of TKey, TValue) In Me.Children.Values
Yield c
For Each cc As ConcurrentTree(Of TKey, TValue) In c.ChildrenDeep
Yield cc
Next
Next
End If
Return
End Get
End Property
#End Region
''' <summary>
''' Initializes a tree with no node value, and no children.
''' </summary>
Public Sub New()
Me._children = New ConcurrentDictionary(Of TKey, ConcurrentTree(Of TKey, TValue))()
End Sub
''' <summary>
''' Tries to get the subtree for a child key.
''' </summary>
''' <param name="key">The key of the child to find</param>
''' <param name="value">The child, if any, or <c>null</c> if no child
''' with this key is present</param>
''' <returns>Whether a child with this key was present</returns>
Public Function TryGetValue(key As TKey, <System.Runtime.InteropServices.OutAttribute()> ByRef value As ConcurrentTree(Of TKey, TValue)) As Boolean Implements System.Collections.Generic.IDictionary(Of TKey, ConcurrentTree(Of TKey, TValue)).TryGetValue
Return Me._children.TryGetValue(key, value)
End Function
''' <summary>
''' ClearNodeValue
''' </summary>
Public Sub ClearNodeValue()
Me._nodeValue = Nothing
End Sub
''' <summary>
''' Sees whether a child with a given key is present.
''' </summary>
''' <param name="key">The key of the child to find</param>
''' <returns></returns>
Public Function ContainsKey(key As TKey) As Boolean Implements System.Collections.Generic.IDictionary(Of TKey, ConcurrentTree(Of TKey, TValue)).ContainsKey
Return Me._children.ContainsKey(key)
End Function
Public Function Contains(item As KeyValuePair(Of TKey, ConcurrentTree(Of TKey, TValue))) As Boolean Implements System.Collections.Generic.ICollection(Of System.Collections.Generic.KeyValuePair(Of TKey, ConcurrentTree(Of TKey, TValue))).Contains
Return item.Value IsNot Nothing AndAlso item.Value._parent Is Me AndAlso Me.Comparer.Equals(item.Key, item.Value.Key)
End Function
''' <summary>
''' Adds a new child to this dictionary.
''' </summary>
''' <param name="item">The key / child node pair to add</param>
Public Sub Add(item As KeyValuePair(Of TKey, ConcurrentTree(Of TKey, TValue))) Implements System.Collections.Generic.ICollection(Of System.Collections.Generic.KeyValuePair(Of TKey, ConcurrentTree(Of TKey, TValue))).Add
Me.Add(item.Key, item.Value)
End Sub
''' <summary>
''' Adds a node as a child of this node. This will disconnect the
''' </summary>
''' <param name="key"></param>
''' <param name="newChild"></param>
Public Sub Add(key As TKey, newChild As ConcurrentTree(Of TKey, TValue)) Implements System.Collections.Generic.IDictionary(Of TKey, ConcurrentTree(Of TKey, TValue)).Add
Me.CheckValue(Of ConcurrentTree(Of TKey, TValue))(newChild, NameOf(newChild))
Dim tree As ConcurrentTree(Of TKey, TValue) = Nothing
If Me._children.TryGetValue(key, tree) Then
tree.Detach()
End If
newChild.Detach()
newChild._key = key
newChild._parent = Me
Me._children.TryAdd(key, newChild)
'Raise event
Me.OnNodeAdded(newChild)
End Sub
''' <summary>
'''
''' </summary>
''' <typeparam name="T"></typeparam>
''' <param name="val"></param>
''' <param name="paramName"></param>
Public Sub CheckValue(Of T As Class)(val As T, paramName As String)
If val Is Nothing Then
Throw New Exception(" Except Value " & paramName)
End If
End Sub
''' <summary>
''' Removes this node and all its descendants from a tree, leading it to
''' be the root of its own tree. Following this, <see cref="P:Tree`2.Parent" /> will
''' be <c>null</c>, and the previous parent (if any) will no longer have
''' this node present as a child.
''' </summary>
Public Sub Detach()
If Me._parent Is Nothing Then
Return
End If
Dim out As ConcurrentTree(Of TKey, TValue) = Nothing
Me._parent._children.TryRemove(Me.Key, out)
'Raise event
Me.OnNodeDetached(out)
Me._parent = Nothing
Me._key = Nothing
End Sub
''' <summary>
''' Remove a child with a specified key.
''' </summary>
''' <param name="key">The key of the child to remove</param>
''' <returns></returns>
Public Function Remove(key As TKey) As Boolean Implements System.Collections.Generic.IDictionary(Of TKey, ConcurrentTree(Of TKey, TValue)).Remove
Dim tree As ConcurrentTree(Of TKey, TValue) = Nothing
If Not Me._children.TryGetValue(key, tree) Then
Return False
End If
tree.Detach()
Return True
End Function
Public Function Remove(item As KeyValuePair(Of TKey, ConcurrentTree(Of TKey, TValue))) As Boolean Implements System.Collections.Generic.ICollection(Of System.Collections.Generic.KeyValuePair(Of TKey, ConcurrentTree(Of TKey, TValue))).Remove
Dim tree As ConcurrentTree(Of TKey, TValue) = Nothing
If Not Me.TryGetValue(item.Key, tree) OrElse item.Value IsNot tree Then
Return False
End If
tree.Detach()
Return True
End Function
''' <summary>
''' Clear
''' </summary>
Public Sub Clear() Implements System.Collections.Generic.ICollection(Of System.Collections.Generic.KeyValuePair(Of TKey, ConcurrentTree(Of TKey, TValue))).Clear
For Each tree As ConcurrentTree(Of TKey, TValue) In Me._children.Values
tree._parent = Nothing
tree._key = Nothing
Next
Me._children.Clear()
End Sub
''' <summary>
''' GetEnumerator
''' </summary>
''' <returns></returns>
Public Function GetEnumerator() As IEnumerator(Of KeyValuePair(Of TKey, ConcurrentTree(Of TKey, TValue))) Implements System.Collections.Generic.IEnumerable(Of System.Collections.Generic.KeyValuePair(Of TKey, ConcurrentTree(Of TKey, TValue))).GetEnumerator
Return Me._children.GetEnumerator()
End Function
Function GetEnumerator2() As IEnumerator Implements System.Collections.IEnumerable.GetEnumerator
Return Me.GetEnumerator()
End Function
''' <summary>
''' CopyTo
''' </summary>
''' <param name="array"></param>
''' <param name="arrayIndex"></param>
Public Sub CopyTo(array As KeyValuePair(Of TKey, ConcurrentTree(Of TKey, TValue))(), arrayIndex As Integer) Implements System.Collections.Generic.ICollection(Of System.Collections.Generic.KeyValuePair(Of TKey, ConcurrentTree(Of TKey, TValue))).CopyTo
CType(Me._children, ICollection(Of KeyValuePair(Of TKey, ConcurrentTree(Of TKey, TValue)))).CopyTo(array, arrayIndex)
End Sub
#Region "............................ [[[[[[[ Event - Functions ]]]]]]]]]]]..............................."
''' <summary>
''' OnNodeAdded
''' </summary>
''' <param name="Node"></param>
Private Sub OnNodeAdded(ByRef Node As ConcurrentTree(Of TKey, TValue))
Dim n As New NodeAddedEventArgs(Node)
RaiseEvent NodeAdded(Me, n)
End Sub
''' <summary>
''' NodeDetached
''' </summary>
''' <param name="Node"></param>
Private Sub OnNodeDetached(ByRef Node As ConcurrentTree(Of TKey, TValue))
Dim n As New NodeAddedEventArgs(Node)
RaiseEvent NodeDetached(Me, n)
End Sub
#End Region
#Region "............................ [[[[[[[ Parent Child - Creation ]]]]]]]]]]].................................."
''' <summary>
''' CreateChild
''' </summary>
''' <param name="Key"></param>
''' <returns></returns>
Public Function CreateChild(Optional Key As TKey = Nothing) As ConcurrentTree(Of TKey, TValue)
Return Me.CreateChild(Key, Nothing)
End Function
''' <summary>
''' CreateChild
''' </summary>
''' <param name="Key"></param>
''' <returns></returns>
Public Function CreateChild(Key As String) As ConcurrentTree(Of TKey, TValue)
'get generic key type
'Dim typeParameterType As Type = GetType(TKey)
Return Me.CreateChild(ParseAndCastToKeytype(Key), Nothing)
End Function
''' <summary>
''' CreateChild
''' </summary>
''' <param name="Key"></param>
''' <param name="Value"></param>
''' <returns></returns>
Public Function CreateChild(ByVal Key As TKey, ByVal Value As TValue) As ConcurrentTree(Of TKey, TValue)
Dim NewNode As New ConcurrentTree(Of TKey, TValue) With {
.NodeValue = Value
}
Me.Add(Key, NewNode)
Return NewNode
End Function
''' <summary>
''' Check whether this node is part of a cyclic graph
''' </summary>
''' <param name="node"></param>
Public Sub CheckForCyclicLoops(ByRef node As ConcurrentTree(Of TKey, TValue))
Dim predecessor As ConcurrentTree(Of TKey, TValue) = Me
While predecessor.Parent IsNot Nothing
predecessor = predecessor.Parent
If predecessor.Equals(node) Then
Throw New ConcurrentTreeException("Not allowed to create cyclic scene graph")
End If
End While
End Sub
''' <summary>
''' IsAncestorOf
''' </summary>
''' <param name="descendant"></param>
''' <returns></returns>
Public Function IsAncestorOf(ByRef descendant As ConcurrentTree(Of TKey, TValue)) As Boolean
Return descendant IsNot Nothing AndAlso (Me Is descendant.Parent OrElse Me.IsAncestorOf(descendant.Parent))
End Function
''' <summary>
''' GetTopParent
''' </summary>
''' <returns></returns>
Public Function GetTopParent() As ConcurrentTree(Of TKey, TValue)
Return If(Me.Parent IsNot Nothing, Me.Parent.GetTopParent(), Me)
End Function
''' <summary>
''' IsParentOf
''' </summary>
''' <param name="Attachable"></param>
''' <returns></returns>
Public Function IsParentOf(ByRef Attachable As ConcurrentTree(Of TKey, TValue)) As Boolean
If (Attachable IsNot Me) Then
Dim i As Integer
For i = 0 To Me._children.Count - 1
If ((Me._children.Values(i) Is Attachable) OrElse Me._children.Values(i).IsParentOf(Attachable)) Then
Return True
End If
Next i
End If
Return False
End Function
''' <summary>
''' FixChildrenReferences
''' </summary>
Public Sub FixChildrenReferences()
Dim i As Integer
For i = 0 To Me.Children.Count - 1
Me.Children.Values(i)._parent = Me
Next i
End Sub
''' <summary>
''' AddChildren
''' </summary>
''' <param name="children"></param>
Public Sub AddChildren(ByVal ParamArray children As ConcurrentTree(Of TKey, TValue)())
Dim node1 As ConcurrentTree(Of TKey, TValue)
For Each node1 In children
Me.Add(ParseAndCastToKeytype(node1.Name), node1)
Next
End Sub
''' <summary>
''' AddChildren
''' </summary>
''' <param name="children"></param>
Public Sub AddChildren(ByRef children As ICollection)
Dim obj1 As ConcurrentTree(Of TKey, TValue)
For Each obj1 In children
If TypeOf obj1 IsNot ConcurrentTree(Of TKey, TValue) Then
Throw New ConcurrentTreeException("Only ConcurrentTree can be added as children to an ConcurrentTree(Of TKey, TValue)")
End If
Me.Add(ParseAndCastToKeytype(obj1.Name), obj1)
Next
End Sub
Public Sub AddChildren(ByRef children As IEnumerable(Of ConcurrentTree(Of TKey, TValue)))
Dim obj2 As ConcurrentTree(Of TKey, TValue)
For Each obj2 In children
Me.Add(ParseAndCastToKeytype(obj2.Name), obj2)
Next
End Sub
''' <summary>
''' ChooseRandomChild
''' </summary>
''' <returns></returns>
Public Function ChooseRandomChild() As ConcurrentTree(Of TKey, TValue)
Dim index As Integer = RandomUtilities.RandomInteger(0, _children.Count - 1)
Return Me._children.Values(index)
End Function
#End Region
#Region "............................ [[[[[[[ Helpers - Generic ]]]]]]]]]]].................................."
''' <summary>
''' ParseToKeytype
''' </summary>
''' <param name="value"></param>
''' <returns></returns>
Private Shared Function ParseAndCastToKeytype(ByVal value As String) As TKey
Return DirectCast(Convert.ChangeType(value, GetType(TKey)), TKey)
End Function
''' <summary>
''' Parser(Of T As Structure)
''' </summary>
''' <typeparam name="T"></typeparam>
Public Class Parser(Of T As Structure)
Delegate Function ParserFunction(ByVal value As String) As T
Public Shared ReadOnly Parse2 As ParserFunction = GetFunction()
''' <summary>
''' GetFunction
''' </summary>
''' <returns></returns>
Private Shared Function GetFunction() As ParserFunction
Dim t As Type = GetType(T)
Dim m As MethodInfo = t.GetMethod("Parse", New Type() {GetType(String)})
Dim d As ParserFunction = DirectCast(ParserFunction.CreateDelegate(GetType(ParserFunction), m), ParserFunction)
Return d
End Function
''' <summary>
''' Parse1
''' </summary>
''' <param name="value"></param>
''' <returns></returns>
Public Shared Function Parse1(ByVal value As String) As T
Return DirectCast(Convert.ChangeType(value, GetType(T)), T)
End Function
End Class
#End Region
#Region "............................ [[[[[[[ Parent child - indexing ]]]]]]]]]]].................................."
''' <summary>
''' GetFirstChild
''' </summary>
''' <returns></returns>
Public Function GetFirstChild() As ConcurrentTree(Of TKey, TValue)
If Me._children IsNot Nothing AndAlso Me._children.Count > 0 Then
Return Me._children.Values(0)
End If
Return Nothing
End Function
''' <summary>
''' IsChildOf
''' </summary>
''' <param name="parent"></param>
''' <returns></returns>
Public Function IsChildOf(parent As ConcurrentTree(Of TKey, TValue)) As Boolean
Return Me.Parent Is parent OrElse (Me.Parent IsNot Nothing AndAlso Me.Parent.IsChildOf(parent))
End Function
''' <summary>
''' IterateChildren
''' </summary>
''' <param name="forEach"></param>
''' <param name="where"></param>
Public Sub IterateChildren(forEach As Action(Of ConcurrentTree(Of TKey, TValue)), Optional where As Predicate(Of ConcurrentTree(Of TKey, TValue)) = Nothing)
If Me._children Is Nothing Then
Return
End If
For Each obj As ConcurrentTree(Of TKey, TValue) In Me._children.Values.ToArray()
If where Is Nothing OrElse where(obj) Then
forEach(obj)
End If
Next
End Sub
''' <summary>
''' GetChildrenEnumerator
''' </summary>
''' <returns></returns>
Public Function GetChildrenEnumerator() As IEnumerator
Return Me._children.GetEnumerator
End Function
Public Function GetChildObject(ByVal index As Integer) As ConcurrentTree(Of TKey, TValue)
Return If((Me._children.Count <= index), Nothing, Me._children.Values(index))
End Function
Public Function GetChildObject(ByVal name As String) As ConcurrentTree(Of TKey, TValue)
Dim obj As ConcurrentTree(Of TKey, TValue)
For Each obj In Me.Children.Values
If (obj.Name Is name) Then
Return obj
End If
Next
Throw New IndexOutOfRangeException("Invalid key specified.")
End Function
''' <summary>
''' ChildAtIndex
''' </summary>
''' <param name="index"></param>
''' <returns></returns>
Public Function ChildAtIndex(index As Integer) As ConcurrentTree(Of TKey, TValue)
Return If(Me._children Is Nothing OrElse index < 0 OrElse index >= Me._children.Count, Nothing, Me._children.Values(index))
End Function
''' <summary>
''' ChildAtIndexPath
''' </summary>
''' <param name="indexPath"></param>
''' <returns></returns>
Public Function ChildAtIndexPath(indexPath As IEnumerable(Of Integer)) As ConcurrentTree(Of TKey, TValue)
Dim gameObject As ConcurrentTree(Of TKey, TValue) = Me
For Each index As Integer In indexPath
gameObject = gameObject.ChildAtIndex(index)
If gameObject Is Nothing Then
Return Nothing
End If
Next
Return gameObject
End Function
''' <summary>
''' SetParent
''' </summary>
''' <param name="node"></param>
Public Sub SetParent(ByRef node As ConcurrentTree(Of TKey, TValue))
Me._parent = node
End Sub
''' <summary>
''' Merge
''' </summary>
''' <param name="nodeToMergeWith"></param>
Public Sub Merge(nodeToMergeWith As ConcurrentTree(Of TKey, TValue))
For i As Integer = 0 To nodeToMergeWith.Children.Count - 1
Dim node As ConcurrentTree(Of TKey, TValue) = CType(nodeToMergeWith.Children.Values(i), ConcurrentTree(Of TKey, TValue))
Dim node2 As ConcurrentTree(Of TKey, TValue) = Me.Values(node.Name)
If node2 Is Nothing Then
node2 = Me.CreateChild(node.Name)
End If
If node.HasChildNodes Then
node2.Merge(node)
End If
Next
End Sub
''' <summary>
''' GetRoot
''' </summary>
''' <returns></returns>
Public Function GetRoot() As ConcurrentTree(Of TKey, TValue)
Dim result As ConcurrentTree(Of TKey, TValue)
If Me.Parent Is Nothing Then
result = TryCast(Me, ConcurrentTree(Of TKey, TValue))
Else
Dim parent As ConcurrentTree(Of TKey, TValue) = Me.Parent
While parent.Parent IsNot Nothing
parent = parent.Parent
End While
result = parent
End If
Return result
End Function
''' <summary>
''' GetChildrenOf
''' </summary>
''' <param name="node"></param>
''' <returns></returns>
Public Function GetChildrenOf(node As ConcurrentTree(Of TKey, TValue)) As List(Of ConcurrentTree(Of TKey, TValue))
Return Me.GetChildrenOf(node.Name)
End Function
'''' <summary>
'''' GetChildrenOf
'''' </summary>
'''' <param name="nodeName"></param>
'''' <returns></returns>
Public Function GetChildrenOf(nodeName As String) As List(Of ConcurrentTree(Of TKey, TValue))
Dim result As List(Of ConcurrentTree(Of TKey, TValue)) = New List(Of ConcurrentTree(Of TKey, TValue))()
Throw New Exception("Not yet implemented")
'Me.BuildChildrenList(Me._children.Keys(nodeName), result)
Return result
End Function
''' <summary>
''' BuildChildrenList
''' </summary>
''' <param name="current"></param>
''' <param name="childrenList"></param>
Private Sub BuildChildrenList(current As ConcurrentTree(Of TKey, TValue), ByRef childrenList As List(Of ConcurrentTree(Of TKey, TValue)))
For Each cnode As ConcurrentTree(Of TKey, TValue) In current._children.Values
childrenList.Add(cnode)
Me.BuildChildrenList(cnode, childrenList)
Next
End Sub
''' <summary>
''' BuildChildrenList
''' </summary>
''' <param name="current"></param>
''' <param name="childrenList"></param>
Public Shared Sub BuildChildrenValuesList(current As ConcurrentTree(Of TKey, TValue), ByRef childrenList As List(Of TValue))
For Each cnode As ConcurrentTree(Of TKey, TValue) In current._children.Values
childrenList.Add(cnode.NodeValue)
BuildChildrenValuesList(cnode, childrenList)
Next
End Sub
''' <summary>
''' DisplayNodeHierarchy
''' </summary>
''' <returns></returns>
Public Function DisplayNodeHierarchy() As String
Dim outstr As New StringBuilder
'Console.WriteLine(vbLf & "World node hierarchy [active]:")
Me.DisplayNodeHierarchy(Me._parent, 0, 2, outstr)
' Console.WriteLine()
Return outstr.ToString
End Function
''' <summary>
''' DisplayNodeHierarchy
''' </summary>
''' <param name="current"></param>
''' <param name="level"></param>
''' <param name="[step]"></param>
''' <param name="OutStr"></param>
<MethodImpl(MethodImplOptions.AggressiveInlining)>
Private Sub DisplayNodeHierarchy(current As ConcurrentTree(Of TKey, TValue), level As Integer, [step] As Integer, ByRef OutStr As StringBuilder)
Dim flag As Boolean = False
If Me._children.Values.Contains(current) Then
flag = True
End If
'create
OutStr.AppendLine(String.Concat(New String() {New String(" "c, level), current.Name, " [", flag.ToString(), "]"}))
For Each cnode As ConcurrentTree(Of TKey, TValue) In current._children.Values
If cnode._children IsNot Nothing Then
Me.DisplayNodeHierarchy(cnode, level + [step], [step], OutStr)
End If
Next
End Sub
''' <summary>
''' GetAllDescendantsOneWay
''' </summary>
''' <param name="Objects"></param>
Public Sub GetAllDescendantsOneWay(ByRef Objects As List(Of ConcurrentTree(Of TKey, TValue)))
Dim ch As ConcurrentTree(Of TKey, TValue)
For Each ch In Me._children.Values
Dim attachable As ConcurrentTree(Of TKey, TValue) = ch
Objects.Add(attachable)
attachable.GetAllDescendantsOneWay(Objects)
Next
End Sub
'''' <summary>
'''' CloneChildren
'''' </summary>
'''' <param name="clone"></param>
'Protected Sub CloneChildren(ByRef clone As ConcurrentTree(Of TKey, TValue))
' Dim i As Integer
' For i = 0 To Me.Children.Count - 1
' clone.CreateChild(Me.Children.Values(i).Clone)
' Next i
'End Sub
''' <summary>
''' GetNthNodeAbove
''' </summary>
''' <param name="nSteps"></param>
''' <returns></returns>
Public Function GetNthNodeAbove(nSteps As Integer) As ConcurrentTree(Of TKey, TValue)
Dim result As ConcurrentTree(Of TKey, TValue)
If nSteps = 0 Then
result = Me
Else
result = Me.Parent.GetNthNodeAbove(nSteps - 1)
End If
Return result
End Function
''' <summary>
''' GetOrCreateChild
''' </summary>
''' <param name="XPath"></param>
''' <returns></returns>
Public Function GetOrCreateChild(XPath As String) As ConcurrentTree(Of TKey, TValue)
Return Me.[Get](XPath, True)
End Function
Private Function [Get](XPath As String, bCreateIfNotFound As Boolean) As ConcurrentTree(Of TKey, TValue)
Dim array As String() = XPath.Split(".".ToCharArray())
Dim node As ConcurrentTree(Of TKey, TValue) = Me
For Each text As String In array
Dim node2 As ConcurrentTree(Of TKey, TValue) = CType(node.Children.Values(text), ConcurrentTree(Of TKey, TValue))
If node2 Is Nothing Then
If Not bCreateIfNotFound Then
Return Nothing
End If
node2 = node.CreateChild(text)
End If
node = node2
Next
Return node
End Function
''' <summary>
''' FindFirstNode
''' </summary>
''' <param name="name"></param>
''' <returns></returns>
Public Function FindFirstNode(name As String) As ConcurrentTree(Of TKey, TValue)
Dim result As ConcurrentTree(Of TKey, TValue)
If Me.HasChild(name) Then
result = CType(Me.Children.Values(name), ConcurrentTree(Of TKey, TValue))
Else
For Each obj As Object In Me.Children
Dim node As ConcurrentTree(Of TKey, TValue) = CType(obj, ConcurrentTree(Of TKey, TValue))
Dim node2 As ConcurrentTree(Of TKey, TValue) = node.FindFirstNode(name)
If node2 IsNot Nothing Then
Return node2
End If
Next
result = Nothing
End If
Return result
End Function
''' <summary>
''' GetFlattened
''' </summary>
''' <returns></returns>
Public Function GetFlattened() As List(Of ConcurrentTree(Of TKey, TValue))
Dim list As List(Of ConcurrentTree(Of TKey, TValue)) = New List(Of ConcurrentTree(Of TKey, TValue))()
For Each obj As Object In Me.Children
Dim node As ConcurrentTree(Of TKey, TValue) = CType(obj, ConcurrentTree(Of TKey, TValue))
node.AddToFlattened(list)
Next
Return list
End Function
''' <summary>
''' AddToFlattened
''' </summary>
''' <param name="flat"></param>
Private Sub AddToFlattened(flat As List(Of ConcurrentTree(Of TKey, TValue)))
flat.Add(Me)
For Each obj As Object In Me.Children
Dim node As ConcurrentTree(Of TKey, TValue) = CType(obj, ConcurrentTree(Of TKey, TValue))
node.AddToFlattened(flat)
Next
End Sub
''' <summary>
''' AttachToParent
''' </summary>
''' <param name="newParent"></param>
Public Sub AttachToParent(newParent As ConcurrentTree(Of TKey, TValue))
Me.Detach()
Me._parent = newParent
End Sub
Private ReadOnly _bAutoCreateChildIfNotExists As Boolean = True
<Category("Hierarchy - Parent,child"), Description("Hierarchy..")>
Public ReadOnly Property ChildIndexed(index As Integer) As ConcurrentTree(Of TKey, TValue)
Get
Return CType(Me.Children.Values(index), ConcurrentTree(Of TKey, TValue))
End Get
End Property
<Category("Hierarchy - Parent,child"), Description("Hierarchy..")>
Public ReadOnly Property ChildByXpath(XPath As String) As ConcurrentTree(Of TKey, TValue)
Get
Return Me.[Get](XPath, Me._bAutoCreateChildIfNotExists)
End Get
End Property
<Category("Hierarchy - Parent,child"), Description("Hierarchy..")>
Public ReadOnly Property HasChildNodes As Boolean
Get
Return Me.Children.Count > 0
End Get
End Property
<Category("Hierarchy"), Description("Parent and childeren property info ...")>
Public Property Index As Long = 0
<Category("Hierarchy"), Description("Parent and childeren property info ...")>
Public ReadOnly Property ParentIndex As Long
Get
Return If(Not IsNothing(_parent), Me._parent.Index, -1)
End Get
End Property
<Category("Hierarchy"), Description("Parent and childeren property info ...")>
Public ReadOnly Property HierarchicalName As String
Get
If Me.Parent IsNot Nothing Then
Return Me.Parent.HierarchicalName + "\" + Me.Name
End If
Return Me.Name
End Get
End Property
<Category("Hierarchy"), Description("Parent and childeren property info ...")>
Public ReadOnly Property RootNode As ConcurrentTree(Of TKey, TValue)
Get
Dim result As ConcurrentTree(Of TKey, TValue)
If Me.Parent IsNot Nothing Then
result = Me.Parent.RootNode
Else
result = Me
End If
Return result
End Get
End Property
#End Region
#Region "................. Has Child ......................."
''' <summary>
''' HasChild
''' </summary>
''' <param name="SceneObject"></param>
''' <returns></returns>
Public Function HasChild(ByRef SceneObject As ConcurrentTree(Of TKey, TValue)) As Boolean
Return ((Me.Children IsNot Nothing) AndAlso Me.HasNestedChild(SceneObject))
End Function
Public Function HasChild(ByVal Name As String) As Boolean
Return (Me.Children IsNot Nothing) AndAlso Me.HasChildNamed(Name)
End Function
'Private Function HasIndependentChildren() As Boolean
' Dim obj2 As SceneObject
' For Each obj2 In Me.mparent.Children
' If Not obj2.IsBoundingBoxMergedWithParent Then
' Return True
' End If
' Next
' Return False
'End Function
''' <summary>
''' HasNestedChild
''' </summary>
''' <param name="child"></param>
''' <returns></returns>
Public Function HasNestedChild(ByRef child As ConcurrentTree(Of TKey, TValue)) As Boolean
If (Me.Children.Count > 0) Then
Dim obj2 As ConcurrentTree(Of TKey, TValue)
For Each obj2 In Me.Children.Values
If (child Is obj2) Then
Return True
End If
If obj2.HasNestedChild(child) Then
Return True
End If
Next
End If
Return False
End Function
''' <summary>
''' HasNestedChild
''' </summary>
''' <param name="child"></param>
''' <returns></returns>
Public Function HasNestedChild(ByVal child As String) As Boolean
If (Me.Children.Count > 0) Then
Dim obj2 As ConcurrentTree(Of TKey, TValue)
For Each obj2 In Me.Children.Values
If (child = obj2.Name) Then
Return True
End If
If obj2.HasNestedChild(child) Then
Return True
End If
Next
End If
Return False
End Function
''' <summary>
''' HasChildNamed
''' </summary>
''' <param name="child"></param>
''' <returns></returns>
Private Function HasChildNamed(ByVal child As String) As Boolean
If (Me.Children.Count > 0) Then
Dim obj2 As ConcurrentTree(Of TKey, TValue)
For Each obj2 In Me.Children.Values
If (child = obj2.Name) Then
Return True
End If
If obj2.HasNestedChild(child) Then
Return True
End If
Next
End If
Return False
End Function
#End Region
#Region "......................................... [[[[[[[ Locking ]]]]]]]]]]] .................................."
' Public Property IsLocked As Boolean
<Category("Locking"), Description("Lock so it cannot be moved or changed (Default if locked)."), RefreshProperties(RefreshProperties.Repaint)>
Public Property IsLocked() As Boolean
<Category("Locking"), Description("Lock so it cannot be moved or changed (Default if locked)."), RefreshProperties(RefreshProperties.Repaint)>
Public Property IsChildNodesListLocked As Boolean
''' <summary>
''' Lock
''' </summary>
Public Sub Lock()
Me.IsLocked = True
End Sub
''' <summary>
''' UnLock
''' </summary>
Public Sub UnLock()
Me.IsLocked = False
End Sub
''' <summary>
''' LockChildNodes
''' </summary>
Public Sub LockChildNodes()
Me.IsChildNodesListLocked = True
End Sub
''' <summary>
''' CheckIsChangeAllowed
''' </summary>
Public Sub CheckIsChangeAllowed()
If Me.IsLocked Then
Throw New InvalidOperationException("childrens list cannot be updated")
End If
End Sub
''' <summary>
''' CheckIsChildNodeChangeAllowed
''' </summary>
Public Sub CheckIsChildNodeChangeAllowed()
If Me.IsLocked Then
Throw New InvalidOperationException("This Scene object Is currentley marked")
End If
If Me.IsChildNodesListLocked Then
Throw New InvalidOperationException("childrens list cannot be updated")
End If
End Sub
#End Region
#Region "......................................... [[[[[[[ Properties ]]]]]]]]]]] .................................."
Private _key As TKey
Private _nodeValue As TValue
Private _children As ConcurrentDictionary(Of TKey, ConcurrentTree(Of TKey, TValue))
Private _parent As ConcurrentTree(Of TKey, TValue)
''' <summary>
''' ItemComparer
''' </summary>
Private Class ItemComparer
Implements IEqualityComparer(Of TKey)
Private ReadOnly _comparer As IEqualityComparer(Of TKey)
''' <summary>
''' New
''' </summary>
''' <param name="comparer"></param>
Public Sub New(ByVal comparer As IEqualityComparer(Of TKey))
_comparer = comparer
End Sub
Public Overloads Function Equals(ByVal x As TKey, ByVal y As TKey) As Boolean Implements IEqualityComparer(Of TKey).Equals
Return _comparer.Equals(x, y)
End Function
Public Overloads Function GetHashCode(ByVal obj As TKey) As Integer Implements IEqualityComparer(Of TKey).GetHashCode
Return _comparer.GetHashCode(obj)
End Function
End Class
#End Region
#Region " ..................... Event - Args .........................."
''' <summary>
''' DrawNodeEventArgs
''' </summary>
Public Class NodeAddedEventArgs
Inherits EventArgs
Public Sub New(ByRef Node As ConcurrentTree(Of TKey, TValue))
'Me.Tree = Tree
Me.Node = Node
End Sub
'Public Property Tree As ConcurrentDictionary(Of TKey, ConcurrentTree(Of TKey, TValue))
Public Property Node As ConcurrentTree(Of TKey, TValue)
End Class
#End Region
End Class
End Namespace
Imports System.Runtime.Serialization
Namespace More.Windows.Forms.Collections
<Serializable>
Public Class ConcurrentTreeException
Inherits Exception
Public Sub New()
End Sub
Public Sub New(ByVal userMessage As String)
MyBase.New(userMessage)
End Sub
Protected Sub New(ByVal info As SerializationInfo, ByVal context As StreamingContext)
MyBase.New(info, context)
End Sub
Public Sub New(ByVal userMessage As String, ByVal originalException As Exception)
MyBase.New(userMessage, originalException)
End Sub
End Class
End Namespace
|