+- 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: Improved my small Gradient Ball drawing SUB (/showthread.php?tid=1838)
RE: Improved my small Gradient Ball drawing SUB - bplus - 07-12-2023
A Voronoi Variation:
Code: (Select All)
_Title "Shading Voronoi Demo 2" 'b+ 2019-12-11 shading 2021-05-10
' 2022-01-30 mod with random dark shades run continuously
' 2023-07-11 Demo 2 mod with changing radii and holding shading to black
Const xymax = 700, nPoints = 20
Type pType
x As Single
y As Single
c As _Unsigned Long
End Type
Screen _NewImage(xymax, xymax, 32)
_ScreenMove 300, 20
Randomize Timer
restart:
Dim pts(1 To nPoints) As pType
For i = 1 To nPoints
pts(i).x = xymax * Rnd
pts(i).y = xymax * Rnd
pts(i).c = _RGB32(155 * Rnd + 100, -(Rnd < .5) * 255 * Rnd, -(Rnd < .5) * 255 * Rnd)
Next
For i = 1 To nPoints
Circle (pts(i).x, pts(i).y), 5, pts(i).c
Next
Dim RC As _Unsigned Long
div = 20
Do
'RC = _RGB32(Rnd * 60, Rnd * 60, Rnd * 60)
RC = &HFF000000
For y = 0 To xymax
For x = 0 To xymax
minD = 49000
For p = 1 To nPoints
d = ((pts(p).x - x) ^ 2 + (pts(p).y - y) ^ 2) ^ .5
If d < minD Then minD = d: saveP = p
Next
PSet (x, y), Ink~&(pts(saveP).c, RC, minD / div)
Next
Next
_Delay 2
div = div + 20
If div > 120 Then div = 20: GoTo restart
Loop
Sub cAnalysis (c As _Unsigned Long, outRed, outGrn, outBlu, outAlp)
outRed = _Red32(c): outGrn = _Green32(c): outBlu = _Blue32(c): outAlp = _Alpha32(c)
End Sub
Function Ink~& (c1 As _Unsigned Long, c2 As _Unsigned Long, fr##)
Dim R1, G1, B1, A1, R2, G2, B2, A2
cAnalysis c1, R1, G1, B1, A1
cAnalysis c2, R2, G2, B2, A2
Ink~& = _RGB32(R1 + (R2 - R1) * fr##, G1 + (G2 - G1) * fr##, B1 + (B2 - B1) * fr##, A1 + (A2 - A1) * fr##)
End Function
RE: Improved my small Gradient Ball drawing SUB - Dav - 07-12-2023
Niiice, @bplus! I will have some fun tweaking this one! Here's a screenshot with nPoints = 100.
- Dav
RE: Improved my small Gradient Ball drawing SUB - Dav - 07-12-2023
@bplus you inspired me. Had to give a Shaded Voronoi a try too. Studied a few sources online, ended up with this simple version.
- Dav
Code: (Select All)
SCREEN _NEWIMAGE(1000, 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) = RND * 255
PointG(p) = RND * 255
PointB(p) = RND * 255
NEXT
FOR x = 0 TO _WIDTH
FOR y = 0 TO _HEIGHT
min = SQR((x - PointX(1)) ^ 2 + (y - PointY(1)) ^ 2)
closest = 1
FOR p = 2 TO Points
dis = SQR((x - PointX(p)) ^ 2 + (y - PointY(p)) ^ 2)
IF dis < min THEN
min = dis: closest = p
END IF
NEXT
PSET (x, y), _RGB(PointR(closest) - min, PointG(closest) - min, PointB(closest) - min)
NEXT
NEXT
SLEEP
RE: Improved my small Gradient Ball drawing SUB - bplus - 07-12-2023
Hi @Dav that's is interesting alternate calculation.
We could shave some time:
Code: (Select All)
Screen _NewImage(1000, 600, 32)
DefLng A-Z
Randomize Timer
Do
Points = Rnd * 70 + 10
ReDim PointX(Points), PointY(Points), PointR(Points), PointG(Points), PointB(Points)
For p = 1 To Points
PointX(p) = Rnd * _Width
PointY(p) = Rnd * _Height
PointR(p) = Rnd * 255
PointG(p) = Rnd * 255
PointB(p) = Rnd * 255
Next
For x = 0 To _Width - 1
For y = 0 To _Height - 1
min = _Hypot(x - PointX(1), y - PointY(1))
closest = 1
For p = 1 To Points
dis = _Hypot(x - PointX(p), y - PointY(p))
If dis < min Then
min = dis: closest = p
End If
Next
PSet (x, y), _RGB(PointR(closest) - min, PointG(closest) - min, PointB(closest) - min)
Next
Next
_Display
_Limit 5
Loop Until _KeyDown(27)
Sleep
RE: Improved my small Gradient Ball drawing SUB - Dav - 07-12-2023
_HYPOT huh? Neat. I shouldn't have stopped reading the keyword of the day thread.
- Dav
RE: Improved my small Gradient Ball drawing SUB - bplus - 07-12-2023
(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!!!
RE: Improved my small Gradient Ball drawing SUB - TerryRitchie - 07-12-2023
(07-12-2023, 12:09 PM)Dav Wrote: @bplus you inspired me. Had to give a Shaded Voronoi a try too. Studied a few sources online, ended up with this simple version.This code is freaking me out. I played around with optimizing it a bit.
- Dav
Code: (Select All)
SCREEN _NEWIMAGE(1000, 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) = RND * 255
PointG(p) = RND * 255
PointB(p) = RND * 255
NEXT
FOR x = 0 TO _WIDTH
FOR y = 0 TO _HEIGHT
min = SQR((x - PointX(1)) ^ 2 + (y - PointY(1)) ^ 2)
closest = 1
FOR p = 2 TO Points
dis = SQR((x - PointX(p)) ^ 2 + (y - PointY(p)) ^ 2)
IF dis < min THEN
min = dis: closest = p
END IF
NEXT
PSET (x, y), _RGB(PointR(closest) - min, PointG(closest) - min, PointB(closest) - min)
NEXT
NEXT
SLEEP
Code: (Select All)
CONST POINTS = 50
TYPE TYPE_POINT
x AS INTEGER
y AS INTEGER
r AS INTEGER
g AS INTEGER
b AS INTEGER
END TYPE
DIM p(POINTS) AS TYPE_POINT
DIM AS INTEGER p, x, y, closest
DIM AS SINGLE min, max, dis
RANDOMIZE TIMER
SCREEN _NEWIMAGE(1000, 600, 32)
max = _HYPOT(_WIDTH, _HEIGHT) ' the maximum distance possible with given screen size
p = 0
DO
p = p + 1
p(p).x = RND * _WIDTH
p(p).y = RND * _HEIGHT
p(p).r = RND * 255
p(p).g = RND * 255
p(p).b = RND * 255
LOOP UNTIL p = POINTS
x = -1
DO
x = x + 1
y = -1
DO
y = y + 1
min = max ' reset to maximum possible distance
p = 0
DO
p = p + 1
dis = _HYPOT(x - p(p).x, y - p(p).y)
IF dis < min THEN
min = dis
closest = p
END IF
LOOP UNTIL p = POINTS
PSET (x, y), _RGB(p(closest).r - min, p(closest).g - min, p(closest).b - min)
LOOP UNTIL y = _HEIGHT
LOOP UNTIL x = _WIDTH
SLEEP
RE: Improved my small Gradient Ball drawing SUB - bplus - 07-12-2023
Yeah forgot about For Loops being slowest!
But UDT's for particles are slower than simple arrays.
RE: Improved my small Gradient Ball drawing SUB - Dav - 07-12-2023
Nice mousey ball shader code by ZXDunny Really fast too. I tried doing that last night but mine worked too slow.
Hey Terry! Sorry for my freaky code.
BTW, I can't tell you how many times your tutorials have helped me re-learn something. Thanks x1000.- Dav
RE: Improved my small Gradient Ball drawing SUB - TerryRitchie - 07-12-2023
(07-12-2023, 04:32 PM)Dav Wrote: Nice mousey ball shader code by ZXDunny Really fast too. I tried doing that last night but mine worked too slow.
Hey Terry! Sorry for my freaky code.
- Dav
It freaks me out not because of your code, but because of what is does with so little code. I happen to be working on a shading routine for a custom laser beam for games (think BattleStar Galactica Viper type lasers) and I never thought to use the approach as seen in your code. I'm investigating that distance vectoring method now to see if it will work for my code.