Ying and Yang on fire
#1
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


Attached Files Thumbnail(s)

B += x
Reply
#2
So let me get this straight. First you post your balls are on fire, next you post your yin and yang is on fire. I don't see any immediate solution for your situation, other than to code up a big ol' batch file of pen-nee-cillin.

Pete Big Grin
Reply
#3
Hey Pete, how's the WP coming, anything hot off the press?
B += x
Reply
#4
Check my forum: http://www.network54.com/Forum/648955/me...litaire%21

If you want a membership there, just sign up at network54, http://network54.com, and let me know your log in name (not password, just name.) 

Pete Big Grin
Reply
#5
Thanks Pete, I will remain a lurker... 

Tonight I just noticed on news that this graphic looks allot like S Korea's flag!

Relax, not a whole lot of primary colors to choose from and there is only one pair at opposite ends of spectrum.
B += x
Reply