37

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