Active Forums > QB64 Discussion
Particle System
johnno56:
I have been searching for a document(s), video, tutorials etc., on how to create a particle system. The problem is, I found heaps... My biggest problem is that the lack of information when it comes to Basic. I know that particle systems have been used in games etc. on this site. Which in itself is great. But, I seem to learn more from a tutorial as opposed to 'Monkey see. Monkey do.' Copy and paste is fine, if only a result is needed, but that does not teach me how and why the code works... I am not sure I am making much sense. If I knew how to use all the other language examples that I have looked at, I probably would not be asking... Basic is what I know best... Basic examples/tutorials are what I am looking for... I would appreciate any assistance that you are willing to offer. Thank you.
bplus:
@johnno56
This surprises me! You've done particle systems way back at SdlBasic, just fine!
You probably would like to do them with an array for each... I don't know what to call them Property? is the VB term, characteristic? oh what are they called?!
You could setup an UDT for them like this:
Type Particle
As Single x, y, dx, dy, life, active
As _unsigned Long colr
end Type
nParticles = 100
Dim Shared parts(nParticles) as Particle
or do it the old fashioned way
dim x(nParticles), y(nParticles), dx(nParticles), dy(nParticles), life(nParticles), active(nParticles)
dim as _unsigned long colr(nParticles)
Then it's good to have a Sub for creating a new particle depends on your app what to do
Sub NewParticle(index) 'where index is for the shared array Parts
' setup Parts(index) for you app here
end sub
I could probably dig up some of your code from SdlBasic for doing particles :)
bplus:
Found it:
http://sdlbasic.epizy.com/showthread.php?tid=235
From 6 years ago!
You call the properties parameters here, OK :)
Oh come to think of it, I think you mentioned losing your computer and a bunch of old work. Well that link is to fine Particle System you did.
_vince:
--- Quote from: bplus on April 10, 2022, 07:57:09 am ---Found it:
http://sdlbasic.epizy.com/showthread.php?tid=235
Here is a simple particle system that I converted from Basic256. It has a lot of comments that explain what each step does.
Note: On my machine, the 'polygon' command, causes sdlbasic to freeze. SetPixel, Bar, fillcircle and Ployline all work just fine.
--- End quote ---
Wow, what is Basic256!? There's a successor to ModernBASIC 128?
bplus:
A little translation:
--- Code: QB64: ---' 2022-04-10 b+ translation of http://sdlbasic.epizy.com/showthread.php?tid=235 ' ***************' Particle System' ***************' maximum number of particles slots' lower this to get more fluent effectmaximum = 100 ' Each particle has 6 parameters' 0 : location on the x-axis' 1 : location on the y-axis' 2 : movement on the x-axis' 3 : movement on the y-axis' 4 : how old the particle can get' 5 : period where particle keeps the same colorDim particle(maximum, 6) ' ******************************' Boiler plate for a nice canvas' ******************************'setDisplay(700, 400, 32, 1)Screen _NewImage(700, 400, 32)f& = _LoadFont("Arial.ttf", 40) ' everyone has arial?_Font f& 'setCaption("Particles Example")_Title "Particles Example"_PrintMode _KeepBackground'autoback(-2)'hidemouse_MouseHideRandomize TimerDim As _Unsigned Long darkred, red, orange, yellow, whitedarkred = _RGB32(128, 0, 0)red = _RGB32(255, 0, 0)orange = _RGB32(255, 128, 0)yellow = _RGB32(255, 255, 0)white = _RGB32(255, 255, 255) ' *************************************************' pre-cache sin/cos calculations (small speed gain)' *************************************************Dim degree(361, 2)pi = 3.141592654k = 0For i = 0 To 2 * pi Step (2 * pi / 359) k = k + 1 degree(k, 0) = Sin(i) degree(k, 1) = Cos(i)Next 'initialize texttext_count = 0t1$ = "Particles Example"t2$ = "( Cool, isn't it? )"t3$ = "( useless too )"t4$ = t2$sw_text = 0 ' *************************************************' initial particle definition: all particles 'dead'' *************************************************For i = 0 To maximum - 1 particle(i, 4) = 0Next '**************************************************' main loop'**************************************************While _KeyDown(27) = 0 Cls ' create new particles ' ******************** ' select 7 random particles at each cycle ' play with this value to get the best result on your computer For k = 1 To 7 spawni = rand(maximum) ' if age of the random particle = 0, create one If particle(spawni, 4) = 0 Then ' horizontal location If rand(100) / 100 > 0.5 Then particle(spawni, 0) = 20 lings = 1 Else particle(spawni, 0) = 660 lings = 0 End If ' vertical location particle(spawni, 1) = 350 direction = rand(35) + 157 ' horizontal speed vector If lings = 1 Then particle(spawni, 2) = rand(6) Else particle(spawni, 2) = 0 - (rand(6)) End If ' falling speed vector particle(spawni, 3) = (0 - rand(6)) - 5 ' particle age particle(spawni, 4) = 30 + rand(50) ' color aging particle(spawni, 5) = particle(spawni, 4) / 5 End If Next ' update position on ALL live particles ' ************************************* For i = 0 To maximum - 1 ' for all live particles If particle(i, 4) > 0 Then ' calculate the new location particle(i, 0) = particle(i, 0) + particle(i, 2) particle(i, 1) = particle(i, 1) + particle(i, 3) ' increase the speed of falling particle(i, 3) = particle(i, 3) + (rand(100) / 100) / 3 ' make the particle older particle(i, 4) = particle(i, 4) - 1 ' if it hits the bottom, make it bounce up ' 0=no bounce, 1= full bounce,no damping If particle(i, 1) > 370 Then particle(i, 3) = -particle(i, 3) * ((rand(100) / 100) / 2) End If End If Next ' Color determination of the particle Dim k As _Unsigned Long '************************************ For i = 0 To maximum - 1 ' for all live particles If particle(i, 4) > 0 Then ' color it darkred if less than 20% life left If particle(i, 4) < particle(i, 5) Then k = darkred End If ' color it red if more than 20% life left If particle(i, 4) > (particle(i, 5)) Then k = red End If ' color it orange if more than 40% life left If particle(i, 4) > (particle(i, 5) * 2) Then k = orange End If ' color it yellow if more than 60% life left If particle(i, 4) > (particle(i, 5) * 3) Then k = yellow End If ' color it white if more than 80% life left If particle(i, 4) > (particle(i, 5) * 4) Then k = white End If '---------------------------- ' PLOT ALL THE LIVE PARTICLES '---------------------------- '--- circles --- 'circle(particle(i,0), particle(i,1), 2+rand(4)) '--- filled circles --- 'fillcircle(particle(i,0), particle(i,1), 2+rand(4)) '--- squares --- 'polyline(particle(i,0), particle(i,1), particle(i,0)+6, particle(i,1), particle(i,0)+6, particle(i,1)+6, particle(i,0), particle(i,1)+6, particle(i,0), particle(i,1)) '--- stars --- 'polyline(particle(i,0)+4, particle(i,1), particle(i,0)+8, particle(i,1)+12, particle(i,0), particle(i,1)+4, particle(i,0)+12, particle(i,1)+4, particle(i,0)+2, particle(i,1)+12) star particle(i, 0), particle(i, 1), 8, 20, 5, 90, k '--- polygon seems to 'lock-up' --- 'polygon(particle(i,0), particle(i,1), particle(i,0)+6, particle(i,1), particle(i,0)+6, particle(i,1)+6, particle(i,0), particle(i,1)+6, particle(i,0), particle(i,1)) '--- filled squares --- 'bar(particle(i,0), particle(i,1), particle(i,0)+2+rand(4), particle(i,1)+2+rand(4)) End If Next Color _RGB32(255, 255, 255) _PrintString (190, 140), t1$ Color _RGB32(0, 0, 255) _PrintString (192, 142), t1$ If text_count < 300 Then 'Text 223, 180, 24, t4$, &HFFFF0000 Color _RGB32(255, 255, 255) _PrintString (213, 190), t4$ Color _RGB32(255, 0, 0) _PrintString (215, 192), t4$ text_count = text_count + 1 Else If sw_text = 1 Then t4$ = t3$ sw_text = 0 Else t4$ = t2$ sw_text = 1 End If text_count = 0 End If _Display _Limit 10Wend Function rand% (n) rand% = Int((n + 1) * Rnd)End Function Sub star (x, y, rInner, rOuter, nPoints, angleOffset, K As _Unsigned Long) ' x, y are same as for circle, ' rInner is center circle radius ' rOuter is the outer most point of star ' nPoints is the number of points, ' angleOffset = angle offset IN DEGREES, it will be converted to radians in sub ' this is to allow us to spin the polygon of n sides Dim pAngle, radAngleOffset, x1, y1, x2, y2, x3, y3, i As Long pAngle = _D2R(360 / nPoints): radAngleOffset = _D2R(angleOffset) x1 = x + rInner * Cos(radAngleOffset) y1 = y + rInner * Sin(radAngleOffset) For i = 0 To nPoints - 1 x2 = x + rOuter * Cos(i * pAngle + radAngleOffset + .5 * pAngle) y2 = y + rOuter * Sin(i * pAngle + radAngleOffset + .5 * pAngle) x3 = x + rInner * Cos((i + 1) * pAngle + radAngleOffset) y3 = y + rInner * Sin((i + 1) * pAngle + radAngleOffset) ftri x1, y1, x2, y2, x3, y3, K 'triangles leaked Line (x1, y1)-(x2, y2), K Line (x2, y2)-(x3, y3), K Line (x3, y3)-(x1, y1), K x1 = x3: y1 = y3 Next Paint (x, y), K, KEnd Sub '2019-12-16 fix by Steve saves some time with STATIC and saves and restores last destSub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long) Dim D As Long Static a& D = _Dest _PrintMode _KeepBackground If a& = 0 Then a& = _NewImage(1, 1, 32) _Dest a& _DontBlend a& ' '<<<< new 2019-12-16 fix PSet (0, 0), K _Blend a& '<<<< new 2019-12-16 fix _Dest D _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)End Sub 'Sub Text (x, y, textHeight, txt$, k As _Unsigned Long)' Dim fg As _Unsigned Long, cur&, I&, multi, xlen' fg = _DefaultColor' 'screen snapshot' cur& = _Dest' I& = _NewImage(8 * Len(txt$), 16, 32)' _Dest I&' Color k' _PrintString (0, 0), txt$' multi = textHeight / 16' xlen = Len(txt$) * 8 * multi' _PutImage (x, y)-Step(xlen, textHeight), I&, cur&' Color fg' _FreeImage I&'End Sub
Navigation
[0] Message Index
[#] Next page
Go to full version