UnderwareDESIGN

PlayBASIC => Resources => Source Codes => Topic started by: kevin on November 21, 2023, 07:55:04 PM

Title: Voronoi Diagram
Post by: kevin on November 21, 2023, 07:55:04 PM
Voronoi Diagram by ScottyBro


[pbcode]

; PROJECT : Voronoi Diagram
; AUTHOR  : Scott_Bro_1
; CREATED : 2/25/2022
; EDITED  : 2/25/2022
; ---------------------------------------------------------------------

X_Screen_Res = 1024
Y_Screen_Res =  768

Color_Mode = 32
Windowed_Mode = 1

OpenScreen X_Screen_Res,Y_Screen_Res,Color_Mode,Windowed_Mode

X_Number_Of_Cells = 256
Y_Number_Of_Cells = 256

Dim Voronoi_Diagram(X_Number_Of_Cells,Y_Number_Of_Cells)

Number_Of_Cycles = 4

Dim Cycle_Color(Number_Of_Cycles)

Dim X_Pos(Number_Of_Cycles)
Dim Y_Pos(Number_Of_Cycles)

For Cycles = 0 To Number_Of_Cycles - 1
      
   X_Pos(Cycles) = Rnd(X_Number_Of_Cells)
   Y_Pos(Cycles) = Rnd(Y_Number_Of_Cells)
      
   Voronoi_Diagram(X_Pos(Cycles),Y_Pos(Cycles)) = Cycles + 1
   
   Cycle_Color(Cycles + 1) = RndRGB() //RGBFade(RGB(255,255,255),Float(Cycles) / Number_Of_Cycles * 75 + 25)
   
Next Cycles

Dim Cycle_Space_Count(Number_Of_Cycles)

Dim Manhattan_Distance(Number_Of_Cycles,Number_Of_Cycles)

While Counter_1 < X_Number_Of_Cells * Y_Number_Of_Cells
   
   LockBuffer
   
   Seed = Point(0,0)
   
   Counter_1 = 0
      
   For Y_Cells = 0 To Y_Number_Of_Cells - 1
      For X_Cells = 0 To X_Number_Of_Cells - 1
         
         If Voronoi_Diagram(X_Cells,Y_Cells) > 0
            
            Cycle_ID = Voronoi_Diagram(X_Cells,Y_Cells)
            
            If Voronoi_Diagram(X_Cells,ClipRange(Y_Cells - 1,0,Y_Number_Of_Cells)) = 0 Then Voronoi_Diagram(X_Cells,ClipRange(Y_Cells - 1,0,Y_Number_Of_Cells)) = -(Cycle_ID)
               
            If Voronoi_Diagram(X_Cells,ClipRange(Y_Cells + 1,0,Y_Number_Of_Cells)) = 0 Then Voronoi_Diagram(X_Cells,ClipRange(Y_Cells + 1,0,Y_Number_Of_Cells)) = -(Cycle_ID)
               
            If Voronoi_Diagram(ClipRange(X_Cells - 1,0,X_Number_Of_Cells),Y_Cells) = 0 Then Voronoi_Diagram(ClipRange(X_Cells - 1,0,X_Number_Of_Cells),Y_Cells) = -(Cycle_ID)
               
            If Voronoi_Diagram(ClipRange(X_Cells + 1,0,X_Number_Of_Cells),Y_Cells) = 0 Then Voronoi_Diagram(ClipRange(X_Cells + 1,0,X_Number_Of_Cells),Y_Cells) = -(Cycle_ID)
                        
         EndIf
         
         If Voronoi_Diagram(X_Cells,Y_Cells) > 0
         
            Counter_1 += 1
         
         EndIf
         
         If Counter_1 = X_Number_Of_Cells * Y_Number_Of_Cells
            
            Goto Label_1
            
         EndIf       
            
      Next X_Cells   
   Next Y_Cells
      
   For Y_Cells = 0 To Y_Number_Of_Cells - 1
      For X_Cells = 0 To X_Number_Of_Cells - 1
            
         If Voronoi_Diagram(X_Cells,Y_Cells) < 0
            
            Cycle_ID = Voronoi_Diagram(X_Cells,Y_Cells)
               
            Voronoi_Diagram(X_Cells,Y_Cells) = Abs(Cycle_ID)
               
         EndIf   
         
         If Voronoi_Diagram(X_Cells,Y_Cells) > 0
         
            FastDot X_Cells,Y_Cells,Cycle_Color(Voronoi_Diagram(X_Cells,Y_Cells))
         
         EndIf   
            
      Next X_Cells
   Next Y_Cells

Label_1:
   
   UnLockBuffer
   
   Sync
   
EndWhile

Ink RGB(255,255,255)

For Cycles = 0 To Number_Of_Cycles - 1

   Dot X_Pos(Cycles),Y_Pos(Cycles)

Next Cycles

Gosub Calculate_Mobility

Gosub Calculate_Distance

Sync

Waitkey

End

Calculate_Distance:

For J = 0 To Number_Of_Cycles - 1
   For I = 0 To Number_Of_Cycles - 1
         
      Manhattan_Distance(J,I) = Abs((X_Pos(J) - X_Pos(I))) + Abs((Y_Pos(J) - Y_Pos(I)))
      
      Ink Cycle_Color(J + 1)
      
      Text J * 64,I * 16 + Y_Screen_Res / 2,Manhattan_Distance(J,I)
      
   Next I
Next J

Return

Calculate_Mobility:

For Cycles = 0 To Number_Of_Cycles - 1
   
   Counter_2 = 0
   
   For Y_Cells = 0 To Y_Number_Of_Cells - 1
      For X_Cells = 0 To X_Number_Of_Cells - 1
         
         If Voronoi_Diagram(X_Cells,Y_Cells) = Cycles + 1
            
            Counter_2 += 1      
         
         EndIf
      
      Next X_Cells
   Next Y_Cells               
   
   Cycle_Space_Count(Cycles) = Counter_2
   
   Ink Cycle_Color(Cycles + 1)
   
   Text X_Screen_Res / 4,Cycles * 16,"Cycle " + Str$(Cycles + 1) + ": " + Str$(Cycle_Space_Count(Cycles))
   
Next Cycles

Return
[/pbcode]