Posts: 3,885
Threads: 174
Joined: Apr 2022
Reputation:
201
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
b = b + ...
Posts: 713
Threads: 117
Joined: Apr 2022
Reputation:
104
Niiice, @bplus! I will have some fun tweaking this one! Here's a screenshot with nPoints = 100.
- Dav
Posts: 713
Threads: 117
Joined: Apr 2022
Reputation:
104
@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
Posts: 3,885
Threads: 174
Joined: Apr 2022
Reputation:
201
07-12-2023, 02:11 PM
(This post was last modified: 07-12-2023, 02:14 PM by bplus.)
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
b = b + ...
Posts: 713
Threads: 117
Joined: Apr 2022
Reputation:
104
_HYPOT huh? Neat. I shouldn't have stopped reading the keyword of the day thread. 
- Dav
Posts: 3,885
Threads: 174
Joined: Apr 2022
Reputation:
201
(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!!!
b = b + ...
Posts: 1,277
Threads: 120
Joined: Apr 2022
Reputation:
100
(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.
- 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
This code is freaking me out. I played around with optimizing it a bit.
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
New to QB64pe? Visit the QB64 tutorial to get started.
QB64 Tutorial
Posts: 3,885
Threads: 174
Joined: Apr 2022
Reputation:
201
07-12-2023, 03:54 PM
(This post was last modified: 07-12-2023, 03:59 PM by bplus.)
Yeah forgot about For Loops being slowest!
But UDT's for particles are slower than simple arrays.
b = b + ...
Posts: 713
Threads: 117
Joined: Apr 2022
Reputation:
104
07-12-2023, 04:32 PM
(This post was last modified: 07-12-2023, 04:34 PM by Dav.)
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
Posts: 1,277
Threads: 120
Joined: Apr 2022
Reputation:
100
(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. BTW, I can't tell you how many times your tutorials have helped me re-learn something. Thanks x1000.
- 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.
New to QB64pe? Visit the QB64 tutorial to get started.
QB64 Tutorial
|
