If you have some idea for improve this code, please post it in this topic.
Enjoy this
ps.
left mouse click - move selected node to center
right mouse click - add child to selected node
EDIT: added feature for checking objects outside the image bounds
Code: Select all
#maximum_nodes = 255
#angle_offset = -90
Enumeration
#Window
#RadiaLayoutImage
#RadiaLayoutImageBlank
#RadiaLayoutImageLast
#ImageGadget
EndEnumeration
Structure NODE
id.l
parent.l
amin.f
amax.f
angle.f
amin_child.f
radial.f
region.l
new_angle.f
new_radial.f
old_angle.f
old_radial.f
x.l
y.l
EndStructure
Structure NODEARRANGE
parent.l
count_childs.l
count_end_childs.l
EndStructure
Global motion_step
Global motion_time.l
Global degrees.f = #PI / 180
Global cx = 630 / 2
Global cy = 630 / 2
Global rs = 40
Global node_over = -1
Global last_node_id.l = 1
Global motion_constant.f = 0.5 / ATan ( 5 )
Global Dim node_index.l( #maximum_nodes )
Global NewMap nodes.NODE()
nodes( "1" )\id = 1
nodes( "1" )\parent = 0
Enumeration 1
#COINCIDENT
#PARALLEL
#INTERESECTING
#NOT_INTERESECTING
EndEnumeration
Global Dim map_ignore_sections( 10, 10 )
Restore ignore_sections
Repeat
Read.l s1
Read.l s2
If s1 And s2
map_ignore_sections( s1, s2 ) = 1
EndIf
Until s1 = 0
DataSection
ignore_sections:
Data.l 1,1, 1,2, 1,3, 1,4, 1,7
Data.l 2,1, 2,2, 2,3
Data.l 3,1, 3,2, 3,3, 3,6, 3,9
Data.l 4,1, 4,4, 4,7
Data.l 6,3, 6,6, 6,9
Data.l 7,1, 7,4, 7,7, 7,8, 7,9
Data.l 8,7, 8,8, 8,9
Data.l 9,3, 9,6, 9,7, 9,8, 9,9
Data.l 0,0
EndDataSection
; 1 | 2 | 3
; ---------------
; 4 | 5 | 6
; ---------------
; 7 | 8 | 9
Procedure PointInSection ( px, py, left, top, right, bottom )
If px < left
If py < top : ProcedureReturn 1 : EndIf
If py <= bottom : ProcedureReturn 4 : EndIf
If py > bottom : ProcedureReturn 7 : EndIf
ElseIf px <= right
If py < top : ProcedureReturn 2 : EndIf
If py <= bottom : ProcedureReturn 5 : EndIf
If py > bottom : ProcedureReturn 8 : EndIf
Else
If py < top : ProcedureReturn 3 : EndIf
If py <= bottom : ProcedureReturn 6 : EndIf
If py > bottom : ProcedureReturn 9 : EndIf
EndIf
EndProcedure
Procedure GetIntersectionPoint ( x1, y1, x2, y2, x3, y3, x4, y4, *P.POINT )
x13 = x1 - x3 : y13 = y1 - y3
x21 = x2 - x1 : y21 = y2 - y1
x43 = x4 - x3 : y43 = y4 - y3
denom.f = ( y43 * x21 ) - ( x43 * y21 )
nume_a.f = ( x43 * y13 ) - ( y43 * x13 )
nume_b.f = ( x21 * y13 ) - ( y21 * x13 )
If denom = 0
If nume_a = 0 And nume_b = 0
ProcedureReturn #COINCIDENT
EndIf
ProcedureReturn #PARALLEL
EndIf
ua.f = nume_a / denom
ub.f = nume_b / denom
If ua >= 0 And ua <= 1 And ub >= 0 And ub <= 1
*P\x = x1 + ua * x21
*P\y = y1 + ua * y21
ProcedureReturn #INTERESECTING
EndIf
ProcedureReturn #NOT_INTERESECTING
EndProcedure
Procedure LineOverBorder ( section, p1x, p1y, p2x, p2y, left, top, right, bottom, *P.POINT )
cross = 0
If section = 1 Or section = 2 Or section = 3
cross = GetIntersectionPoint ( p1x, p1y, p2x, p2y, left, top, right, top, @PC.POINT )
EndIf
If cross = 0 And ( section = 1 Or section = 4 Or section = 7 )
cross = GetIntersectionPoint ( p1x, p1y, p2x, p2y, left, top, left, bottom, @PC.POINT )
EndIf
If cross = 0 And ( section = 3 Or section = 6 Or section = 9 )
cross = GetIntersectionPoint ( p1x, p1y, p2x, p2y, right, top, right, bottom, @PC.POINT )
EndIf
If cross = 0 And ( section = 7 Or section = 8 Or section = 9 )
cross = GetIntersectionPoint ( p1x, p1y, p2x, p2y, left, bottom, right, bottom, @PC.POINT )
EndIf
*P\x = PC\x
*P\y = PC\y
ProcedureReturn cross
EndProcedure
Procedure.l ColorBlending ( Couleur1.l, Couleur2.l, Echelle.f )
Protected Rouge, Vert, Bleu, Rouge2, Vert2, Bleu2
Rouge = Couleur1 & $FF
Vert = Couleur1 >> 8 & $FF
Bleu = Couleur1 >> 16
Rouge2 = Couleur2 & $FF
Vert2 = Couleur2 >> 8 & $FF
Bleu2 = Couleur2 >> 16
Rouge = Rouge * Echelle + Rouge2 * ( 1 - Echelle )
Vert = Vert * Echelle + Vert2 * ( 1 - Echelle )
Bleu = Bleu * Echelle + Bleu2 * ( 1 - Echelle )
ProcedureReturn ( Rouge | Vert <<8 | Bleu << 16 )
EndProcedure
Procedure CircleAA ( X, Y, Radius, Color, Thickness = 1, Mode = #PB_2DDrawing_Default )
If PointInSection ( X, Y, 0 + Radius + 2, 0 + Radius + 2, OutputWidth () - Radius - 2, OutputHeight () - Radius - 2 ) <> 5
ProcedureReturn 0
EndIf
Protected n, nn, Distance.f, Application.f, Couleur_Fond.l
If Mode & #PB_2DDrawing_Outlined
For n = 0 To Radius
For nn = 0 To Radius
Distance.f = Sqr ( n * n + nn * nn )
If Distance <= Radius And Distance > Radius - 1
Application.f = Abs(Radius - 1 - Distance)
Plot ( X + n, Y + nn, ColorBlending ( Point ( X + n, Y + nn ), Color, Application ) )
Plot ( X - n, Y + nn, ColorBlending ( Point ( X - n, Y + nn ), Color, Application ) )
Plot ( X + n, Y - nn, ColorBlending ( Point ( X + n, Y - nn ), Color, Application ) )
Plot ( X - n, Y - nn, ColorBlending ( Point ( X - n, Y - nn ), Color, Application ) )
ElseIf Distance <= Radius - Thickness And Distance > Radius - Thickness - 1
Application.f = Abs(Radius - Thickness - Distance)
Plot ( X + n, Y + nn, ColorBlending ( Point ( X + n, Y + nn ), Color, Application ) )
Plot ( X - n, Y + nn, ColorBlending ( Point ( X - n, Y + nn ), Color, Application ) )
Plot ( X + n, Y - nn, ColorBlending ( Point ( X + n, Y - nn ), Color, Application ) )
Plot ( X - n, Y - nn, ColorBlending ( Point ( X - n, Y - nn ), Color, Application ) )
ElseIf Distance <= Radius - 1 And Distance > Radius - Thickness
Plot ( X + n, Y + nn, Color )
Plot ( X - n, Y + nn, Color )
Plot ( X + n, Y - nn, Color )
Plot ( X - n, Y - nn, Color )
EndIf
Next
Next
Else
For n = 0 To Radius
For nn = 0 To Radius
Distance.f = Sqr(n * n + nn * nn)
If Distance <= Radius And Distance > Radius - 1
Application.f = 1 - ( Radius - Distance )
Plot ( X + n, Y + nn, ColorBlending ( Point ( X + n, Y + nn ), Color, Application ) )
Plot ( X - n, Y + nn, ColorBlending ( Point ( X - n, Y + nn ), Color, Application ) )
Plot ( X + n, Y - nn, ColorBlending ( Point ( X + n, Y - nn ), Color, Application ) )
Plot ( X - n, Y - nn, ColorBlending ( Point ( X - n, Y - nn ), Color, Application ) )
ElseIf Distance <= Radius - 1
Plot ( X + n, Y + nn, Color )
Plot ( X - n, Y + nn, Color )
Plot ( X + n, Y - nn, Color )
Plot ( X - n, Y - nn, Color )
EndIf
Next
Next
EndIf
EndProcedure
Procedure LineAA ( X, Y, Width, Hight, Color, Thickness = 1 )
Protected SensX, SensY, n, nn, Epaisseur.f, x2.f, y2.f, Couleur_Fond.l, Application.f, Distance.f
left = 2
top = 2
right = OutputWidth () - 4
bottom = OutputHeight () - 4
p1x = X
p1y = Y
p2x = X + Width
p2y = Y + Hight
section_p1 = PointInSection ( p1x, p1y, left, top, right, bottom )
section_p2 = PointInSection ( p2x, p2y, left, top, right, bottom )
If map_ignore_sections ( section_p1, section_p2 )
ProcedureReturn 0
EndIf
For c = 1 To 2
Select c
Case 1 : section = section_p1
Case 2 : section = section_p2
EndSelect
If LineOverBorder ( section, p1x, p1y, p2x, p2y, left, top, right, bottom, @IP.POINT ) = #INTERESECTING
Select c
Case 1 : p1x = IP\x : p1y = IP\y
Case 2 : p2x = IP\x : p2y = IP\y
EndSelect
EndIf
Next
section_p1 = PointInSection ( p1x, p1y, left, top, right, bottom )
section_p2 = PointInSection ( p2x, p2y, left, top, right, bottom )
If section_p1 <> 5 And section_p2 <> 5
ProcedureReturn 0
EndIf
X = p1x
Y = p1y
Width = p2x - p1x
Hight = p2y - p1y
If Width >= 0 : SensX = 1 : Else : SensX = -1 : Width = - Width : EndIf
If Hight >= 0 : SensY = 1 : Else : SensY = -1 : Hight = - Hight : EndIf
Epaisseur.f = Thickness / 2
Distance.f = Sqr ( Width * Width + Hight * Hight )
CosAngle.f = Width / Distance
SinAngle.f = -Sin ( ACos ( CosAngle ) )
For n = -Thickness To Width + Thickness
For nn = -Thickness To Hight + Thickness
y2 = Abs ( n * SinAngle + nn * CosAngle )
If y2 <= Epaisseur + 0.5
x2 = n * CosAngle - nn * SinAngle
Application = 0.5 + Epaisseur - y2
If Application > 1
Application = 1
EndIf
If x2 > -1 And x2 < Distance + 1
If x2 < 0
Application * ( 1 + x2 )
ElseIf x2 > Distance
Application * ( 1 - x2 + Distance )
EndIf
Else
Continue
EndIf
If Application > 0
plot_color = Color
If Application < 1
plot_color = ColorBlending ( Color, Point ( X + n * SensX, Y + nn * SensY ), Application )
EndIf
Plot ( X + n * SensX, Y + nn * SensY, plot_color )
EndIf
EndIf
Next
Next
EndProcedure
Procedure PaintBlankLayout ()
If StartDrawing ( ImageOutput ( #RadiaLayoutImageBlank ) )
Box ( 0, 0, 630, 630, RGB ( 255, 255, 255 ) )
DrawingMode ( #PB_2DDrawing_Outlined )
For r = 6 To 1 Step -1
color = $a0 + 8 * r
; Circle ( cx, cy, rs * r, RGB ( color, color, color ) )
CircleAA ( cx, cy, rs * r, RGB ( color, color, color ), 1, #PB_2DDrawing_Outlined )
Next
; Circle ( cx, cy, 2 )
CircleAA ( cx, cy, 2, RGB ( color, color, color ), 1, #PB_2DDrawing_Outlined )
StopDrawing ()
EndIf
CopyImage ( #RadiaLayoutImageBlank, #RadiaLayoutImage )
EndProcedure
Procedure RepaintImage ()
Protected Dim p.Point(10)
Protected Dim circles.POINT ( #maximum_nodes )
Protected Dim nodes_xy.POINT( #maximum_nodes )
Protected circle_id = 0
ForEach nodes()
id = nodes()\id
nodes_xy( id )\x = nodes()\x
nodes_xy( id )\y = nodes()\y
Next
; Debug "RepaintImage"
If motion_step > 50
CopyImage ( #RadiaLayoutImageLast, #RadiaLayoutImage )
Else
CopyImage ( #RadiaLayoutImageBlank, #RadiaLayoutImage )
If StartDrawing ( ImageOutput ( #RadiaLayoutImage ) )
DrawingMode ( #PB_2DDrawing_Default )
FrontColor ( RGB ( 100, 100, 255 ) )
ForEach nodes ()
id = nodes()\id
parent = nodes()\parent
x = nodes()\x
y = nodes()\y
If nodes()\region
DeleteObject_ ( nodes()\region )
EndIf
index = 0
For a = 0 To 360 Step 36
ad = a * degrees
p(index)\x = x + 10 * Cos ( ad )
p(index)\y = y + 10 * Sin ( ad )
index + 1
Next
nodes()\region = CreatePolygonRgn_ ( p(), 10, #ALTERNATE )
circles( circle_id )\x = x
circles( circle_id )\y = y
circle_id + 1
If parent > 0
If motion_step < 50
LineXY ( nodes_xy( parent )\x, nodes_xy( parent )\y, x, y, RGB ( 0, 0, 0 ) )
Else
width = nodes_xy( parent )\x - x
height = nodes_xy( parent )\y - y
LineAA ( x, y, width, height, RGB ( 0, 0, 0 ), Thickness = 1 )
EndIf
EndIf
DrawText ( x - 4, y - 20, Str ( nodes()\id ), RGB(0,0,0), RGB(255,255,255) )
Next
For c = 0 To circle_id - 1
; Circle ( circles( c )\x, circles( c )\y, 6 )
CircleAA ( circles( c )\x, circles( c )\y, 6, RGB ( 100, 100, 255 ), 1 )
Next
StopDrawing ()
EndIf
EndIf
If motion_step = 50
CopyImage ( #RadiaLayoutImage, #RadiaLayoutImageLast )
EndIf
If node_over > 0
If StartDrawing ( ImageOutput ( #RadiaLayoutImage ) )
; DrawingMode ( #PB_2DDrawing_Outlined )
; FrontColor ( RGB ( 100, 100, 255 ) )
; Circle ( nodes_xy( node_over )\x, nodes_xy( node_over )\y, 10 )
CircleAA ( nodes_xy( node_over )\x, nodes_xy( node_over )\y, 10, RGB ( 100, 100, 255 ), 1, #PB_2DDrawing_Outlined )
; DrawingMode ( #PB_2DDrawing_Default )
StopDrawing ()
EndIf
EndIf
SetGadgetState ( #ImageGadget, ImageID ( #RadiaLayoutImage ) )
EndProcedure
Procedure RadialMotion ( )
Protected new.f, old.f, radial.f, angle.f, x.l, y.l
; Debug "RadialMotion"
new = ATan( ( motion_step / 50.0 ) * 10 - 5 ) * motion_constant + 0.5
old = 1 - new
move = #False
ForEach nodes()
radial = nodes()\radial
angle = nodes()\angle
If radial <> nodes()\new_radial
radial = nodes()\old_radial * old + nodes()\new_radial * new
nodes()\radial = radial
move = #True
EndIf
If radial > 0 And nodes()\angle <> nodes()\new_angle
angle = nodes()\old_angle * old + nodes()\new_angle * new
nodes()\angle = angle
move = #True
EndIf
radial = radial * rs
angle = ( angle + #angle_offset ) * degrees
nodes()\x = cx + radial * Cos ( angle )
nodes()\y = cy + radial * Sin ( angle )
Next
If move = #True
RepaintImage()
EndIf
If motion_step > 49 Or move = #False
KillTimer_ ( WindowID ( #Window ), 1 )
; Debug GetTickCount_ () - motion_time
EndIf
motion_step + 1
EndProcedure
Procedure Rearange ()
Protected c.l, parent.l, piece_angle.f, width.f, id.l, parent_id.l, root_id
Protected amin.f, amax.f, angle.f, ad.f, radial.f
Protected Dim node_arrange.NODEARRANGE( #maximum_nodes )
Protected Dim index_table.l ( #maximum_nodes )
Protected Dim skip_table.l ( #maximum_nodes )
Protected last_id = 0
; Debug "Rearange"
ForEach nodes()
id = nodes()\id
parent = nodes()\parent
node_arrange( id )\parent = parent
node_index( id ) = Val ( MapKey ( nodes() ) )
If last_id < id : last_id = id : EndIf
If parent = 0 : root_id = id : EndIf
Next
For c = last_id To 1 Step -1
parent = c
While parent
parent = node_arrange( parent )\parent
node_arrange( parent )\count_childs + 1
If node_arrange( c )\count_childs = 0
node_arrange( parent )\count_end_childs + 1
EndIf
Wend
Next
piece_angle = 360 / node_arrange( 0 )\count_end_childs
last = 1
offset = 1
index_table( last ) = root_id
Repeat
found = #False
For c = 1 To last_id
parent = node_arrange( c )\parent
If index_table( offset ) = parent And skip_table( c ) <> parent
found = #True
last + 1
skip_table ( c ) = parent
index_table ( last ) = c
EndIf
Next
If found = #False : offset + 1 : EndIf
Until last = last_id
For d = 1 To last_id
c = index_table ( d )
ends = node_arrange( c )\count_end_childs
parent = node_arrange( c )\parent
If ends = 0 : ends = 1 : EndIf
width = piece_angle * ends
c_str.s = Str ( c )
parent_str.s = Str ( node_arrange( c )\parent )
If parent = 0
nodes( c_str )\new_radial = 0
nodes( c_str )\amin = 0
nodes( c_str )\amax = width
nodes( c_str )\amin_child = 0
Else
amin = nodes( parent_str )\amin_child
nodes( c_str )\new_radial = nodes( parent_str )\new_radial + 1
nodes( c_str )\amin = amin
nodes( c_str )\amax = amin + width
nodes( c_str )\amin_child = amin
nodes( parent_str )\amin_child + width
EndIf
Next
ForEach nodes()
angle = nodes()\angle
nodes()\old_angle = angle
nodes()\old_radial = nodes()\radial
nodes()\new_angle = ( nodes()\amax + nodes()\amin ) / 2
nodes()\x = cx + nodes()\radial * rs * Cos ( angle )
nodes()\y = cy + ( nodes()\angle + #angle_offset ) * degrees * Sin ( angle )
Next
EndProcedure
Procedure Recenter ( new_id.l )
Protected Dim parents.l ( #maximum_nodes )
Protected Dim new_parents.l ( #maximum_nodes )
Protected last_id.l = 0
; Debug "Recenter"
ForEach nodes()
id = nodes()\id
parents( id ) = nodes()\parent
If nodes()\parent = 0 : root_id = id : EndIf
Next
parent = parents ( new_id )
last_parent = new_id
new_parents( parent ) = new_id
If parent = root_id
parent_for_root = new_id
ElseIf parent > 0
Repeat
new_parents( parent ) = last_parent
last_parent = parent
parent = parents( parent )
Until parent = root_id Or parent = 0
parent_for_root = last_parent
EndIf
ForEach nodes()
id = nodes()\id
If id = new_id
nodes()\parent = 0
ElseIf id = root_id
nodes()\parent = parent_for_root
ElseIf new_parents( id ) > 0
nodes()\parent = new_parents ( id )
EndIf
Next
EndProcedure
Procedure CheckObjects ( px.l, py.l )
old_node_over = node_over
node_over = -1
ForEach nodes()
If PtInRegion_ ( nodes()\region, px, py )
node_over = nodes()\id
Break
EndIf
Next
If node_over > -1 Or old_node_over <> node_over
RepaintImage ()
EndIf
ProcedureReturn node_over
EndProcedure
Procedure StartRadialMotion ()
Rearange ()
motion_step = 0
Settmr = SetTimer_( WindowID ( #Window ), 1, 10, @RadialMotion() )
; motion_time = GetTickCount_ ()
EndProcedure
Procedure AddNode ( parent.l )
last_node_id + 1
Protected id_string.s = Str ( last_node_id )
Protected parent_index.s = ""
nodes( id_string )\id = last_node_id
nodes( id_string )\parent = parent
If nodes( id_string )\parent > 0
parent_index = Str ( node_index( nodes( id_string )\parent ) )
nodes( id_string )\radial = nodes( parent_index )\radial
nodes( id_string )\angle = nodes( parent_index )\angle
EndIf
StartRadialMotion ()
EndProcedure
Procedure ImageViewProc ( hwnd, msg, wParam, lParam )
Select msg
Case #WM_PAINT
; Debug "paint"
Case #WM_MOUSEMOVE
mouse_x = lParam & $FFFF
mouse_y = ( ( lParam >> 16 ) & $FFFF )
id = CheckObjects ( mouse_x, mouse_y )
Case #WM_LBUTTONDOWN
If node_over > -1
; Debug "node click: " + Str ( node_over )
Recenter ( node_over )
StartRadialMotion ()
EndIf
Case #WM_RBUTTONDOWN
If node_over > -1
AddNode ( node_over )
EndIf
EndSelect
ProcedureReturn CallWindowProc_( GetProp_( hwnd, "oldproc" ), hwnd, msg, wParam, lParam )
EndProcedure
Procedure FreeObjects ()
ForEach nodes()
If nodes()\region
DeleteObject_ ( nodes()\region )
EndIf
Next
EndProcedure
If OpenWindow ( #Window, 332, 80, 640, 640, "Radial Layout", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
CreateImage ( #RadiaLayoutImage, 630, 630 )
CreateImage ( #RadiaLayoutImageBlank, 630, 630 )
ImageGadget ( #ImageGadget, 5, 5, 630, 630, ImageID ( #RadiaLayoutImage ) )
PaintBlankLayout()
Rearange ()
motion_step = 0
RepaintImage ()
Settmr = SetTimer_( WindowID(#Window), 1, 30, @RadialMotion() )
hwnd = GadgetID ( #ImageGadget )
SetProp_( hwnd, "oldproc", SetWindowLong_( hwnd, #GWL_WNDPROC, @ImageViewProc() ) )
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_CloseWindow ; If the user has pressed on the close button
Quit = 1
EndIf
Until Quit = 1
EndIf
FreeObjects ()
End
