Morphing Stained Glass

[bplus]

Stained Glass Blowing into Dreamland:

Code: (Select All)

_Title "Moving Voronoi Diagram" ' b+ mod Andy Amaya 2024-09-13

'=====================================================================
' Changes number of points and screen size here
'=====================================================================
Const pnt = 100
Const px = 800
Const py = 600

Dim As Long i, x, y, adjct, sy, ly

'=====================================================================
Screen _NewImage(px, py, 32)
_ScreenMove 250, 60
Randomize Timer

Dim Shared As Long pax(pnt), pay(pnt), indx(px, py), dx(pnt), dy(pnt)
Dim Shared As Long dSqr(px, py), counter
Dim Shared As _Unsigned Long col(pnt)

For i = 1 To pnt
    pax(i) = Int(Rnd * px)
    pay(i) = Int(Rnd * py)
    col(i) = _RGB32(Rnd * 180, (Rnd < .5) * -255, Rnd * 150, Rnd * 255)
    dx(i) = Int(Rnd * 15) + 3
    dy(i) = Int(Rnd * 11) - 5
Next
While _KeyDown(27) = 0
    For x = 0 To px - 1
        For y = 0 To py - 1
            dSqr(x, y) = (pax(1) - x) * (pax(1) - x) + (pay(1) - y) * (pay(1) - y)
            indx(x, y) = 1
        Next
    Next

    For i = 2 To pnt
        ly = py - 1
        For x = pax(i) To 0 Step -1
            If (scan(i, x, ly)) = 0 Then Exit For
        Next x
        For x = pax(i) + 1 To px - 1
            If (scan(i, x, ly)) = 0 Then Exit For
        Next
    Next

    For x = 0 To px - 1
        For y = 0 To py - 1
            sy = y
            adjct = indx(x, y)
            For y = y + 1 To py
                If indx(x, y) <> adjct Then y = y - 1: Exit For
            Next
            Line (x, sy)-(x, y + 1), col(adjct), BF ' bplus added BF
        Next
    Next
    For i = 1 To pnt
        pax(i) = pax(i) + dx(i)
        If pax(i) < 0 Then pax(i) = 0: dx(i) = -dx(i)
        If pax(i) > px - 1 Then newPnt i
        pay(i) = pay(i) + dy(i)
        If pay(i) < 0 Then pay(i) = 0: dy(i) = -dy(i)
        If pay(i) > py - 1 Then pay(i) = py - 1: dy(i) = -dy(i)
    Next
Wend

Sub newPnt (i)
    Dim a As Long
    counter = counter + 1
    pax(i) = 0
    pay(i) = Int(Rnd * py)
    a = Rnd * (255 - counter / 2)
    If a < 4 Then a = 4 ' fix
    col(i) = _RGB32(Rnd * 180, (Rnd < .5) * -255, Rnd * 150, a)
    dx(i) = Int(Rnd * 15) + 3
    dy(i) = Int(Rnd * 11) - 5
End Sub

Function scan (site As Integer, x As Integer, ly As Integer)
    Dim As Integer ty
    Dim As Long delt2, dsq
    delt2 = (pax(site) - x) * (pax(site) - x)
    For ty = 0 To ly
        dsq = (pay(site) - ty) * (pay(site) - ty) + delt2
        If dsq <= dSqr(x, ty) Then
            dSqr(x, ty) = dsq
            indx(x, ty) = site
            scan = 1
        End If
    Next
End Function

Goodnight Gentlemen

Dang one more fix!