Smooothness - Printable Version

OPTION _EXPLICIT SCREEN _NEWIMAGE(1280, 720, 32) RANDOMIZE TIMER: _MOUSEHIDE _DELAY .25: _SCREENMOVE _MIDDLE TYPE particle x AS SINGLE y AS SINGLE Vx AS SINGLE Vy AS SINGLE END TYPE DIM AS INTEGER c DIM AS particle p(200) start: c = -1 DO ' c = c + 1 ' init particles p(c).x = _WIDTH / 2 p(c).y = c * -5 - 140 p(c).Vx = 0 p(c).Vy = 3 + (RND - RND) / 4 LOOP UNTIL c = UBOUND(p) DO c = -1 CLS _LIMIT 60 DO ' move em c = c + 1 p(c).x = p(c).x + p(c).Vx p(c).y = p(c).y + p(c).Vy IF p(c).y > 20 AND p(c).y < 26 THEN p(c).Vx = (RND - RND) / 1.75 ' only change em once IF p(c).y > 14 THEN p(c).Vy = p(c).Vy + .06 ' a little gravity LOOP UNTIL c = UBOUND(p) c = -1 DO ' draw em c = c + 1 PSET (p(c).x, p(c).y), _RGB32(255) LOOP UNTIL c = UBOUND(p) _DISPLAY IF p(200).y > _HEIGHT + 140 THEN GOTO start LOOP UNTIL _KEYDOWN(27) SYSTEM

Code: (Select All)

_Title "Particle Fountain" 'b+ 2020-08-27

' 2023-08-17 tweaked a number for improved more consistent performance

Const nP = 50000

Type particle

    x As Single

    y As Single

    dx As Single

    dy As Single

    r As Single

    c As _Unsigned Long

End Type

Dim Shared p(1 To nP) As particle

Screen _NewImage(800, 600, 32)

_Delay .25

_ScreenMove _Middle

For i = 1 To nP

    new i

Next

Color , &HFF002200

Do

    Cls

    If lp < nP Then lp = lp + 10

    For i = 1 To lp

        p(i).dy = p(i).dy + .1

        p(i).x = p(i).x + p(i).dx

        p(i).y = p(i).y + p(i).dy

        If p(i).x < 0 Or p(i).x > _Width Then new i

        If p(i).y > _Height And p(i).dy > 0 Then

            p(i).dy = -.75 * p(i).dy: p(i).y = _Height - 5

        End If

        Circle (p(i).x, p(i).y), p(i).r, p(i).c

    Next

    _Display

    _Limit 60

Loop Until _KeyDown(27)

Sub new (i)

    p(i).x = _Width / 2 + Rnd * 20 - 10

    p(i).y = _Height + Rnd * 5

    p(i).dx = Rnd * 1 - .5

    p(i).dy = -10

    p(i).r = Rnd * 3

    p(i).c = _RGB32(50 * Rnd + 165, 50 * Rnd + 165, 255)

End Sub

Option _Explicit Screen _NewImage(1280, 720, 32) Randomize Timer: _MouseHide _Delay .25: _ScreenMove _Middle Type particle: As Single x, y, Vx, Vy: End Type Dim As Integer c, reset_values Dim As particle p(200) reset_values = -1 Do Cls For c = 0 To UBound(p) If reset_values Then p(c).x = _Width / 2 p(c).y = c * -5 - 140 p(c).Vx = 0 p(c).Vy = 3 + (Rnd - Rnd) / 4 End If p(c).x = p(c).x + p(c).Vx p(c).y = p(c).y + p(c).Vy If p(c).y > 20 And p(c).y < 26 Then p(c).Vx = (Rnd - Rnd) / 1.75 ' only change em once If p(c).y > 14 Then p(c).Vy = p(c).Vy + .06 ' a little gravity PSet (p(c).x, p(c).y), _RGB32(255) Next _Limit 60 _Display If p(200).y > _Height + 140 Then reset_values = -1 Else reset_values = 0 Loop Until _KeyDown(27) System

Code: (Select All)

Option _Explicit

_Title "Another Particle Fountain" ' bplus mod Steve mod NakedApe  2024-10-13

Screen _NewImage(600, 600, 32)

_ScreenMove 250, 20

Randomize Timer: _MouseHide

_Delay .25: _ScreenMove _Middle



Type particle

    As Single x, y, Vx, Vy

    As _Unsigned Long c

    As Integer flag

End Type

Dim As Long i, top, j, s

Dim As Single r, g, b

restart:

ReDim As particle p(15000)

r = Rnd * Rnd: g = Rnd * Rnd: b = Rnd * Rnd: top = 1

Do

    Cls

    For i = 0 To top

        If p(i).flag = 0 Then

            p(i).x = _Width / 2 + 20 * (Sin(_D2R(i Mod 360)))

            p(i).y = _Height - 1

            p(i).Vx = 0

            p(i).Vy = -7

            p(i).flag = 1

            p(i).c = _RGB32(127 * 127 * Sin(r * i * .5), 127 * 127 * Sin(g * i * .5), 127 * 127 * Sin(b * i * .5))

        End If

        p(i).Vy = p(i).Vy + .032

        p(i).Vx = p(i).Vx + .1 * Rnd - .1 * Rnd

        p(i).x = p(i).x + p(i).Vx

        p(i).y = p(i).y + p(i).Vy + 2 * Rnd

        If p(i).y > _Height Then p(i).flag = 0

        Circle (p(i).x, p(i).y), 2, p(i).c

        s = s + 1

        If s Mod 100 = 0 Then

            If top < UBound(p) Then top = top + 1

        End If

    Next

    _Display

    _Limit 60

    If s > 20000000 Then

        s = 0

        GoTo restart

    End If

Loop Until _KeyDown(27)

System