RosettaCodeData/Task/Voronoi-diagram/PureBasic/voronoi-diagram-1.purebasic
Ingy döt Net 68f8f3e56b all tasks
2013-04-11 01:07:29 -07:00

70 lines
1.8 KiB
Text

Structure VCoo
x.i: y.i
Colour.i: FillColour.i
EndStructure
Macro RandInt(MAXLIMIT)
Int(MAXLIMIT*(Random(#MAXLONG)/#MAXLONG))
EndMacro
Macro SQ2(X, Y)
((X)*(X) + (Y)*(Y))
EndMacro
Procedure GenRandomPoints(Array a.VCoo(1), xMax, yMax, cnt)
Protected i, j, k, l
cnt-1
Dim a(cnt)
For i=0 To cnt
a(i)\x = RandInt(xMax): a(i)\y = RandInt(yMax)
j = RandInt(255): k = RandInt(255): l = RandInt(255)
a(i)\Colour = RGBA(j, k, l, 255)
a(i)\FillColour = RGBA(255-j, 255-k, 255-l, 255)
Next i
ProcedureReturn #True
EndProcedure
Procedure MakeVoronoiDiagram(Array a.VCoo(1),xMax, yMax) ; Euclidean
Protected i, x, y, img, dist.d, dt.d
img = CreateImage(#PB_Any, xMax+1, yMax+1)
If StartDrawing(ImageOutput(img))
For y=0 To yMax
For x=0 To xMax
dist = Infinity()
For i=0 To ArraySize(a())
dt = SQ2(x-a(i)\x, y-a(i)\y)
If dt > dist
Continue
ElseIf dt < dist
dist = dt
Plot(x,y,a(i)\FillColour)
Else ; 'Owner ship' is unclear, set pixel to transparent.
Plot(x,y,RGBA(0, 0, 0, 0))
EndIf
Next
Next
Next
For i=0 To ArraySize(a())
Circle(a(i)\x, a(i)\y, 1, a(i)\Colour)
Next
StopDrawing()
EndIf
ProcedureReturn img
EndProcedure
; Main code
Define img, x, y, file$
Dim V.VCoo(0)
x = 640: y = 480
If Not GenRandomPoints(V(), x, y, 150): End: EndIf
img = MakeVoronoiDiagram(V(), x, y)
If img And OpenWindow(0, 0, 0, x, y, "Voronoi Diagram in PureBasic", #PB_Window_SystemMenu)
ImageGadget(0, 0, 0, x, y, ImageID(img))
Repeat: Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
UsePNGImageEncoder()
file$ = SaveFileRequester("Save Image?", "Voronoi_Diagram_in_PureBasic.png", "PNG|*.png", 0)
If file$ <> ""
SaveImage(img, file$, #PB_ImagePlugin_PNG)
EndIf