Voronoi colorfull tiles

Share your advanced PureBasic knowledge/code with the community.
Post Reply
applePi
Addict
Addict
Posts: 1404
Joined: Sun Jun 25, 2006 7:28 pm

Voronoi colorfull tiles

Post by applePi »

adapted from the first algorithm in this page http://forum.basicprogramming.org/index ... 127.0.html
to produce a voronoi color scheme
run it with debugger off to see instant result, but if you run it with debugger on you need to wait 15 seconds (seems from the far inner loop in line 22)
Image

with ImageGadget:

Code: Select all

DisableDebugger
Procedure.f RandF() ; simulate RND function from 0 to 1
  ProcedureReturn Random(10000) * 0.0001
EndProcedure


If OpenWindow(0, 0, 0, 640, 640, "2DDrawing Example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    If CreateImage(0, 640, 640) And StartDrawing(ImageOutput(0))
sq=639:s2.f=sq/2:points=240
Dim x.f(points):Dim y.f(points):Dim kl.f(points)
For i = 0 To points
  x(i)=RandF()*sq: y(i)=RandF()*sq
  ;g=127-127*(s2-x(i)/s2)+127-127*(s2-y(i)/s2)
  g.f=127-127*(Abs(s2-x(i))/s2)+127-127*(Abs(s2-y(i))/s2)
  kl(i)=RGB(255-x(i)/sq*255,g,y(i)/sq*255)
Next

a.f:b.f:q.f
;StartTime = ElapsedMilliseconds()             
For xx = 0 To sq
   For yy = 0 To sq
      d = 307201
      For i = 0 To points
         a=x(i)-xx: b=y(i)-yy
         q=a*a+b*b
         If q < d 
           d = q: kkl = i
         EndIf
         
      Next
      ;pset xx,yy,kl(kkl)
      Plot(xx, yy, kl(kkl))
   Next 
 Next 
 
 ;ElapsedTime = ElapsedMilliseconds()-StartTime 
 ;MessageRequester(" ", Str(ElapsedTime/1000) +"  seconds")
 
      StopDrawing() 
      ImageGadget(0, 0, 0, 640, 640, ImageID(0))
    EndIf
    
    Repeat
      Event = WaitWindowEvent()
    Until Event = #PB_Event_CloseWindow
  EndIf

with opengl glDrawArrays:

Code: Select all

DisableDebugger
Procedure.f RandF() ; simulate RND function from 0 to 1
  ProcedureReturn Random(10000) * 0.0001
EndProcedure

Structure Point3D
  x.f
  y.f
  z.f
EndStructure

Structure color3
  r.f
  g.f
  b.f
EndStructure

Define event, quit
Declare FillArrays()
Declare Display()

ExamineDesktops()
OpenWindow(0, 0, 0, DesktopWidth(0), DesktopHeight(0), "OpenGL..Voronoi, using glDrawArrayss... ")
SetWindowColor(0, RGB(200,220,200))
OpenGLGadget(0, 20, 10, WindowWidth(0) , WindowHeight(0), #PB_OpenGL_Keyboard )
SetActiveGadget(0)

Global Nb.l = 1000000
  
  ; -- Define Data For it
  
  Global Dim VertexA.Point3D(Nb)
  Global Dim ColorA.Color3(Nb)
 
  FillArrays()
  

glMatrixMode_(#GL_PROJECTION)
glLoadIdentity_()
gluPerspective_(60.0, WindowWidth(0)/WindowHeight(0), 1.0, 100.0)
glMatrixMode_(#GL_MODELVIEW)
glScalef_(0.5,0.5, 1)
glTranslatef_(-60, -60, -50)
glShadeModel_(#GL_SMOOTH) 
glEnable_(#GL_DEPTH_TEST)
gluLookAt_( 0, 1, 20,
           0,  1, -20,
            0, 1,  0 )  

  
  Repeat
    
  Display()
  
  event = WindowEvent()
   If Event = #PB_Event_Gadget And EventGadget() = 0 
      If EventType() = #PB_EventType_KeyDown
      
        key = GetGadgetAttribute(0,#PB_OpenGL_Key )
        Select key
            
          Case #PB_Shortcut_Escape
            quit = 1
        EndSelect
           
      EndIf
   EndIf   
     
  SetGadgetAttribute(0, #PB_OpenGL_FlipBuffers, #True)
  
  Delay(2)
Until quit = 1 Or Event = #PB_Event_CloseWindow

Procedure FillArrays()
  
sq=640:s2.f=sq/2:points=240 :g.f
;sq=240:s2.f=sq/2:points=40 :g.f
Dim x.f(points)
Dim y.f(points)
Dim kl.color3(points)

For i = 0 To points
  x(i)=RandF()*sq: y(i)=RandF()*sq
  ;g=127-127*(s2-x(i)/s2)+127-127*(s2-y(i)/s2)
  g=127-127*(Abs(s2-x(i))/s2)+127-127*(Abs(s2-y(i))/s2)
  kl(i)\r = 255-x(i)/sq*255
  kl(i)\g = g
  kl(i)\b = y(i)/sq*255
Next

a.f: b.f: q.f: radius.f: hei.f: zz.f
xx.l: yy.l: d.l : kkl.l


For xx = 0 To sq
   For yy = 0 To sq
      d = 307201
      For i = 0 To points
         a=x(i)-xx: b=y(i)-yy
         q=a*a+b*b
         If q < d 
           d = q
           kkl = i
         EndIf
         
      Next
      ;pset xx,yy,kl(kkl)
      ;indexX * arrayWidth + indexY
      ind = yy*sq + xx ;ind = (yy-1)*sq + xx
      VertexA(ind)\x = xx*0.2
      VertexA(ind)\y = yy*0.2
      VertexA(ind)\z = 0
      ColorA(ind)\r = kl(kkl)\r /255
      ColorA(ind)\g = kl(kkl)\g /255
      ColorA(ind)\b = kl(kkl)\b /255
      
      ;pset xx,yy,kl(kkl)
   Next
Next

  
EndProcedure

Procedure display()


glClear_(#GL_COLOR_BUFFER_BIT)
       
       
 glClear_(#GL_COLOR_BUFFER_BIT | #GL_DEPTH_BUFFER_BIT)
 glClearColor_(1, 1, 1, 1)
 ;glScalef_(0.6,0.6, 1)
 glEnableClientState_(#GL_VERTEX_ARRAY )
 glEnableClientState_(#GL_COLOR_ARRAY)
 glVertexPointer_(3, #GL_FLOAT,SizeOf(Point3D),@VertexA(0)\x)
 glColorPointer_(3, #GL_FLOAT, SizeOf(Color3), @ColorA(0)\r)
       
 glDrawArrays_(#GL_POINTS, 0, Nb )
       
 glDisableClientState_(#GL_COLOR_ARRAY)
 glDisableClientState_(#GL_VERTEX_ARRAY)  
 ;**************************************************
       
   
EndProcedure
feel free to add examples or to correct the above code
Last edited by applePi on Tue Dec 08, 2015 7:45 pm, edited 2 times in total.
Top
Num3
PureBasic Expert
PureBasic Expert
Posts: 2812
Joined: Fri Apr 25, 2003 4:51 pm
Location: Portugal, Lisbon
Contact:
Contact Num3

Re: Voronoi colorfull tiles

Post by Num3 »

NICE :)

P.S.
Maybe you can add this on the start of the code:

Code: Select all

DisableDebugger
:twisted:
Top
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Voronoi colorfull tiles

Post by davido »

@applePi,

Very nice demo. :D
The ImageGadget works just fine, however...
The OpenGL version seems to have a flickering mesh (net) in front of it. Using PureBasic 5.40LTS 64 bit - Window 7

Edit: 21:50
Same results, as above, on MacBook Pro, for both demos.
DE AA EB
Top
applePi
Addict
Addict
Posts: 1404
Joined: Sun Jun 25, 2006 7:28 pm

Re: Voronoi colorfull tiles

Post by applePi »

Thanks Num3 and Davido, i have added DisableDebugger to the all examples, regarding the opengl demo flicker , don't know the reason, i have adjusted the camera and the Graphics distances since when we are very close it shows the net, also depends on the screen monitor resolution. i have Nvidia Geforce card and the graphics does not flicker in 800x600 or 1024x768 pixels mode. i changed it a little above.

the same algorithm but using Ogre engine, directing the plotting to TextureOutput, and then applying the material to a plane , if you want one picture then change 2 to 1 in CreatePlane(3, 500, 500, 1, 1, 2, 2)
i forgot to say, if we change points=240 to something like points=40 (line 104) then the color tiles will be bigger , you may like it more.

Code: Select all

DisableDebugger

Procedure.f RandF() ; simulate RND function from 0 to 1
  ProcedureReturn Random(10000) * 0.0001
EndProcedure


#CameraSpeed = 2

Define event, quit
Declare VoronoiColor()

InitEngine3D()
   InitMouse()
   InitKeyboard()
   InitSprite()
   ExamineDesktops()
   
OpenWindow(0, 0, 0, DesktopWidth(0), DesktopHeight(0), "Voronoi color scheme, using PB Ogre graphics... .. space to stop/start rotation.... arrow keys/ mouse to move camera")

OpenWindowedScreen(WindowID(0), 0, 0, DesktopWidth(0), DesktopHeight(0), 0, 0, 0)
    Add3DArchive(".",#PB_3DArchive_FileSystem)
    Add3DArchive(#PB_Compiler_Home+"Examples\3D\Data\Textures\",#PB_3DArchive_FileSystem)
    Add3DArchive(#PB_Compiler_Home+"Examples\3D\Data\GUI",#PB_3DArchive_FileSystem)
    Parse3DScripts()
         
      ;-Camera
    CreateCamera(0, 0, 0, 100, 100)
    MoveCamera(0, 0, 0, 70, #PB_Absolute)
    CameraFOV(0, 80)
    CameraBackColor(0, RGB(220, 220, 220))
    
    ;-Light
    CreateLight(0, RGB(255,255,255), -10, 60, 10)
    AmbientColor(RGB(220, 220, 100))
        
    VoronoiColor() ; calculate the voronoi color 
    
        ;************************************************** 
    
    rot.f = 0.5
    Repeat
      Event = WindowEvent()
        
      If ExamineMouse()
        MouseX = -MouseDeltaX()/5 
        MouseY = -MouseDeltaY()/5
      EndIf
      
          
      If ExamineKeyboard()
         
        If KeyboardPushed(#PB_Key_Left)
          KeyX = -#cameraSpeed
        ElseIf KeyboardPushed(#PB_Key_Right)
          KeyX = #cameraSpeed
        Else
          KeyX = 0
        EndIf
        
        If KeyboardPushed(#PB_Key_Up)
          KeyY = -#cameraSpeed
        ElseIf KeyboardPushed(#PB_Key_Down)
          KeyY = #cameraSpeed
        Else
          KeyY = 0
        EndIf
        
        If KeyboardReleased(#PB_Key_Space)
          
          If stop
            stop ! 1
            rot.f = 0.5
          Else 
            rot.f= 0.0
            stop ! 1
          EndIf
       
         
        EndIf
        EndIf
       
        
        RotateEntity(3, 0.0,rot,0.0,#PB_Relative)
        RotateCamera(0, MouseY, MouseX, 0, #PB_Relative)
      MoveCamera(0, KeyX, 0, KeyY)
      
      RenderWorld()
      FlipBuffers()
      ;=========================================
    Until KeyboardPushed(#PB_Key_Escape) Or Quit = 1
 
    End
    
Procedure VoronoiColor() 
    

  ; -- Define Data For it

CreateTexture(1,640,640)
  StartDrawing(TextureOutput(1))
    
  
sq=639:s2.f=sq/2:points = 240
Dim x.f(points):Dim y.f(points):Dim kl.f(points)
For i = 0 To points
  x(i)=RandF()*sq: y(i)=RandF()*sq
  ;g=127-127*(s2-x(i)/s2)+127-127*(s2-y(i)/s2)
  g.f=127-127*(Abs(s2-x(i))/s2)+127-127*(Abs(s2-y(i))/s2)
  kl(i)=RGB(255-x(i)/sq*255,g,y(i)/sq*255)
Next

a.f:b.f:q.f

For xx = 0 To sq
   For yy = 0 To sq
      d = 307201
      For i = 0 To points
         a=x(i)-xx: b=y(i)-yy
         q=a*a+b*b
         If q < d 
           d = q: kkl = i
         EndIf
         
      Next
      ;pset xx,yy,kl(kkl)
      Plot(xx, yy, kl(kkl))
   Next 
 Next 
 
 
 StopDrawing()
  CreateMaterial(1, TextureID(1))
  StopDrawing()
  
  MaterialCullingMode(1, #PB_Material_NoCulling) 
;***************************************************

    
    CreatePlane(3, 500, 500, 1, 1, 2, 2)
    CreateEntity(3,MeshID(3),MaterialID(1), 0, 0, -300)
    RotateEntity(3, 90,0,0)
        
    
        
EndProcedure
the last example is the same previous OpenGL glDrawArrays example but now we use a more natural 2D array instead of the previous demo 1D array:

Code: Select all

DisableDebugger

Procedure.f RandF() ; simulate RND function from 0 to 1
  ProcedureReturn Random(10000) * 0.0001
EndProcedure

Structure Point3D
  x.f
  y.f
  z.f
EndStructure

Structure color3
  r.f
  g.f
  b.f
EndStructure

Define event, quit
Declare FillArrays()
Declare Display()

ExamineDesktops()
OpenWindow(0, 0, 0, DesktopWidth(0), DesktopHeight(0), "OpenGL..Voronoi, using glDrawArrayss... ")
SetWindowColor(0, RGB(200,220,200))
OpenGLGadget(0, 20, 10, WindowWidth(0) , WindowHeight(0), #PB_OpenGL_Keyboard )
SetActiveGadget(0)

Global HorzPoints =640, VertPoints = HorzPoints ;  0 to 639
Global Nb.l = HorzPoints * VertPoints ; total number of points
  ; -- Define Data For it
  
  Global Dim VertexA.Point3D(HorzPoints, Vertpoints)
  Global Dim ColorA.Color3(HorzPoints, VertPoints)
 
  FillArrays()
  

glMatrixMode_(#GL_PROJECTION)
glLoadIdentity_()
gluPerspective_(60.0, WindowWidth(0)/WindowHeight(0), 1.0, 100.0)
glMatrixMode_(#GL_MODELVIEW)
glScalef_(0.5,0.5, 1) ; scale the graphics
glTranslatef_(-30, -30, -20) ; move the shape left/right, up/down, in/out
glShadeModel_(#GL_SMOOTH) 
glEnable_(#GL_DEPTH_TEST)
gluLookAt_( 0, 1, 20,
           0,  1, -20,
            0, 1,  0 )  

  
  Repeat
    
  Display()
  
  event = WindowEvent()
   If Event = #PB_Event_Gadget And EventGadget() = 0 
      If EventType() = #PB_EventType_KeyDown
      
        key = GetGadgetAttribute(0,#PB_OpenGL_Key )
        Select key
            
          Case #PB_Shortcut_Escape
            quit = 1
        EndSelect
           
      EndIf
   EndIf   
     
  SetGadgetAttribute(0, #PB_OpenGL_FlipBuffers, #True)
  
  ;Delay(2)
Until quit = 1 Or Event = #PB_Event_CloseWindow

Procedure FillArrays()
  
sq=HorzPoints:s2.f=sq/2:points=240 :g.f
;sq=240:s2.f=sq/2:points=40 :g.f
Dim x.f(points)
Dim y.f(points)
Dim kl.color3(points)

For i = 0 To points
  x(i)=RandF()*sq: y(i)=RandF()*sq
  ;g=127-127*(s2-x(i)/s2)+127-127*(s2-y(i)/s2)
  g=127-127*(Abs(s2-x(i))/s2)+127-127*(Abs(s2-y(i))/s2)
  kl(i)\r = 255-x(i)/sq*255
  kl(i)\g = g
  kl(i)\b = y(i)/sq*255
Next

a.f: b.f: q.f: radius.f: hei.f: zz.f
xx.l: yy.l: d.l : kkl.l


For xx = 0 To sq
   For yy = 0 To sq
      d = 307201
      For i = 0 To points
         a=x(i)-xx: b=y(i)-yy
         q=a*a+b*b
         If q < d 
           d = q
           kkl = i
         EndIf
         
      Next
      ;pset xx,yy,kl(kkl)
      VertexA(xx,yy)\x  = xx*0.1
      VertexA(xx,yy)\y = yy*0.1
      VertexA(xx,yy)\z = 0
      ColorA(xx,yy)\r = kl(kkl)\r /255
      ColorA(xx,yy)\g = kl(kkl)\g /255
      ColorA(xx,yy)\b = kl(kkl)\b /255
      
   Next
Next

  
EndProcedure

Procedure display()


glClear_(#GL_COLOR_BUFFER_BIT)
       
       
 glClear_(#GL_COLOR_BUFFER_BIT | #GL_DEPTH_BUFFER_BIT)
 glClearColor_(1, 1, 1, 1)
 
 glEnableClientState_(#GL_VERTEX_ARRAY )
 glEnableClientState_(#GL_COLOR_ARRAY)
 glVertexPointer_(3, #GL_FLOAT,SizeOf(Point3D),@VertexA(0,0)\x)
 glColorPointer_(3, #GL_FLOAT, SizeOf(Color3), @ColorA(0,0)\r)
       
 glDrawArrays_(#GL_POINTS, 0, Nb)
       
 glDisableClientState_(#GL_COLOR_ARRAY)
 glDisableClientState_(#GL_VERTEX_ARRAY)  
 ;**************************************************
       
   
EndProcedure
Top
Post Reply

Return to “Tricks 'n' Tips”