Voronoi diagrams are apparently a rather bonecrushing algorithm. I forget the O notation but the best possible is pretty slow. Adding recursion sped it up hugely. I'm doing this for a reason but I thought it was interesting enough to share.
It seems like you could pretty easily cull the tree by running paths between different regions, bailing out on the second region, and building up a list, per centroid, of neighbors. Probably the smart people already thought of this.
If you watch you'll see some very strange artifacts around some of the edges. I'm not quite sure why they are in there, probably some sort of precision error.
' VORONOI CREATOR PRO
' BROKEN BY SPATHI MCZOQFOT AND THE WAREZIRD
' GREETS TO SUPERPIRATES 612
Global WIDTH=1024
Global HEIGHT=768
Graphics WIDTH,HEIGHT
Global mode# = 0
Type voronoipoint
Field x#,y#
Field r#,g#,b#
Field id#
' bounding box for region
Field ux#,uy#,lx#,ly#
Method randomize()
x = Rand(WIDTH)
y = Rand(HEIGHT)
ux = x
uy = y
lx = x
ly = y
r=Rand(255)
g=Rand(255)
b=Rand(255)
End Method
End Type
Global vpointlist:TList = New TList
For Local i# = 1 To 32
Local tempvpoint:voronoipoint = New voronoipoint
tempvpoint.randomize()
tempvpoint.id = i
vpointlist.addlast(tempvpoint)
Next
Function closestvpoint:voronoipoint(x#, y#) ' returns closest voronoi point for x and y
Local closestpoint:voronoipoint = New voronoipoint
Local closestdistance:Double = 10000
Local nextclosestdistance:Double = 10000
Local p:voronoipoint = New voronoipoint
For p = EachIn vpointlist
Local thisdistance:Float = Distance(x, y, p.x,p.y)
If thisdistance < closestdistance
nextclosestdistance = closestdistance
closestdistance = thisdistance
closestpoint = p
EndIf
Next
Return closestpoint
End Function
Function thesame(a#,b#,c#,d#)
If a=b And a=c And a=d
Return True
Else
Return False
EndIf
End Function
Global p1:voronoipoint = New voronoipoint
Global p2:voronoipoint = New voronoipoint
Global p3:voronoipoint = New voronoipoint
Global p4:voronoipoint = New voronoipoint
Global tempvor:voronoipoint = New voronoipoint
'Function voronoirecursive(ax, ay, bx, by, cx, cy, dx, dy)
Function voronoirecursive(ux, uy, lx, ly, recursions#)
If recursions < 5 And KeyDown(KEY_ESCAPE) recursions = 1000
If recursions < 12
' check all four points clockwise
p1=closestvpoint(ux,uy)
p2=closestvpoint(lx,uy)
p3=closestvpoint(lx,ly)
p4=closestvpoint(ux,ly)
If thesame(p1.id, p2.id, p3.id, p4.id)
Local midpointx# = ux + ((lx-ux)/2)
Local midpointy# = uy + ((ly-uy)/2)
tempvor=closestvpoint(midpointx,midpointy)
SetColor p1.r,p1.g,p1.b
DrawRect ux, uy, lx-ux, ly-uy
SetColor 0,0,0
' Increase extents of bounding box
If ux < p1.ux p1.ux = ux
If lx > p1.lx p1.lx = lx
If uy < p1.uy p1.uy = uy
If ly > p1.ly p1.ly = ly
If mode = 2 Or mode = 3 drawhollowrect(ux,uy,lx,ly)
If recursions < 7 Flip
Return True
Else
midpointx# = ux + ((lx-ux)/2)
midpointy# = uy + ((ly-uy)/2)
voronoirecursive(ux, uy, midpointx, midpointy, recursions+1)
voronoirecursive(midpointx, midpointy, lx, ly, recursions+1)
voronoirecursive(ux, midpointy, midpointx, ly, recursions+1)
voronoirecursive(midpointx, uy, lx, midpointy, recursions+1)
EndIf
EndIf ' bailing out because recursions too high
End Function
Function lefthalf:Object(data:Object)
voronoirecursive(0,0,width/2,height,1)
End Function
Function righthalf:Object(data:Object)
voronoirecursive(width/2,0,width,height,1)
End Function
While Not KeyDown(KEY_ESCAPE)
Local p:voronoipoint = New voronoipoint
Cls
voronoirecursive(0,0,WIDTH,HEIGHT,1)
'Local thread1:TThread=CreateThread(lefthalf,"")
'Local thread2:TThread=CreateThread(righthalf,"")
Flip
'Local tv:voronoipoint = New voronoipoint
'For tv = EachIn vpointlist
'tv.randomize()
'Next
Local tv:voronoipoint = New voronoipoint
For tv = EachIn vpointlist
SetColor 255,255,255
'drawhollowrect(tv.ux, tv.uy, tv.lx, tv.ly)
Next
Local ticks = 0
Repeat
For tv = EachIn vpointlist
SetColor 255,255,255
If mode = 1 Or mode = 3 drawhollowrect(tv.ux, tv.uy, tv.lx, tv.ly)
If mode = 5 Or mode = 3 DrawRect tv.x-2,tv.y-2, 5,5
Next
Flip
ticks = ticks + 1
Until MouseDown(1) Or ticks > 200
For tv = EachIn vpointlist
tv.randomize()
Next
mode = mode + 1
If mode > 5 mode = 0
Wend
'get 4 points
' if all the same, color according to closest and bail.
' else subdivide
Function drawhollowrect(ux, uy, lx, ly)
DrawLine ux, uy, lx, uy
DrawLine lx, uy, lx, ly
DrawLine lx, ly, ux, ly
DrawLine ux, ly, ux, uy
End Function
Function Distance(Point1X,Point1Y,Point2X,Point2Y)
'calculate the x/y distances
dX = Point1X - Point2X
dY = Point1Y - Point2Y
'calculate exact distance
'Sqr() always returns an absolute value
Return Sqr( (dx^2) + (dy^2) )
End Function
