Posts: 572
Threads: 109
Joined: Apr 2022
Reputation:
28
(07-12-2023, 02:36 PM)bplus Wrote: (07-12-2023, 02:21 PM)Dav Wrote: _HYPOT huh? Neat. I shouldn't have stopped reading the keyword of the day thread. 
- Dav
Hi from ZXDunny at another forum that Charlie has inspired, this is a ball shader:
Code: (Select All)
' Ball shader
' by ZXDunny 2023
sw = 800
sh = 480
Screen _NewImage(sw, sh, 32) ' SpecBAS uses this as its default window size
xc = sw / 2
yc = sh / 2
r = 100
amb = 0.0125
k = 3
mxp = (1 - amb) * 255
r2 = r * r
Do
While _MouseInput: Wend
lx = xc - _MouseX
ly = yc - _MouseY
lz = -75
Cls
l = Sqr(lx * lx + ly * ly + lz * lz)
nlx = lx / l
nly = ly / l
nlz = lz / l
For x = -r To r
x2 = x * x
For y = -r To r
y2 = y * y
If x2 + y2 <= r2 Then
v2 = Sqr(r2 - x2 - y2)
l = Sqr(x2 + y2 + v2 * v2)
v0 = x / l
v1 = y / l
v2 = v2 / l
d = nlx * v0 + nly * v1 + nlz * v2
'i = mxp * (iff(d < 0, -d ^ k, 0) + amb)
If d < 0 Then i = mxp * (-d ^ k) + amp Else i = amp
PSet (x + xc, y + yc), _RGB32(Int(i), Int(i), Int(i))
End If
Next y
Next x
_Display
Loop
The mouse is light source, so move it around...
More things to play with!!!
ZXDunny's BAM program (ULTIMATE Gradient Ball):
Posts: 671
Threads: 143
Joined: Apr 2022
Reputation:
56
07-13-2023, 04:15 PM
(This post was last modified: 07-13-2023, 04:32 PM by James D Jarvis.)
playing about with this last night, no claims of "improvement". A wee bit of interaction with key presses.
Code: (Select All) 'v bubbles
'$dynamic
Screen _NewImage(800, 600, 32)
Dim Shared Points: Points = 50
Dim Shared PointX(Points), PointY(Points), PointR(Points), PointG(Points), PointB(Points)
Randomize Timer
For p = 1 To Points
PointX(p) = Rnd * _Width
PointY(p) = Rnd * _Height
PointR(p) = 50 + Rnd * 60
PointG(p) = 60 + Rnd * 80
PointB(p) = 70 + Rnd * 100
Next
wr = 4 'wiggle ratio
Do
_Limit 50000 'experiment with the value that works for you and keeps your computer from metling
For p = 1 To Points
PointX(p) = PointX(p) + Rnd * wr - Rnd * wr
PointY(p) = PointY(p) + Rnd * wr - Rnd * wr
PointR(p) = PointR(p) + Rnd * 3 - Rnd * 3
PointG(p) = PointG(p) + Rnd * 3 - Rnd * 3
PointB(p) = PointB(p) + Rnd * 3 - Rnd * 3
Next
For y = 0 To _Height Step 4 'skipping points of calcualtion to speed things along
For x = 0 To _Width Step 4
min = Sqr((x - PointX(1)) ^ 2 + (y - PointY(1)) ^ 2)
closest = 1
For p = Points To 2 Step -1
dis = Sqr((x - PointX(p)) ^ 2 + (y - PointY(p)) ^ 2)
If dis < min Then
min = dis
closest = p
End If
Next
'circlefill? Yes circle fill because it's quicker in getting that screen filled
CircleFill x, y, 3, _RGB(PointR(closest) - min, PointG(closest) - min, PointB(closest) - min)
Next
Next
kk$ = InKey$
Select Case (kk$)
Case "C", "c" 'change the pattern
For p = 1 To Points
PointX(p) = Rnd * _Width
PointY(p) = Rnd * _Height
PointR(p) = 50 + Rnd * 60
PointG(p) = 60 + Rnd * 80
PointB(p) = 70 + Rnd * 100
Next
Case "<", "," 'slower wiggle
wr = wr - .5
If wr < 0 Then wr = 0
Case ">", "." 'quicker wiggle
wr = wr + .5
Case "R" 'more red
For p = 1 To Points
PointR(p) = PointR(p) + (1 + Rnd * 6)
Next
Case "r" 'less red
For p = 1 To Points
PointR(p) = PointR(p) - (1 + Rnd * 6)
Next 'more green
Case "G"
For p = 1 To Points
PointG(p) = PointG(p) + (1 + Rnd * 6)
Next
Case "g" 'less green
For p = 1 To Points
PointG(p) = PointG(p) - (1 + Rnd * 6)
Next
Case "B" 'more blue
For p = 1 To Points
PointB(p) = PointB(p) + (1 + Rnd * 6)
Next
Case "b" 'less blue
For p = 1 To Points
PointB(p) = PointB(p) - (1 + Rnd * 6)
Next
Case "M" 'more points
Points = Points + 1
ReDim _Preserve PointX(Points), PointY(Points), PointR(Points), PointG(Points), PointB(Points)
PointX(Points) = Rnd * _Width
PointY(Points) = Rnd * _Height
PointR(Points) = 50 + Rnd * 60
PointG(Points) = 60 + Rnd * 80
PointB(Points) = 70 + Rnd * 100
Case "m" 'less points
If Points > 20 Then
Points = Points - 1
ReDim _Preserve PointX(Points), PointY(Points), PointR(Points), PointG(Points), PointB(Points)
End If
End Select
_Display
Loop Until kk$ = Chr$(27)
Sub CircleFill (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
' CX = center x coordinate
' CY = center y coordinate
' R = radius
' C = fill color
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R)
RadiusError = -Radius
X = Radius
Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, 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), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
Posts: 475
Threads: 88
Joined: Apr 2022
Reputation:
71
07-13-2023, 05:23 PM
(This post was last modified: 07-13-2023, 09:33 PM by Dav.)
I like it, James! Neat wiggle motion. Seems to update quickly too. I'll have to study that a while. Thanks for sharing.
I was playing around this morning with adding a plasms texture to the gradient ball. Here's a growing plasma ball. Had to use the STEP/LINE trick to make it faster - PSETing it was too slow on my laptop.
- Dav
Code: (Select All)
'Growing Plasma ball
'by Dav, JULY/2023
SCREEN _NEWIMAGE(1000, 650, 32)
x = _WIDTH / 2 'x place of ball
y = _HEIGHT / 2 ' y place of ball
size = 45 'ball start size
DO
t = TIMER
FOR y2 = y - size TO y + size STEP 3
FOR x2 = x - size TO x + size STEP 3
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 * 75)
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
LINE (x2, y2)-STEP(2, 2), _RGBA(clr * r - noise, clr * g - noise, clr * b - noise, 5 + RND * 10), BF
END IF
NEXT
t = t + .01
NEXT
IF size < y THEN size = size + .5
_LIMIT 60
_DISPLAY
LOOP
EDIT: A little variation - ball grows & shrinks randomly, leaving gassy like edges. Looks less like a ball.
Code: (Select All)
SCREEN _NEWIMAGE(1000, 650, 32)
x = _WIDTH / 2 'x place of ball
y = _HEIGHT / 2 ' y place of ball
size = 45 'ball start size
DO
t = TIMER
FOR y2 = y - size TO y + size STEP 3
FOR x2 = x - size TO x + size STEP 3
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 * 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
LINE (x2, y2)-STEP(2, 2), _RGBA(clr * r - noise, clr * g - noise, clr * b - noise, 5 + RND * 10), BF
END IF
NEXT
t = t + .01
NEXT
LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA(0, 0, 0, 10), BF
IF INT(RND * 2) = 1 THEN size = size + (RND * 15) ELSE size = size - (RND * 15)
IF size < y THEN size = size + .5
IF size > (y * 1.5) THEN size = y
IF size < 15 THEN size = 15
_LIMIT 60
_DISPLAY
LOOP
|
