PureBoard

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)