September 19, 2021, 10:05:26

Author Topic: A new wrinkle with Voronoi (QB64)  (Read 245 times)

bplus

• Full Member
• Posts: 221
A new wrinkle with Voronoi (QB64)
« on: May 10, 2021, 07:35:07 »
Shading gives us pseudo 3D
Code: [Select]
`_Title "Shading Voronoi Demo" 'b+ 2019-12-11  shading 2021-05-10Const xymax = 700, nPoints = 50Type pType    x As Single    y As Single    c As _Unsigned LongEnd TypeScreen _NewImage(xymax, xymax, 32)_ScreenMove 300, 20Randomize TimerDim pts(1 To nPoints) As pTypeFor 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)NextFor i = 1 To nPoints    Circle (pts(i).x, pts(i).y), 5, pts(i).cNext_Delay .5For 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)    NextNextSleepSub cAnalysis (c As _Unsigned Long, outRed, outGrn, outBlu, outAlp)    outRed = _Red32(c): outGrn = _Green32(c): outBlu = _Blue32(c): outAlp = _Alpha32(c)End SubFunction 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`

SimplePortal 2.3.6 © 2008-2014, SimplePortal