Demo 2D - Repulsion

[pf shadoko]

a small demo without pretention
Remove the debugger
(you can use the mouse)

Code: Select all

; mini demo 2D - répulsion - Pf Shadoko - 2023

ExamineDesktops()
Define i,j,n,rnd,a.f,l=256,ex=DesktopWidth(0),ey=DesktopHeight(0),ry.f=ey/1080,ex2=ex/2,ey2=ey/2,ex3=ex*1.5,ey3=ey*1.5

InitSprite():InitKeyboard():InitMouse()
OpenWindow(0, 0, 0, ex,ey, "", #PB_Window_BorderLess):OpenWindowedScreen(WindowID(0), 0, 0, ex,ey, 0, 0, 0)

For i=1 To 6
  CreateSprite(i,l,l,#PB_Sprite_AlphaBlending)
  StartDrawing(SpriteOutput(i))
  DrawingMode(#PB_2DDrawing_Gradient| #PB_2DDrawing_AllChannels)      
  GradientColor(0,$ffffFFFF)
  GradientColor(1,RGBA(Random(128),Random(128),Random(128),255))
  CircularGradient(l*0.3, l*0.3, l*0.5)     
  Circle(l*0.5, l*0.5, l*0.5)     
  StopDrawing()
Next

Structure spoint
  x.f
  y.f
  r.f
  m.f
  sprite.l
EndStructure

n=200
Dim p.spoint(n)
RandomSeed(4)
For i=0 To n
  With p(i)
    rndf.f=Random(999)/1000
    rnd=Int(rndf*rndf*5)+1
    If i=0:rnd=6:EndIf
    \x=Random(ex)
    \y=Random(ey)
    \r=rnd*15*ry
    \m=rnd*rnd*6000*ry*ry
    \sprite=rnd
  EndWith  
Next

Define.f f,fx,fy,   x,y,m,dx,dy,l2

MouseLocate(ex2,ey2)
Repeat
  While WindowEvent():Wend
  ExamineKeyboard():ExamineMouse()
  
  ClearScreen(RGB(0,0,0))
  
  For j=0 To n:x=p(j)\x:y=p(j)\y:m=p(j)\m:fx=0:fy=0
    For i=0 To n:If i=j:Continue:EndIf
      With p(i)
        dx=\x-x:dx=Mod(dx+ex3,ex)-ex2
        dy=\y-y:dy=Mod(dy+ey3,ey)-ey2
        l2=Sqr(dx*dx+dy*dy):If l2<10:l2=10:EndIf:f=\m/(l2*l2*l2):fx+dx*f:fy+dy*f
      EndWith
    Next
    p(j)\x=Mod(p(j)\x-fx+ex,ex)
    p(j)\y=Mod(p(j)\y-fy+ey,ey)
  Next
  
  If MouseDeltaX():mouseon=1:EndIf
  If mouseon:p(0)\x=MouseX():p(0)\y=MouseY():Else:a+0.01:p(0)\x=Cos(a)*ex/3+ex/2:p(0)\y=Sin(a)*ey/3+ey/2:EndIf
  
  For i=0 To n
    With p(i)
      ZoomSprite(\sprite,\r*2,\r*2):DisplayTransparentSprite(\sprite,\x-\r,\y-\r,255)
    EndWith
  Next
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape) Or MouseButton(3)

[ebs]

That is amazing - and less than 100 lines of code too!

VERY NICE WORK!

[mk-soft]

Works perfect on macOS

Try sorting everything with the mouse. The big ones in the middle ... You could make a game out of it.

[idle]

nice

[Caronte3D]

I like it

[BarryG]

I played longer than I should have. Hehe.

[AZJIO]

I tried it on SpiderBasic

Code: Select all

; mini demo 2D - répulsion - Pf Shadoko - 2023

ExamineDesktops()
Global i,j,n,rnd,a.f,l=256,ex=DesktopWidth(0) - 100,ey=DesktopHeight(0) - 100,ry.f=ey/1080,ex2=ex/2,ey2=ey/2,ex3=ex*1.5,ey3=ey*1.5

InitSprite():InitKeyboard():InitMouse()
OpenWindow(0, 0, 0, ex,ey, "", #PB_Window_BorderLess):OpenWindowedScreen(WindowID(0), 0, 0, ex,ey, 0, 0, 0)

For i=1 To 6
	CreateSprite(i,l,l,#PB_Sprite_AlphaBlending)
	StartDrawing(SpriteOutput(i))
	DrawingMode(#PB_2DDrawing_Gradient| #PB_2DDrawing_AllChannels)      
	;   GradientColor(0,$ffffFFFF)
	;   GradientColor(1,RGBA(Random(128),Random(128),Random(128),255))
	;   CircularGradient(l*0.3, l*0.3, l*0.5)     
	Circle(l*0.5, l*0.5, l*0.5, RGB(Random(255), Random(255), Random(255))) 
	StopDrawing()
Next

Structure spoint
	x.f
	y.f
	r.f
	m.f
	sprite.l
EndStructure

n=200
Global Dim p.spoint(n)
RandomSeed(4)
For i=0 To n
	With p(i)
		rndf.f=Random(999)/1000
		rnd=Int(rndf*rndf*5)+1
		If i=0:rnd=6:EndIf
		\x=Random(ex)
		\y=Random(ey)
		\r=rnd*15*ry
		\m=rnd*rnd*6000*ry*ry
		\sprite=rnd
	EndWith  
Next

Global.f f,fx,fy,   x,y,m,dx,dy,l2

MouseLocate(ex2,ey2)
FlipBuffers()

Procedure RenderFrame()
	; Repeat
	ExamineKeyboard():ExamineMouse()
	
	ClearScreen(RGB(0,0,0))
	
	For j=0 To n:x=p(j)\x:y=p(j)\y:m=p(j)\m:fx=0:fy=0
		For i=0 To n:If i=j:Continue:EndIf
			With p(i)
				dx=\x-x:dx=Mod(dx+ex3,ex)-ex2
				dy=\y-y:dy=Mod(dy+ey3,ey)-ey2
				l2=Sqr(dx*dx+dy*dy):If l2<10:l2=10:EndIf:f=\m/(l2*l2*l2):fx+dx*f:fy+dy*f
			EndWith
		Next
		p(j)\x=Mod(p(j)\x-fx+ex,ex)
		p(j)\y=Mod(p(j)\y-fy+ey,ey)
	Next
	
	If MouseDeltaX():mouseon=1:EndIf
	If mouseon:p(0)\x=MouseX():p(0)\y=MouseY():Else:a+0.01:p(0)\x=Cos(a)*ex/3+ex/2:p(0)\y=Sin(a)*ey/3+ey/2:EndIf
	
	For i=0 To n
		With p(i)
			ZoomSprite(\sprite,\r*2,\r*2):DisplayTransparentSprite(\sprite,\x-\r,\y-\r,255)
		EndWith
	Next
	FlipBuffers()
	; Until KeyboardPushed(#PB_Key_Escape) Or MouseButton(3)
	If MouseButton(#PB_MouseButton_Right):End:EndIf
EndProcedure

BindEvent(#PB_Event_RenderFrame, @RenderFrame())

[firace]

Nice demo!

Just one thing, I have a transparency issue any time circles are overlapping.

I was able to get rid of the issue by removing the #PB_Sprite_AlphaBlending flag.

[pf shadoko]

@firace :

which OS do you use ?

(I have this problem under directx (probably a new bug), but by default the code runs under opengl ...)

[firace]

@firace :

which OS do you use ?

(I have this problem under directx (probably a new bug), but by default the code runs under opengl ...)

windows 10 x64

but i'm still running an older version of PB (v5.62)

edit: you're right, it seems related to directx:
the bug doesn't occur if I manually specify opengl in Library subsystem

[Kwai chang caine]

Very splendid effect like 3D
I don't know if it's normal, but here the black corners of each ball is visible
But thanks for sharing this jewell