11-25-2017, 11:10 AM

Code:

`_TITLE "Yinging and yanging with balls on fire by bplus, 2017-11-24"`

CONST xmax = 640

CONST ymax = 640

SCREEN _NEWIMAGE(xmax, ymax, 32)

_SCREENMOVE 360, 60 'adjust as needed _MIDDLE needs a delay .5 or more for me

DEFSNG A-Z

DIM SHARED xxmax, yymax, br, brs, br2, br2s

xxmax = 160: yymax = 160

xc = xxmax / 2: yc = yymax / 2 + 10

xstep = xmax / xxmax: ystep = ymax / yymax

br = 25 ' ball radius

brs = br * br ' ball radius squared

br2 = 8

br2s = br2 * br2

DIM SHARED pr&(255) 'pallette thanks harixxx

DIM SHARED pb&(255)

FOR i = 1 TO 255

pb&(i) = _RGB(0, 0, i)

pr&(i) = _RGB(i, 0, 0)

NEXT

DIM SHARED f(xxmax, yymax) 'fire array tracks flames

WHILE 1 'main show

CLS 'some flames are sticking

FOR i = 0 TO xxmax: f(i, yymax) = 0: f(i, yymax - 1) = 0: NEXT

FOR i = 0 TO yymax: f(0, i) = 0: NEXT

a = a + _PI(1 / 36)

IF a > _PI(2) THEN a = 0

bx = xc + br * COS(a)

by = yc + br * SIN(a)

rfireBall bx, by

bx1 = xc + br * COS(a + _PI(1))

by1 = yc + br * SIN(a + _PI(1))

bfireBall bx1, by1

FOR y = 1 TO yymax - 2 'fire based literally on 4 pixels below it like cellular automata

FOR x = 1 TO xxmax - 1

v = (f(x - 1, y + 1) + f(x, y + 1) + f(x + 1, y + 1) + f(x, y + 2)) / 4

IF v > 0 THEN v = v - 1 ELSE v = v + 1

IF RND < .9 THEN f(x, y) = v ELSE f(x, y) = 0

IF v > 254 THEN f(x, y) = 255

IF v < -254 THEN f(x, y) = -255

'glow worms effect

'f(x, y) = max((f(x - 1, y + 1) + f(x, y + 1) + f(x + 1, y + 1) + f(x, y + 2)) / 4 - 15, 0)

IF f(x, y) < 0 THEN COLOR pb&(-1 * f(x, y))

IF f(x, y) > 0 THEN COLOR pr&(f(x, y))

LINE (x * xstep, y * ystep)-STEP(xstep, ystep), , BF

NEXT

NEXT

COLOR pb&(255)

fcirc bx * xstep, by * ystep, br2 * xstep

COLOR pr&(255)

fcirc bx1 * xstep, by1 * ystep, br2 * xstep

'I intended to remove the following block after moving it to start of loop but it works better to double it

'go ahead and comment it out and see what I am talking about!

a = a + _PI(1 / 36)

IF a > _PI(2) THEN a = 0

bx = xc + br * COS(a)

by = yc + br * SIN(a)

rfireBall bx, by

bx = xc + br * COS(a + _PI(1))

by = yc + br * SIN(a + _PI(1))

bfireBall bx, by

_DISPLAY

_LIMIT 30

WEND

SUB rfireBall (x, y)

FOR xr = 0 TO br

yrMax = (brs - xr * xr) ^ .5

FOR yr = 0 TO yrMax

IF x + xr < xxmax - 1 AND y + yr <= yymax - 1 THEN f(x + xr, y + yr) = 255

IF x + xr < xxmax - 1 AND y - yr >= 0 THEN f(x + xr, y - yr) = 255

IF x - xr >= 0 AND y + yr <= yymax THEN f(x - xr, y + yr) = 255

IF x - xr >= 0 AND y - yr >= 0 THEN f(x - xr, y - yr) = 255

NEXT

NEXT

END SUB

SUB bfireBall (x, y)

FOR xr = 0 TO br

yrMax = (brs - xr * xr) ^ .5

FOR yr = 0 TO yrMax

IF x + xr < xxmax - 1 AND y + yr <= yymax - 1 THEN f(x + xr, y + yr) = -255

IF x + xr < xxmax - 1 AND y - yr >= 0 THEN f(x + xr, y - yr) = -255

IF x - xr >= 0 AND y + yr <= yymax THEN f(x - xr, y + yr) = -255

IF x - xr >= 0 AND y - yr >= 0 THEN f(x - xr, y - yr) = -255

NEXT

NEXT

END SUB

'Steve McNeil's copied from his forum note: Radius is too common a name

SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)

DIM subRadius AS LONG, RadiusError AS LONG

DIM X AS LONG, Y AS LONG

subRadius = ABS(R)

RadiusError = -subRadius

X = subRadius

Y = 0

IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB

' Draw the middle span here so we don't draw it twice in the main loop,

' which would be a problem with blending turned on.

LINE (CX - X, CY)-(CX + X, CY), , BF

WHILE X > Y

RadiusError = RadiusError + Y * 2 + 1

IF RadiusError >= 0 THEN

IF X <> Y + 1 THEN

LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF

LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF

END IF

X = X - 1

RadiusError = RadiusError - X * 2

END IF

Y = Y + 1

LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF

LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF

WEND

END SUB

B += x