Sorry your browser is not supported!

REM Project: TreeSearch
REM Created: 17/12/2006 13:07:02
REM 
`This is the treesearch module

Type TreeSearch
    Value as string
    Include as boolean
    Right as integer
    Left as integer
EndType

Type TreeSearchProperties
    EntryNum as integer
EndType

Function Setup_TreeSearch()
`Set up the tree search database array (Link-list)
Global MaxTreeSearches, MaxTreeValues
MaxTreeSearches = 10
MaxTreeValues = 1000
MaxValueValues = 3
Dim TreeSearchBase(MaxTreeSearches, MaxTreeValues) as TreeSearch
Dim TreeSearchProperties(MaxTreeSearches) as TreeSearchProperties
Dim TreeSearchNodeValue(MaxTreeSearches, MaxTreeValues, MaxValueValues) as string
EndFunction

Function AddTreeSearchItem(TreeSearch, Value as string)
`Add 1 to the current entry number of this tree search
Inc TreeSearchProperties(TreeSearch).EntryNum
Value = Lower$(Value)
`If this is the first entery
If TreeSearchProperties(TreeSearch).EntryNum = 1
    TreeSearchBase(TreeSearch, 1).Value = Value
    TreeSearchBase(TreeSearch, 1).Include  =1
Else
    `If this is not the first entry
    Node = 1
    Repeat
        `If this value is less than the first value
        If Value <= TreeSearchBase(TreeSearch, Node).Value
            `Then find the lowest entry
            If TreeSearchBase(TreeSearch, Node).Left <> 0
                Node = TreeSearchBase(TreeSearch, Node).Left
            Else
                `If it is below the current value, then add it to the index
                TreeSearchBase(TreeSearch, Node).Left = TreeSearchProperties(TreeSearch).EntryNum
                TreeSearchBase(TreeSearch, TreeSearchProperties(TreeSearch).EntryNum).Value = Value
                TreeSearchBase(TreeSearch, TreeSearchProperties(TreeSearch).EntryNum).Include  =1
                ValueFound = 1
            endIf
        `If this value is more than the first value
        Else 
            `Then find the highest entry
            If TreeSearchBase(TreeSearch, Node).Right <> 0
                Node = TreeSearchBase(TreeSearch, Node).Right
            Else
                `If it is above the current value, then add it to the index
                TreeSearchBase(TreeSearch, Node).Right = TreeSearchProperties(TreeSearch).EntryNum
                TreeSearchBase(TreeSearch, TreeSearchProperties(TreeSearch).EntryNum).Value = Value
                TreeSearchBase(TreeSearch, TreeSearchProperties(TreeSearch).EntryNum).Include  =1
                ValueFound = 1
            Endif
        EndIf
    Until ValueFound = 1                   
EndIf
EndFunction 

Function AddValueToTreeSearchItem(TreeSearch as integer, Value as string, NewValue as string, NewValueNum)
`Get the value node number
Node = GetValueNode(TreeSearch, Value)
`Record the new value in the nodes value array
TreeSearchNodeValue(TreeSearch, Node, NewValueNum) = Lower$(NewValue)
EndFunction

Function GetValueFromTreeSearchItem(TreeSearch, ItemValue as string, ValueNum as integer)
`Get the item value node
Node = GetValueNode(TreeSearch, ItemValue)
`Get the value
NewValue$ = Lower$(TreeSearchNodeValue(TreeSearch, Node, ValueNum))
EndFunction NewValue$

Function DecludeValueFromTree(TreeSearch, Value as string)
Node = GetValueNode(TreeSearch, Value)
TreeSearchBase(TreeSearch, Node).Include = 0
EndFunction SearchValue

Function GetValueNode(TreeSearch, Value as string)
`Set node to 1
node = 1
Repeat
    `If the value is the current nodes value
    If Lower$(Value) = Lower$(TreeSearchBase(TreeSearch, Node).Value) and TreeSearchBase(TreeSearch, Node).Include = 1
        Found = 1
        SearchValue = Node

    EndIf
    
    `If the current nodes value is 0, then this value does not exist in the database
    If Node = 0
        Found = 1
        SearchValue = 0
    EndIf
    
    `If the value is above the current nodes value
    If lower$(Value) =< Lower$(TreeSearchBase(TreeSearch, Node).Value)
        `Go left
        Node = TreeSearchBase(TreeSearch, Node).Left
    Else `If the value is above the current nodes value
        `Go right
        Node = TreeSearchBase(TreeSearch, Node).Right
    EndIf
Until Found = 1
EndFunction SearchValue

`This function returns the lowest value in the tree dbase
Function GetTreeLowest(TreeSearch)
Node = 1
Repeat
    `If there is nothing lower than the current nodes value
    If TreeSearchBase(TreeSearch, Node).Left = 0
    `The lowest avaliable value has been found, now set it to the valid lowest, if it is enabled/included
        If TreeSearchBase(TreeSearch, Node).Include = 1
            ValidNode = Node
        Endif
        done = 1
    Else `If there is something lower than the current nodes value
        `Set the current node to the node of the lower value
        If TreeSearchBase(TreeSearch, Node).Include = 1
            Validnode = Node
        EndIf
        Node = TreeSearchBase(TreeSearch, Node).Left
    EndIf
Until done = 1
Lowestval$ = TreeSearchBase(TreeSearch, ValidNode).Value
EndFunction Lowestval$

Function DebugTreeSearch(TreeSearch)
For i = 1 to TreeSearchProperties(TreeSearch).EntryNum
    Text 1, i * 20, "Node: " + str$(i) + " Value: " + TreeSearchBase(TreeSearch, i).Value+ " Left: " + str$(TreeSearchBase(TreeSearch, i).Left) + " Right " + Str$(TreeSearchBase(TreeSearch, i).Right) + " Include: " + Str$(TreeSearchBase(TreeSearch, i).Include)
Next i
Endfunction

Sync on
Sync rate 60
Setup_TreeSearch() `Initilize all variables, and create arrays.
LoadObject("ExampleObject", "ExampleObject.X")

Do
Text 1, 1, "The object number for ExampleObject is "+str$(GetObjectNum("ExampleObject"))
sync
Loop

Function LoadObject(ObjectName as string, ObjectFile as string)
ObjectNum = FreeObject()
`Load object ObjectNum, ObjectFile
AddTreeSearchItem(ObjectTreeSearch, ObjectName) `Add the object name to the list
AddValueToTreeSearchItem(ObjectTreeSearch, ObjectName, Str$(OBjectNum), 1) `Add the object number to the list
EndFunction

Function GetObjectNum(ObjectName as string)
ObjectNum = val(GetValueFromTreeSearchItem(ObjectTreeSearch, ObjectName, 1))
EndFunction ObjectNum

Function FreeObject()
Repeat
    Inc FNum
    If Object exist(FNum) = 0 then found = 1
Until Found = 1
Endfunction FNum