Code archives/Miscellaneous/Tree-like structure

This code has been declared by its author to be Public Domain code.

Download source code

Tree-like structure by Matt Merkulov2007
From article: Tree-like structure (rus)
;Tree-like structure demo by Matt Merkulov

;Controls: arrows - move; Ins, PgUp, PgDown - create element; Del - remove

Type element
  ;User fields of element
 Field r,g,b
 ;auxillary element fields
 Field root.element,prev.element,nxt.element,sub.element
End Type

;root element
Global root.element=New element

Global ex,ey,sel.element

Graphics 800,600
branchcreate root,9
sel=root\sub
SetBuffer BackBuffer()
Repeat
 Cls
 ex=0:ey=0
 branchview root
 Flip
 Select WaitKey()
  Case 3;Ins
   sel=einsertin(Null,sel)
  Case 4;Del
   sel2.element=Null
   If sel\prev<>Null Then
    sel2=sel\prev
   ElseIf sel\nxt<>Null Then
    sel2=sel\nxt
   ElseIf sel\root<>root
    sel2=sel\root
   End If
   If sel2<>Null Then eremove sel:sel=sel2
  Case 5;Page Up
   sel=einsertbefore(Null,sel)
  Case 6;Page Down
   sel=einsertafter(Null,sel)
  Case 27;Esc
   Exit
  Case 28;up arrow
   If sel\prev<>Null Then sel=sel\prev
  Case 29;down arrow
   If sel\nxt<>Null Then sel=sel\nxt
  Case 30;right arrow
   If sel\sub<>Null Then sel=sel\sub
  Case 31;left arrow
   If sel\root<>root Then sel=sel\root
 End Select
Forever

;Function for creation of random branch with elements from certain element (k-maximum quantity)
Function branchcreate(e.element,k)
q=Rand(1,k)
;Create q elements
For n=1 To q
 e2.element=einsertin(Null,e)
 ;In 1/3 of cases create branch from current element, decreasing maximum of possible elements on 2
 If Rand(1,3)=1 Then branchcreate e2,k-2
Next
End Function

;Branch displaying (recursion is used)
Function branchview(e.element)
ex=ex+35
e=e\sub
ey1=ey-6
ey2=ey1
While e<>Null
 Line ex-20,ey+10,ex+15,ey+10
 ;Highlighting current element
 If e=sel Then c=127 Else c=0
 ;If element have no color set - set it randomly
 If e\r=0 Then
  e\r=Rand(1,128)
  e\g=Rand(1,128)
  e\b=Rand(1,128)
 End If
 Color c+e\r,c+e\g,c+e\b
 Rect ex,ey,30,20
 Color 255,255,255
 Rect ex,ey,30,20,False
 ey2=ey+10
 ey=ey+25
 branchview e
 e=e\nxt
Wend
Line ex-20,ey1,ex-20,ey2
ex=ex-35
End Function

;Inserton of element after certain
Function einsertafter.element(what.element,afterwhat.element)
;If element is not specified - creating new, else deleting it correctly from group
If what=Null Then what=New element Else epush what
;Connecting new element with previous and next in group
what\prev=afterwhat
what\nxt=afterwhat\nxt
If afterwhat\nxt<>Null Then afterwhat\nxt\prev=what
afterwhat\nxt=what
;Setting the root and returning pointer to the element
what\root=afterwhat\root
Return what
End Function

;Inserton of element before certain
Function einsertbefore.element(what.element,beforewhat.element)
If what=Null Then what=New element Else epush what
what\prev=beforewhat\prev
what\nxt=beforewhat
If beforewhat\prev<>Null Then beforewhat\prev\nxt=what
what\root=beforewhat\root
;If element is placed before first in group - connecting parent with it
If what\prev=Null Then what\root\sub=what
beforewhat\prev=what
Return what
End Function

;Inserton of element in group of certain
Function einsertin.element(what.element,inwhat.element)
If what=Null Then what=New element Else epush what
;Placing element in the beginning of the group
what\prev=Null
If inwhat\sub=Null Then
 what\nxt=Null
Else
 ;If the group is not empty - shifting first element down and connect it to new
 what\nxt=inwhat\sub
 inwhat\sub\prev=what
End If
;Connecting group parent with new element (now first in group)
inwhat\sub=what
what\root=inwhat
Return what
End Function

;Deleting element with all his branches
Function eremove(what.element,care=True)
;Deleting element correctly from group
If care Then epush what
e.element=what\sub
;If the element contains branches inside - deleting 'em using recursion
While e<>Null
 e2.element=e
 e=e\nxt
 ;Elements inside don't needs to be correctly removed from group
 eremove e2,False
Wend
Delete what
End Function

;Auxillary function - correct removing of element from group
Function epush(what.element)
;Connecting previous and nect elements with each other
;If removed element is situated on top of the group - connecting parent element with next
If what\prev<>Null Then what\prev\nxt=what\nxt Else what\root\sub=what\nxt
If what\nxt<>Null Then what\nxt\prev=what\prev
End Function

Comments

None.

Code Archives Forum