Improved my small Gradient Ball drawing SUB

[bplus]

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

[Dav]

Niiice, @bplus!  I will have some fun tweaking this one!  Here's a screenshot with nPoints = 100.

- Dav

   

[Dav]

@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
 

[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

[Dav]

_HYPOT huh?  Neat.  I shouldn't have stopped reading the keyword of the day thread.  

- Dav

[bplus]

_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!!!

[TerryRitchie]

@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

[bplus]

Yeah forgot about For Loops being slowest!

But UDT's for particles are slower than simple arrays.

[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

[TerryRitchie]

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.