metacircles

Share your advanced PureBasic knowledge/code with the community.
User avatar
idle
Always Here
Always Here
Posts: 5915
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

metacircles

Post by idle »

metacircles, no reason for it but it's just a nice algorithm, left click to start!

Code: Select all

Structure metacircle
  x.f
  y.f
  vx.f
  vy.f
  r.f
 EndStructure   

Global Dim metacircles.metacircle(0)
Global gNumCircles 

Macro RRandom(min,max)
 Random((max-min),0) + min 
EndMacro   

Procedure Init(NumCirles,size)
  
gNumCircles = NumCirles  

ReDim metacircles.metacircle(NumCirles)  
  
For i = 0 To NumCirles-1
  metacircles(i)\x = RRandom(0, size)
  metacircles(i)\y = RRandom(0, size)
  metacircles(i)\r = RRandom(10, 60)
  metacircles(i)\vx = RRandom(-2, 2)
  metacircles(i)\vy = RRandom(-2, 2)
Next 

EndProcedure 

Procedure draw(size,width)
  Protected *c.metacircle,dx.f,dy.f,sum.f,dd.f  
  
  If gNumCircles
    For i = 0 To gNumCircles-1     ;move and keep in bounds   
        *c = @metacircles(i)
        *c\x + *c\vx
        *c\y + *c\vy 
     
        If *c\x - *c\r <= 0
           *c\vx = Abs(*c\vx)
        EndIf
        If *c\x + *c\r >= width
            *c\vx = -Abs(*c\vx)
        EndIf 
        If *c\y - *c\r <= 0
           *c\vy = Abs(*c\vy)
        EndIf
        If *c\y + *c\r >=  width
          *c\vy = -Abs(*c\vy);
       EndIf
               
    Next
        
    While x < Width            ;plot 
      y=0
      While y < Width
         sum = 0
         For i = 0 To gNumCircles -1 
           *c = metacircles(i)
            dx = x - *c\x
            dy = y - *c\y
            dd = dx * dx + dy * dy
            sum + (*c\r * *c\r / dd)
         Next     
         If sum > 1
           Plot(x,y,RGB(0,255,0))
         EndIf 
      y+size       
      Wend 
    x+size   
    Wend  
  EndIf   
EndProcedure 

If OpenWindow(0, 0, 0, 420, 420, "left click for new metacircles", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    CanvasGadget(0, 10, 10, 400, 400)
    AddWindowTimer(0,1,20)
    Repeat
      Event = WaitWindowEvent()
          
      If Event = #PB_Event_Gadget And EventGadget() = 0 
        If EventType() = #PB_EventType_LeftClick 
          init(Random(10,3),400)
        EndIf
      EndIf    
      If Event = #PB_Event_Timer And EventTimer() = 1
       If StartDrawing(CanvasOutput(0))
        Box(0,0,400,400,0)
        Draw(1,400)
        StopDrawing()
      EndIf
     EndIf  
    Until Event = #PB_Event_CloseWindow
 EndIf
Windows 11, Manjaro, Raspberry Pi OS
Image
dige
Addict
Addict
Posts: 1409
Joined: Wed Apr 30, 2003 8:15 am
Location: Germany
Contact:

Re: metacircles

Post by dige »

Nice liquid animation, like a lava lamp :-)
"Daddy, I'll run faster, then it is not so far..."
User avatar
RSBasic
Moderator
Moderator
Posts: 1228
Joined: Thu Dec 31, 2009 11:05 pm
Location: Gernsbach (Germany)
Contact:

Re: metacircles

Post by RSBasic »

Very nice
Image
Image
Fred
Administrator
Administrator
Posts: 18244
Joined: Fri May 17, 2002 4:39 pm
Location: France
Contact:

Re: metacircles

Post by Fred »

Nice
User avatar
idle
Always Here
Always Here
Posts: 5915
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: metacircles

Post by idle »

thanks for the comments, I just think it's a really nice algorithm and whoever created it in the first place
had one of those epiphany moments.
Windows 11, Manjaro, Raspberry Pi OS
Image
User avatar
Keya
Addict
Addict
Posts: 1890
Joined: Thu Jun 04, 2015 7:10 am

Re: metacircles

Post by Keya »

idle yes it's one of those "how did they get so much out of so little?" algorithms heehee. Its not obvious to me from the code what it's doing (even though its so small!), but it must've been a great moment for the original coder the first time they saw it working on their screen :)
Making it blended-multi-colored like a lava lamp sounds like quite a challenge though!!
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: metacircles

Post by Kwai chang caine »

Cool !!!! like my splendid magical light
When i have 12 years old and i watch it, somes hours and somes hours, without limit

Image

Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
User avatar
idle
Always Here
Always Here
Posts: 5915
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: metacircles

Post by idle »

Keya wrote:idle yes it's one of those "how did they get so much out of so little?" algorithms heehee. Its not obvious to me from the code what it's doing (even though its so small!), but it must've been a great moment for the original coder the first time they saw it working on their screen :)
Making it blended-multi-colored like a lava lamp sounds like quite a challenge though!!
maybe not so hard, but I'm not about to do it, change the integration adding gravity, add a repeller and use phong shading
for the color.
Windows 11, Manjaro, Raspberry Pi OS
Image
User avatar
idle
Always Here
Always Here
Posts: 5915
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: metacircles

Post by idle »

Kwai chang caine wrote:Cool !!!! like my splendid magical light
When i have 12 years old and i watch it, somes hours and somes hours, without limit

Image

Thanks for sharing 8)
Eric you really do have GIF for every moment, incroyable :D
Windows 11, Manjaro, Raspberry Pi OS
Image
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: metacircles

Post by Kwai chang caine »

:wink: 8)
Say that to FRED !!!! :lol:
ImageThe happiness is a road...
Not a destination
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: metacircles

Post by davido »

@idle,

Very nice, thank your sharing. :D
DE AA EB
User avatar
STARGÅTE
Addict
Addict
Posts: 2235
Joined: Thu Jan 10, 2008 1:30 pm
Location: Germany, Glienicke
Contact:

Re: metacircles

Post by STARGÅTE »

Nice code. Thx.

Is it possible to reduce the calculation time, if you approximate only the surface of the meta circles and not each pixel?
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Lizard - Script language for symbolic calculations and moreTypeface - Sprite-based font include/module
User avatar
idle
Always Here
Always Here
Posts: 5915
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: metacircles

Post by idle »

STARGÅTE wrote:Nice code. Thx.

Is it possible to reduce the calculation time, if you approximate only the surface of the meta circles and not each pixel?
no probably not, but you could do the sampling in larger steps, just change the size parameter in the draw function
then if you rendered with sprites and a blend it'd look more or less the same with a fussy outline
Windows 11, Manjaro, Raspberry Pi OS
Image
Little John
Addict
Addict
Posts: 4791
Joined: Thu Jun 07, 2007 3:25 pm
Location: Berlin, Germany

Re: metacircles

Post by Little John »

Very nice. Thank you, idle!

The code contains a bug, though. It shows up when running it with Debugger on.
Then it crashes on line 34: Array index out of bounds.
This can be fixed e.g. by adding

Code: Select all

ReDim metacircles(3)
before the Repeat in line 77.
User avatar
idle
Always Here
Always Here
Posts: 5915
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: metacircles

Post by idle »

thanks Little John ,I've updated it.
Windows 11, Manjaro, Raspberry Pi OS
Image
Post Reply