I've translated a lovely little program to PureBasic.
Solved: (see second post): However, I get flickering when either the particle count is too high or low. I've set the #PB_Screen_WaitSynchronization flag in the OpenWindowedScreen. Do others get this problem? If so do they have an explanation?!
Code: Select all
; Unstable Connections
; BB4W version by Michael Hutton 23/09/2009
; PureBasic version by Michael Hutton 18/04/2017
; Based on 'Unstable Connections' by Andre Michelle
; http://lab.andre-michelle.com/instable-connections
Enumeration
#window
EndEnumeration
InitSprite()
InitKeyboard()
#width = 640
#height = 512
OpenWindow(#window, #PB_Ignore, #PB_Ignore, #width, #height, "Unstable Connections", #PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0), 0, 0, WindowWidth(#window), WindowHeight(#window), #True, 0, 0, #PB_Screen_NoSynchronization)
Define.d sx, sy, dx, dy, dd, mx, my, strength
damp.d = 0.99 ; try also 0.9 and 0.999....
nParticles.i = 60
maxParticles.i = 9999
Structure particle
x.d
y.d
vx.d
vy.d
sx.d
sy.d
EndStructure
Dim AllParticles.particle(maxParticles)
;Create particles
For i.i = 0 To nParticles
With AllParticles(i)
\x = Random(#width, 1)
\y = Random(#height, 1)
\sx = \x
\sy = \y
EndWith
Next
frame.i = 0
framestart.i = frame
AddWindowTimer(0, 0, 1000)
Repeat
Repeat
Event = WindowEvent()
If Event = #PB_Event_Timer
framerate = frame - framestart
framestart = frame
SetWindowTitle(#window,
"Framerate: " + Str(framerate) + " fps. Particle Count: " + Str(nParticles) + " Press Up/Down arrow to add/remove particle. Move mouse to push particles.")
EndIf
Until Event = 0
mx = WindowMouseX(#window)
my = WindowMouseY(#window)
If mx < 0
mx = 0
EndIf
If my < 0
my = 0
EndIf
;Update Velocities
For i = 0 To nParticles
With AllParticles(i)
sx = \sx + \vx
sy = \sy + \vy
dx = mx - sx
dy = my - sy
dd = dx * dx + dy * dy
If dd < 48 * 48
\vx - dx/96
\vy - dy/96
EndIf
If sx < 0
sx = 0
\vx * -1.0
Else
If sx > #width - 1
sx = #width - 1
\vx * -1.0
EndIf
EndIf
If sy < 0
sy = 0
\vy * -1.0
Else
If sy > #height - 1
sy = #height -1
\vy * -1.0
EndIf
EndIf
\sx = sx
\sy = sy
EndWith
Next
ClearScreen(0)
StartDrawing(ScreenOutput())
; Calculate forces
For i = 0 To nParticles - 1
For j.i = i + 1 To nParticles
dx = AllParticles(i)\sx - AllParticles(j)\sx
dy = AllParticles(i)\sy - AllParticles(j)\sy
dd = dx*dx + dy * dy
If dd > 26 * 26
;nothing
Else
If dd > 18 * 18
;attraction
AllParticles(i)\vx - dx/200
AllParticles(i)\vy - dy/200
AllParticles(j)\vx + dx/200
AllParticles(j)\vy + dy/200
AllParticles(i)\vx * damp
AllParticles(i)\vy * damp
AllParticles(j)\vx * damp
AllParticles(j)\vy * damp
strength = 1 - (Sqr(dd)-18)/8
LineXY(AllParticles(i)\sx, AllParticles(i)\sy, AllParticles(j)\sx, AllParticles(j)\sy, RGB(0,0, 255 * strength))
Else
If dd > 0
;repulsion
dd = Sqr(dd)
dd = 0.5 * (dd - 18)/dd
dx * dd
dy * dd
AllParticles(i)\vx - dx
AllParticles(i)\vy - dy
AllParticles(j)\vx + dx
AllParticles(j)\vy + dy
AllParticles(i)\x + Allparticles(i)\vx
AllParticles(i)\y + Allparticles(i)\vy
LineXY(AllParticles(i)\sx, AllParticles(i)\sy, AllParticles(j)\sx, AllParticles(j)\sy, RGB(255 * strength, 0, 0))
EndIf
EndIf
EndIf
Next
Plot(AllParticles(i)\sx, AllParticles(i)\sy, RGB(0,255,0))
Next
StopDrawing()
FlipBuffers()
ExamineKeyboard()
;Add a particle
If KeyboardPushed(#PB_Key_Up)
nParticles + 1
If nParticles > maxParticles
nParticles = maxParticles
EndIf
Allparticles(nParticles)\x = Random(#width, 1)
Allparticles(nParticles)\y = Random(#height, 1)
Allparticles(nParticles)\sx = Allparticles(nParticles)\x
Allparticles(nParticles)\sy = Allparticles(nParticles)\y
EndIf
;delete a particle
If KeyboardPushed(#PB_Key_Down)
If nParticles > 1
nParticles - 1
EndIf
EndIf
frame + 1
Until KeyboardPushed(#PB_Key_Escape)
