Screen Savers

[bplus]

Trivial 2D Explosions

That was Stx's tiltle from which I made a fun mod. Trivial is wrong! Fun is not Trivial it is vital.

So here is better title for my mod anyway:

Fun Fake 3D Explosions!

Code: (Select All)

_Title "trivial 2D explosions B+ mod 2" 'STxAxTIC mod B+ 2019-02-03
' 2019-02-03 use a bg& for background instead of redraws each loop, that should cool down CPU
'  rounder rocks, more fiddle with numbers

Const xmax = 1200
Const ymax = 700
Screen _NewImage(xmax, ymax, 32)
'_ScreenMove 100, 20
_FullScreen
Randomize Timer

np = 500 'number of particles
Dim x(np), y(np), xold(np), yold(np), v0x(np), v0y(np), col(np) As _Unsigned Long

nr = 3500 'number of rocks
Dim rx(nr), ry(nr), rw(nr), rh(nr), rc(nr) As _Unsigned Long
For i = 0 To nr \ 2
    rx(i) = Rnd * xmax
    ry(i) = .5 * ymax + Rnd * .25 * ymax + rx(i) * .09
    rw(i) = ry(i) * ry(i) * .00015
    rh(i) = .3 * rw(i)
    r = 200 * Rnd
    rc(i) = _RGB32(r, .45 * r, .2 * r)
Next
For i = nr \ 2 + 1 To nr
    rx(i) = Rnd * xmax
    ry(i) = .5 * ymax + Rnd * .75 * ymax + rx(i) * .09
    rw(i) = ry(i) * ry(i) * .00015
    rh(i) = .3 * rw(i)
    r = 200 * Rnd
    rc(i) = _RGB32(r, .45 * r, .2 * r)
Next

no = 80 'number of rock bounce reflectors
Dim ox(no), oy(no), ow(no), oh(no)
For i = 0 To no
    ox(i) = Rnd * xmax
    oy(i) = .5 * ymax + Rnd * .75 * ymax + ox(i) * .09
    ow(i) = oy(i) * oy(i) * .00015
    oh(i) = .3 * ow(i)
Next


Dim wallcol As _Unsigned Long
wallcol = _RGB32(200, 100, 50)
g = 95
xdamp = .07
ydamp = .07
exploderadius = 10

'draw background
bgrd& = _NewImage(xmax, ymax, 32)
_Dest bgrd&
'sky
For y = 0 To ymax
    Line (0, y)-(xmax, y), _RGB32(.1 * y, .1 * y, .15 * y), BF
Next
'rocks
For i = 0 To nr
    EllipseFill rx(i), ry(i), rw(i), rh(i), rc(i)
    'LINE (rx(i), ry(i))-STEP(rw(i), rh(i)), rc(i), BF
Next i

'Draw obstacles randomly
For i = o To no
    EllipseFill ox(i), oy(i), ow(i), oh(i), wallcol
    'LINE (ox(i), oy(i))-STEP(ow(i), oh(i)), wallcol, BF
Next i

_Dest 0

start:
iterations = 0
'Toggle for random starting position.
xshift = Rnd * xmax
yshift = Rnd * ymax * .6


For i = 1 To np
    speed = Rnd * 150 + 1
    ang1 = Rnd * 2 * 3.141592653589793#
    ang2 = Rnd * 2 * 3.141592653589793#
    x(i) = xshift + Rnd * exploderadius * Cos(ang1)
    y(i) = yshift + Rnd * exploderadius * Sin(ang1)
    v0x(i) = speed * Cos(ang2)
    v0y(i) = speed * Sin(ang2)
    dotcol:
    col(i) = _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)
    If col(i) = bgcol Or col(i) = wallcol Then GoTo dotcol
    If Point(x(i), y(i)) = wallcol Or x(i) < 0 Or x(i) > xmax Or y(i) < 0 Or y(i) > ymax Then i = i - 1
    dv = Sqr((v0x(i)) ^ 2 + (v0y(i)) ^ 2)
    If dv > vmax Then vmax = dv
Next
dt = .995 / vmax

Do
    _PutImage , bgrd&, 0
    iterations = iterations + 1
    smax = 0
    For i = 1 To np
        xold(i) = x(i)
        yold(i) = y(i)
        v0x(i) = v0x(i) + .1 * dt
        v0y(i) = v0y(i) + g * dt + .2 'more gravity
        xtmp = x(i) + v0x(i) * dt
        ytmp = y(i) + v0y(i) * dt
        If Point(xtmp, yold(i)) = wallcol Then v0x(i) = v0x(i) * -1 * xdamp
        If Point(xold(i), ytmp) = wallcol Then v0y(i) = v0y(i) * -1 * ydamp
        x(i) = x(i) + v0x(i) * dt
        y(i) = y(i) + v0y(i) * dt
        EllipseFill x(i), y(i), 3, 3, col(i)
        ds = Sqr((y(i) - yold(i)) ^ 2 + (x(i) - xold(i)) ^ 2)
        If ds > smax Then smax = ds
    Next
    If smax > .95 Then dt = dt * (1 - .01)
    If smax < .9 Then dt = dt * (1 + .01)
    _Display
    _Limit 200
    If iterations > 1500 Then GoTo start
Loop Until InKey$ <> ""

' with Steve's EllipseFill, who needs CircleFill?
Sub EllipseFill (cx As Integer, cy As Integer, rx As Integer, ry As Integer, c As _Unsigned Long)
    Dim a As Long, b As Long
    Dim x As Long, y As Long
    Dim xx As Long, yy As Long
    Dim sx As Long, sy As Long
    Dim e As Long

    a = 2 * rx * rx
    b = 2 * ry * ry
    x = rx
    xx = ry * ry * (1 - rx - rx)
    yy = rx * rx
    sx = b * rx

    Do While sx >= sy
        Line (cx - x, cy - y)-(cx + x, cy - y), c, BF
        If y <> 0 Then Line (cx - x, cy + y)-(cx + x, cy + y), c, BF

        y = y + 1
        sy = sy + a
        e = e + yy
        yy = yy + a

        If (e + e + xx) > 0 Then
            x = x - 1
            sx = sx - b
            e = e + xx
            xx = xx + b
        End If
    Loop

    x = 0
    y = ry
    xx = rx * ry
    yy = rx * rx * (1 - ry - ry)
    e = 0
    sx = 0
    sy = a * ry

    Do While sx <= sy
        Line (cx - x, cy - y)-(cx + x, cy - y), c, BF
        Line (cx - x, cy + y)-(cx + x, cy + y), c, BF

        Do
            x = x + 1
            sx = sx + b
            e = e + xx
            xx = xx + b
        Loop Until (e + e + yy) > 0

        y = y - 1
        sy = sy - a
        e = e + yy
        yy = yy + a

    Loop

End Sub

STx's code is almost interesting too:

Code: (Select All)

'#lang "qb"              ' freebasic edit 2011-06
delayconst = 900000 ' freebasic edit 2011-06
'CLEAR                  ' freebasic edit 2011-06

CLS
SCREEN 12
RANDOMIZE TIMER

LOCATE 1, 2: INPUT "Enter number of particles (default is 80): ", num
IF num = 0 THEN num = 80
DIM x(num), y(num), xold(num), yold(num), v0x(num), v0y(num), col(num)

start:
CLS
iterations = 0
'g = RND * 10 + 20
g = RND * 15 + 25
xdamp = RND * .15 + .55
ydamp = RND * .15 + .55
exploderadius = 200 '75
numobstacles = 0
iterationmax = 1200

choosecol:
bgcol = INT(RND * 14)
wallcol = 0 'INT(RND * 14)'change to zero for spider mode
IF bgcol = wallcol THEN GOTO choosecol

LINE (1, 1)-(639, 479), bgcol, BF
LINE (1, 1)-(639, 479), wallcol, B

'Draw obstacles randomly.
FOR i = 1 TO numobstacles
    LINE (RND * 640, RND * 480)-(RND * 640, RND * 480), wallcol, B
NEXT i

'Make predetermined obstacles.
'LINE (50, 75)-(600, 125), wallcol, B

'Toggle for random starting position.
xshift = RND * 640
yshift = RND * 480
'Toggle for fixed starting position
'xshift = 100
'yshift = 100

FOR i = 1 TO num
    speed = RND * 90
    ang1 = RND * 2 * 3.141592653589793#
    ang2 = RND * 2 * 3.141592653589793#
    x(i) = xshift + RND * exploderadius * COS(ang1)
    y(i) = yshift + RND * exploderadius * SIN(ang1)
    v0x(i) = 1.5 * speed * COS(ang2)
    v0y(i) = speed * SIN(ang2)
    dotcol:
    col(i) = INT(RND * 13 + 1)
    IF col(i) = bgcol OR col(i) = wallcol THEN GOTO dotcol
    IF POINT(x(i), y(i)) = wallcol OR x(i) < 1 OR x(i) > 639 OR y(i) < 1 OR y(i) > 479 THEN i = i - 1
    dv = SQR((v0x(i)) ^ 2 + (v0y(i)) ^ 2)
    IF dv > vmax THEN vmax = dv
    PSET (x(i), y(i)), col(i)
NEXT

dt = .995 / vmax
'PRINT dt

SLEEP 1

DO
    idel = 0: DO: idel = idel + 1: LOOP UNTIL idel > delayconst ' freebasic edit 2011-06

    iterations = iterations + 1
    smax = 0
    FOR i = 1 TO num
        xold(i) = x(i)
        yold(i) = y(i)
        v0x(i) = v0x(i) + 0 * dt
        v0y(i) = v0y(i) + g * dt
        xtmp = x(i) + v0x(i) * dt
        ytmp = y(i) + v0y(i) * dt
        IF POINT(xtmp, yold(i)) = wallcol THEN v0x(i) = v0x(i) * -1 * xdamp
        IF POINT(xold(i), ytmp) = wallcol THEN v0y(i) = v0y(i) * -1 * ydamp
        x(i) = x(i) + v0x(i) * dt
        y(i) = y(i) + v0y(i) * dt
        'Recolor stagnant particles.
        xx = x(i) - xold(i)
        yy = y(i) - yold(i)
        IF SQR(xx ^ 2 + yy ^ 2) < .05 THEN col(i) = bgcol
        PSET (xold(i), yold(i)), 0 'bgcol
        PSET (x(i), y(i)), col(i)
        ds = SQR((y(i) - yold(i)) ^ 2 + (x(i) - xold(i)) ^ 2)
        IF ds > smax THEN smax = ds
    NEXT
    IF smax > .95 THEN dt = dt * (1 - .01)
    IF smax < .9 THEN dt = dt * (1 + .01)
    IF iterations > iterationmax THEN
        SLEEP 2
        GOTO start
    END IF
    LINE (19, 459)-(151, 471), wallcol, B
    LINE (20, 460)-(20 + 130 * (iterations / iterationmax), 470), 15, BF
LOOP UNTIL INKEY$ <> ""
END

How the heck did I get from his post to mine? They look so different!