Code: Alles auswählen
EnableExplicit
Structure VPoint
X.d
Y.d
EndStructure
Structure VPointWeight Extends VPoint
Weight.d
EndStructure
;- Misc Helper
;{
Procedure.i Min(A.i, B.i)
If A <= B
ProcedureReturn A
EndIf
ProcedureReturn B
EndProcedure
Procedure.i Max(A.i, B.i)
If A >= B
ProcedureReturn A
EndIf
ProcedureReturn B
EndProcedure
Procedure.i Gray(Color.i)
ProcedureReturn Min(Max(Int(0.299 * Red(Color) + 0.587 * Green(Color) + 0.114 * Blue(Color)), 0), 255)
EndProcedure
;}
;- Distance Functions
;{
Prototype.d DistanceFunction(*P1.VPoint, *P2.VPoint)
DisableDebugger
Procedure.d DistanceEuclidSquared(*P1.VPoint, *P2.VPoint)
Protected X.d = *P1\X - *P2\X
Protected Y.d = *P1\Y - *P2\Y
ProcedureReturn (X * X + Y * Y)
EndProcedure
EnableDebugger
;}
;- Voronoi Functions
;{
DisableDebugger
Procedure.i ClosestPoint(Array VPoint.VPoint(1), *Point.VPoint, Distance.DistanceFunction)
Protected K.i
Protected Dist.d
Protected MinDist.d = Infinity()
Protected MinIndex.i = -1
For K = ArraySize(VPoint()) To 0 Step -1
Dist = Distance(@VPoint(K), *Point)
If Dist < MinDist
MinIndex = K
MinDist = Dist
EndIf
Next K
ProcedureReturn MinIndex
EndProcedure
Procedure DrawVoronoi(Array VPoint.VPoint(1), Distance.DistanceFunction)
Protected X.i
Protected Y.i
Protected Point.VPoint
Protected PointIndex.i
For X = OutputWidth() - 1 To 0 Step -1
For Y = OutputHeight() - 1 To 0 Step -1
Point\X = X
Point\Y = Y
PointIndex = ClosestPoint(VPoint(), @Point, Distance)
If PointIndex >= 0
Plot(X, Y, PointIndex)
EndIf
Next Y
Next X
EndProcedure
Procedure RelaxVoronoi(Array VPoint.VPoint(1), Array Weights.d(2), Width.i, Height.i, ResX.i, ResY.i, Distance.DistanceFunction)
Protected Dim NewVPoint.VPointWeight(ArraySize(VPoint()))
Protected X.i, Y.i
Protected Point.VPoint
Protected PointIndex.i
Protected Weight.d
Protected K.i
X = 0
While X < Width
Y = 0
While Y < Height
Point\X = X
Point\Y = Y
PointIndex = ClosestPoint(VPoint(), @Point, Distance)
If PointIndex >= 0
Weight = Weights(X, Y)
NewVPoint(PointIndex)\X + X * Weight
NewVPoint(PointIndex)\Y + Y * Weight
NewVPoint(PointIndex)\Weight + Weight
EndIf
Y + ResY
Wend
X + ResX
Wend
For K = ArraySize(VPoint()) To 0 Step -1
If NewVPoint(K)\Weight > 0.0
NewVPoint(K)\Weight = 1.0 / NewVPoint(K)\Weight
NewVPoint(K)\X * NewVPoint(K)\Weight
NewVPoint(K)\Y * NewVPoint(K)\Weight
VPoint(K)\X = NewVPoint(K)\X
VPoint(K)\Y = NewVPoint(K)\Y
EndIf
Next K
EndProcedure
EnableDebugger
;}
Procedure ShowImage(Image.i)
Protected Window.i
Window = OpenWindow(#PB_Any, #PB_Default, #PB_Default, ImageWidth(Image), ImageHeight(Image), "Result")
ImageGadget(#PB_Any, 0, 0, ImageWidth(Image), ImageHeight(Image), ImageID(Image))
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
CloseWindow(Window)
EndProcedure
Procedure LoadWeightImage(Filename.s, Array Weights.d(2))
Protected Image.i
Protected X.i, Y.i
Image = LoadImage(#PB_Any, Filename)
If Image <> 0
If StartDrawing(ImageOutput(Image))
For X = Min(OutputWidth() - 1, ArraySize(Weights(), 1)) To 0 Step -1
For Y = Min(OutputHeight() - 1, ArraySize(Weights(), 2)) To 0 Step -1
Weights(X, Y) = Gray(Point(X, Y)) / 255.0
Next Y
Next X
StopDrawing()
EndIf
FreeImage(Image)
EndIf
EndProcedure
Define K.i, X.i, Y.i
#WIDTH = 960 ; image height
#HEIGHT = 480 ; image width
#COUNT = 200 ; amount of voronoi cells
#ITERATIONS = 10 ; relax iterations
; load weight image
Dim Weights.d(#WIDTH - 1, #HEIGHT - 1)
For X = ArraySize(Weights(), 1) To 0 Step -1
For Y = ArraySize(Weights(), 2) To 0 Step -1
Weights(X, Y) = 1.0
Next Y
Next X
; load a weight image (should have the same dimensions)
; LoadWeightImage("weights.png", Weights())
; initialize random points
Dim VPoint.VPoint(#COUNT - 1)
For K = 0 To ArraySize(VPoint())
Repeat
VPoint(K)\X = Random(#WIDTH - 1)
VPoint(K)\Y = Random(#HEIGHT - 1)
Until Weights(Int(VPoint(K)\X), Int(VPoint(K)\Y)) > Random(100) * 0.01
Next K
; relax
For K = 0 To #ITERATIONS
RelaxVoronoi(VPoint(), Weights(), #WIDTH, #HEIGHT, 4, 4, @DistanceEuclidSquared())
Next K
; draw
CreateImage(0, #WIDTH, #HEIGHT)
If StartDrawing(ImageOutput(0))
DrawVoronoi(VPoint(), @DistanceEuclidSquared())
StopDrawing()
EndIf
ShowImage(0)
Bewegen heißt dann aber nicht, dass sich die Verbindungslinien ändern. Dass heißt, du brauchst nur einmal die Berechnung am Anfang machen und brauchst danach nur die Knoten verschieben, was allein betrachtet kein Zeitverlust darstellt. Klar ist dann nur, dass die Dreicke u.U. unglücklich verzerrt werden.Damit sollte ein Hintergrund realisiert werden, der sich - im Idealfall - permanent bewegt.
Evtl. benötigst du aber auch keine Relaxierung. Momentan werden ja #ITERATIONS Iterationen zur gleichmäßigen Anordnung verwendet. Evtl. schau ich demnächst mal ob ich das mit PB hardwarebeschleunigt hinbekomme.Agent hat geschrieben:Ich habe mir beides angesehen. Stargate's trifft natürlich die ursprüngliche Anforderung am ehesten. Das von Dragon sagt mir am Ende jedoch mehr zu. Die Berechnung scheint allerdings lange zu dauern. Damit sollte ein Hintergrund realisiert werden, der sich - im Idealfall - permanent bewegt.
