+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: Ball Sub - draws several kind of filled, textured balls (circles) (/showthread.php?tid=1929)
Pages:
1
2
Ball Sub - draws several kind of filled, textured balls (circles) - Dav - 08-22-2023
Started updating my little Ball SUB (filled circle), thought I'd build it up over time by adding different kinds of textures to the balls, instead of just plain solid colors. Although this is nowhere near the speed of the gold standard fcirc routine, it can be handy, and it's easy to drop the SUB in your programs.
So far it can draw 6 kinds of filled balls. Solid, Gradient, and some textures like grainy, striped, plasma, mixed.
I will come up with some more textures. If you'd like to add one, please do.
- Dav
Code: (Select All)
'===========
'BALLSUB.BAS v1.0
'===========
'Simple Ball SUB that draws balls of different textures.
'Solid, Gradient, planet, plasma, noisey, striped, mixed.
'Coded by Dav, AUGUST/2023
Randomize Timer
Screen _NewImage(1000, 600, 32)
Do
'make random ball to show all kinds
ball Int(Rnd * 7), Rnd * _Width, Rnd * _Height, Rnd * 300 + 25, Rnd * 255, Rnd * 255, Rnd * 255, 100 + Rnd * 155
_Limit 10
Loop Until InKey$ <> ""
Sub ball (kind, x, y, size, r, g, b, a)
'SUB by Dav that draws many types of filled balls (circles).
'Not super fast, but small and easy to add to your programs.
'kind=0 (Gradient)
'kind=1 (noisey)
'kind=2 (planets)
'kind=3 (plasma)
'kind=4 (striped)
'kind=5 (plasma mix with gradient noise)
'kind=6 (solid)
'get current display status to restore later
displayStatus%% = _AutoDisplay
'turn off screen updates while we draw
_Display
t = Timer
For y2 = y - size To y + size
For x2 = x - size To x + size
If Sqr((x2 - x) ^ 2 + (y2 - y) ^ 2) <= size Then
clr = (size - (Sqr((x2 - x) * (x2 - x) + (y2 - y) * (y2 - y)))) / size
Select Case kind
Case 1: 'noisey (grainy)
noise = Rnd * 255
Case 2: 'planet
noise = 20 * Sin((x2 + y2) / 30) + 10 * Sin((x2 + y2) / 10)
Case 3: 'plasma
r = (Sin(x2 / (size / 4)) + Sin(y2 / size / 2)) * 128 + 128
g = (Sin(x2 / (size / 6)) + Cos(y2 / (size / 4))) * 128 + 128
b = (Cos(x2 / (size / 4)) + Sin(y2 / (size / 6))) * 128 + 128
Case 4: 'striped
dx = x2 - size: dy = y2 - size
dis = Sqr(dx * dx + dy * dy)
r = Sin(dis / 5) * 255
g = Cos(dis / 25) * 255
b = 255 - Sin(dis / 50) * 255
Case 5: 'plasma mix with gradient & noise
noise = Int(Rnd * 50)
r = Sin(6.005 * t) * size - y2 + size + 255
g = Sin(3.001 * t) * size - x2 + size + 255
b = Sin(2.001 * x2 / size + t + y2 / size) * r + 255
t = t + .00195
Case Else: 'solid & gradient (no noise)
noise = 0
End Select
If kind = 6 Then
'if solid color
PSet (x2, y2), _RGBA(r, g, b, a)
Else
'all others, noise & gradient color aware
PSet (x2, y2), _RGBA(clr * r - noise, clr * g - noise, clr * b - noise, a)
End If
End If
Next
Next
'show the ball on the screen
_Display
'If autodislay was previously on, turn it back on
If displayStatus%% = 1 Then _AutoDisplay
End Sub
RE: Ball Sub - draws several kind of filled, textured balls (circles) - dbox - 08-22-2023
Very cool! Works in QBJS with an additional Dim statement at line 20:
RE: Ball Sub - draws several kind of filled, textured balls (circles) - Dav - 08-22-2023
Oh wow, QBJS is really coming along great! Runs perfect.
- Dav
RE: Ball Sub - draws several kind of filled, textured balls (circles) - James D Jarvis - 08-22-2023
Those are some fine balls you got there. (I'm sorry, nothing could stop me from typing that).
RE: Ball Sub - draws several kind of filled, textured balls (circles) - SMcNeill - 08-22-2023
(08-22-2023, 07:26 PM)James D Jarvis Wrote: Those are some fine balls you got there. (I'm sorry, nothing could stop me from typing that).
Now, the real question is: *Do you guys want to see my mod to them where I cover them all in hair?"
If you like, I can do them in 4k for super large, hairy balls!
RE: Ball Sub - draws several kind of filled, textured balls (circles) - bplus - 08-22-2023
And I've already lightened them up for you all!
https://staging.qb64phoenix.com/showthread.php?tid=162&pid=657#pid657
RE: Ball Sub - draws several kind of filled, textured balls (circles) - Dav - 08-22-2023
Nice, bplus. I forgot about that one.
I just finished adding Vooroni pattern balls. Working on fire balls, but they're not... great balls of fire yet.
- Dav (ducking)
RE: Ball Sub - draws several kind of filled, textured balls (circles) - Dav - 08-23-2023
Here's a new version - added 3 more ball types: Voronoi pattern, Checkered, Fabric. Was able to get it working in QBJS with a little adjustment.
EDIT: I can't seem to post this in the QBJS code box....
- Dav
Code: (Select All)
'===========
'BALLSUB.BAS v1.1
'===========
'Simple Ball SUB that draws balls of different textures.
'Coded by Dav, AUGUST/2023
'New for v1.1: - Added 3 textures: Voronoi, checkered, fabric.
'Ball types: Solid, Gradient, planet, plasma, noisey, striped,
' plasma mixed, Voronoi pattern, checkered, fabric.
RANDOMIZE TIMER
SCREEN _NEWIMAGE(1000, 600, 32)
DO
'show all kinds of balls
ball INT(RND * 10), RND * _WIDTH, RND * _HEIGHT, RND * 300 + 25, RND * 255, RND * 255, RND * 255, 100 + RND * 155
_LIMIT 10
LOOP UNTIL INKEY$ <> ""
SUB ball (kind, x, y, size, r, g, b, a)
'SUB by Dav that draws many types of filled balls (circles).
'Not super fast, but small and easy to add to your programs.
'kind=0 (Gradient)
'kind=1 (noisey)
'kind=2 (planets)
'kind=3 (plasma)
'kind=4 (striped)
'kind=5 (plasma mixed)
'kind=6 (solid, non gradient)
'kind-7 (voronoi pattern)
'kind=8 (checkered pattern)
'kind=9 (fabric)
'The DIMs makes the SUB QBJS compatible
'(these are not needed if using QB64)
DIM displayStatus%%, t, y2, x2, clr, noise, dx, dy, dis
DIM scale, xf, yf, cell, cellsize, closest, min, p, Points
'=== check for and do special drawing kinds first
'fabric pattern
IF kind = 9 THEN
scale = size / 30
IF scale < 3 THEN scale = 3
IF scale > 9 THEN scale = 9
FOR y2 = y - size TO y + size
FOR x2 = x - size TO x + size
IF SQR((x2 - x) ^ 2 + (y2 - y) ^ 2) <= size THEN
clr = (size - (SQR((x2 - x) * (x2 - x) + (y2 - y) * (y2 - y)))) / size
noise = INT(RND * 100)
xf = x2 + INT(SIN(((x2 - size) / scale)) * scale)
yf = y2 + INT(COS(((y2 - size) / scale)) * scale)
PSET (xf, yf), _RGBA(clr * r - noise, clr * g - noise, clr * b - noise, a)
END IF
NEXT
NEXT
EXIT SUB
END IF
'checkered ball
IF kind = 8 THEN
cellsize = INT(size / 4)
IF cellsize < 5 THEN cell = 5
FOR y2 = y - size TO y + size
FOR x2 = x - size TO x + size
IF SQR((x2 - x) ^ 2 + (y2 - y) ^ 2) <= size THEN
clr = (size - (SQR((x2 - x) * (x2 - x) + (y2 - y) * (y2 - y)))) / size
IF x2 MOD cellsize < (cellsize / 2) THEN
IF y2 MOD cellsize < (cellsize / 2) THEN
PSET (x2, y2), _RGBA(clr * r - noise, clr * g - noise, clr * b - noise, a)
ELSE
PSET (x2, y2), _RGBA(1, 1, 1, a)
END IF
ELSE
IF y2 MOD cellsize < (cellsize / 2) THEN
PSET (x2, y2), _RGBA(1, 1, 1, a)
ELSE
PSET (x2, y2), _RGBA(clr * r - noise, clr * g - noise, clr * b - noise, a)
END IF
END IF
END IF
NEXT
NEXT
EXIT SUB
END IF
'Voronoi pattern
IF kind = 7 THEN
Points = INT(size / 25)
IF Points < 7 THEN Points = 7
DIM PointX(Points), PointY(Points), PointR(Points), PointG(Points), PointB(Points)
FOR p = 1 TO Points
PointX(p) = x + (RND * size * 2) - (size)
PointY(p) = y + (RND * size * 2) - (size)
PointR(p) = RND * 255
PointG(p) = RND * 255
PointB(p) = RND * 255
NEXT
FOR x2 = x - size TO x + size
FOR y2 = y - size TO y + size
IF SQR((x2 - x) ^ 2 + (y2 - y) ^ 2) <= size THEN
min = SQR((x2 - PointX(1)) ^ 2 + (y2 - PointY(1)) ^ 2)
closest = 1
FOR p = 2 TO Points
dis = SQR((x2 - PointX(p)) ^ 2 + (y2 - PointY(p)) ^ 2)
IF dis < min THEN min = dis: closest = p
NEXT
PSET (x2, y2), _RGBA(PointR(closest) - min, PointG(closest) - min, PointB(closest) - min, a)
END IF
NEXT
NEXT
EXIT SUB
END IF
'==== All other ball textures follow (they use same drawing method)
'get current display status to restore later
displayStatus%% = _AUTODISPLAY
'turn off screen updates while we draw
_DISPLAY
t = TIMER
FOR y2 = y - size TO y + size
FOR x2 = x - size TO x + size
IF SQR((x2 - x) ^ 2 + (y2 - y) ^ 2) <= size THEN
clr = (size - (SQR((x2 - x) * (x2 - x) + (y2 - y) * (y2 - y)))) / size
SELECT CASE kind
CASE 1: 'noisey (grainy)
noise = RND * 255
CASE 2: 'planet
noise = 20 * SIN((x2 + y2) / 30) + 10 * SIN((x2 + y2) / 10)
CASE 3: 'plasma
r = (SIN(x2 / (size / 4)) + SIN(y2 / size / 2)) * 128 + 128
g = (SIN(x2 / (size / 6)) + COS(y2 / (size / 4))) * 128 + 128
b = (COS(x2 / (size / 4)) + SIN(y2 / (size / 6))) * 128 + 128
CASE 4: 'striped
dx = x2 - size: dy = y2 - size
dis = SQR(dx * dx + dy * dy)
r = SIN(dis / 5) * 255
g = COS(dis / 25) * 255
b = 255 - SIN(dis / 50) * 255
CASE 5: 'plasma mix with gradient & noise
noise = INT(RND * 50)
r = SIN(6.005 * t) * size - y2 + size + 255
g = SIN(3.001 * t) * size - x2 + size + 255
b = SIN(2.001 * x2 / size + t + y2 / size) * r + 255
t = t + .00195
CASE ELSE: 'solid & gradient (no noise)
noise = 0
END SELECT
IF kind = 6 THEN
'if solid color only, then...
PSET (x2, y2), _RGBA(r, g, b, a)
ELSE
'...else, with noise & gradient color aware
PSET (x2, y2), _RGBA(clr * r - noise, clr * g - noise, clr * b - noise, a)
END IF
END IF
NEXT
NEXT
'show the ball on the screen
_DISPLAY
'If autodislay was previously on, turn it back on
IF displayStatus%% = 1 THEN _AUTODISPLAY
END SUBRE: Ball Sub - draws several kind of filled, textured balls (circles) - dbox - 08-23-2023
Hey @Dav, the QBJS tag is expects you to paste in the share link in between the qbjs start and end tags instead of the source code. You can get the share link by clicking the button to the right of the play button.
RE: Ball Sub - draws several kind of filled, textured balls (circles) - Dav - 08-23-2023
Ah....thanks, @dbox! Here it is then.
- Dav