Code archives/Miscellaneous/Tree-like structure
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
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