Screen Savers - Printable Version

Code: (Select All)

_Title "Floating Triangle - by Sierraken"

Screen _NewImage(800, 800, 32)

dirrr = .1

dirx = -1

diry = 1

cenx = 400

ceny = 400

length1 = Rnd * 50

length2 = Rnd * 50

length3 = Rnd * 50



Do

    _Limit 15

    If cenx > 600 Then dirx = -1 * Rnd * 3

    If cenx < 200 Then dirx = 1 * Rnd * 3

    If ceny > 600 Then diry = -1 * Rnd * 3

    If ceny < 200 Then diry = 1 * Rnd * 3

    t = t + .1

    If t = 2 Then

        dirr = Int(Rnd * 4) + 1

        If dirr = 1 Then dirx = -1 * Rnd * 3

        If dirr = 2 Then dirx = 1 * Rnd * 3

        If dirr = 3 Then diry = -1 * Rnd * 3

        If dirr = 4 Then diry = 1 * Rnd * 3

        length1 = Rnd * 50

        length2 = Rnd * 50

        length3 = Rnd * 50

    End If

    If t = 6 Then

        dirr2 = Int(Rnd * 2)

        If dirr2 = 1 Then dirrr = -.1

        If dirr2 = 2 Then dirrr = .1

        length1 = Rnd * 50

        length2 = Rnd * 50

        length3 = Rnd * 50

    End If

    cenx = cenx + dirx

    ceny = ceny + diry

    seconds = seconds + dirrr

    s = (60 - seconds) * 6 + 180

    x = Int(Sin(s / 180 * 3.141592) * 125) + cenx

    y = Int(Cos(s / 180 * 3.141592) * 125) + ceny

    m = 180 - seconds * 6

    xx = Int(Sin(m / 180 * 3.141592) * 120) + x

    yy = Int(Cos(m / 180 * 3.141592) * 120) + y

    c1 = c1 + 1

    c2 = c2 + 1

    c3 = c3 + 1

    If c1 > 255 Then

        c1 = Rnd * 255

        c2 = Rnd * 255

        c3 = Rnd * 255

    End If

    For b = -5 To 5 Step .1

        Line (x + b + length3, y + b + length3)-(xx + b + length1, yy + b + length1), _RGB32(c1, c2, c3)

    Next b

    h = 360 - seconds * 30 + 180

    xxx = Int(Sin(h / 180 * 3.141592) * 100) + xx

    yyy = Int(Cos(h / 180 * 3.141592) * 100) + yy

    For b = -5 To 5 Step .1

        Line (xx + b + length1, yy + b + length1)-(xxx + b + length2, yyy + b + length2), _RGB32(c1, c2, c3)

    Next b

    For b = -5 To 5 Step .1

        Line (xxx + b + length2, yyy + b + length2)-(x + b + length3, y + b + length3), _RGB32(c1, c2, c3)

    Next b

    If t > 12 Then

        t = 0

    End If

    _Display

    Line (0, 0)-(800, 800), _RGB32(0, 0, 0, 30), BF

Loop Until InKey$ = Chr$(27)

Trivial 2D Explosions

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

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