A new wrinkle with Voronoi (QB64)

Started by bplus, May 10, 2021, 07:35:07

Previous topic - Next topic
Print
Go Down Pages1
User actions

bplus

May 10, 2021, 07:35:07
Shading gives us pseudo 3D
Code Select

_Title "Shading Voronoi Demo" 'b+ 2019-12-11  shading 2021-05-10
Const xymax = 700, nPoints = 50
Type pType
    x As Single
    y As Single
    c As _Unsigned Long
End Type
Screen _NewImage(xymax, xymax, 32)
_ScreenMove 300, 20
Randomize Timer
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
_Delay .5
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, &HFF000000, minD / 85)
    Next
Next
Sleep

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





1 person likes this
Print
Go Up Pages1
User actions