Voronoi Spiral gem

[ScriptBasic]

Good News!

I was able to get the JavaScript extension module working with Script BASIC.

[B+]

Well that is good news!

Too bad this forum does not have an announcement section for the community.

oh wait... 

[Peter]

My port to BaCon runs in less than a second when using GCC compiler optimizations.

Code: [Select]

'Voronoi spiral gem.sdlbas
'translated from SmallBASIC 2016-08-19 MGA/B+
'translated to BaCon, sticking to the original code as much as possible, 12 sept 2016 - PvE.

DEF FN rgb(r, g, b) = r<<16 | g<<8 | b
DEF FN dergb(c, v) = IIF(c = 0, (v>>16)&255, IIF(c = 1, (v>>8)&255, v&255))

INCLUDE canvas.bac

OPTION VARTYPE FLOATING

gem = 700

tt = TIMER

WINDOW("Voronoi Spiral Gem", gem, gem)

points = 36 * 13 :' 10 degrees needs 36 points for 1 circle
cy = gem/2
ga = 10

DECLARE x, y, kl TYPE int ARRAY points
DECLARE r, g, b TYPE int

Scale = 0.7

FOR n = 0 TO points
    x[n] = cy + Scale * n * COS(RAD(n * ga))
    y[n] = cy + Scale * n * SIN(RAD(n * ga))

    IF x[n] < gem AND x[n] > 0 AND y[n] < gem AND y[n] > 0 THEN
        g = 127 - ABS(cy - x[n]) * 127 / cy  + 127 - ABS(cy - y[n]) * 127 / cy
    ELSE
        g = 0
    END IF

    IF x[n] < gem AND x[n] > 0 THEN : r = 255 - x[n] * 255 / gem : ELSE : r = 0 : END IF
    IF y[n] < gem AND y[n] > 0 THEN : b = y[n] * 255 / gem : ELSE : b = 0 : END IF

    kl[n] = rgb(r, g, b)

    INK (r, g, b, 255)

    CIRCLE(x[n], y[n], 2, 2, TRUE)
NEXT

FOR xx = 0 TO gem
    FOR yy = 0 TO gem
        d = gem * gem + 1
        FOR i = 0 TO points
            a = x[i] - xx : b = y[i] - yy
            q = a * a + b * b
            IF q < d THEN : d = q : kkl = i : ENDIF
        NEXT
        INK(dergb(0, kl[kkl]), dergb(1, kl[kkl]), dergb(2, kl[kkl]), 255)
        PIXEL(xx, yy)
    NEXT
NEXT

SYNC : ' Optional

PRINT "Time: ", TIMER-tt, " msecs."
WAITKEY


[Mike Lobanovsky]

Thanks Peter,

That's remarkable but:

• your CPU is terribly fast;
• GCC w/ -On will clearly optimize the yy loop by constant propagation of gem * gem + 1  to the outside of all loops (that's a constant, after all) even without your explicit intervention; and
• judging by SYNC you aren't PSet'ing/PIXEL'ing to the memory DC but, in order to eliminate SetPixelV-like function call overhead in each iteration, are rather writing color values into an own 32-bit pixel color buffer somewhere in canvas.inc that you blit, or assign by some other *nix specific technique, later on in one swoop to the screen window through SYNC'ing. That would be a slightly faster solution (I'd say, the fastest) also feasible under Windows but with a little more pain for setting up the gfx window compatible with your 32-bit color canvas. My memory DC is 24 bits -- the easiest to set up.

[Peter]

Hi Mike,

Yes, I am aware of that. For the canvas, it simply uses a 2D OpenGL canvas with double buffering, based on one of the available backends in my system (but this is hidden from the user). The SYNC simply swaps the buffer to the display.

Regards
Peter

[B+]

I know this topic is old but someone might like to see FreeBASIC example (I have no idea if this optimum FB can do.):

Code: [Select]

'Voronoi spiral gem.bas for FreeBASIC 2017-03-03
'from SmallBASIC 2016-08-19 MGA/B+ replace vars with number when possible

Const As Double PI = ACos(-1)
Const As Double RAD = PI / 180

'Set screen size here
screenres 700, 700, 32, 2
WindowTitle "Voronoi Spiral Gem  -  Press any to exit"
Dim As Double t = timer
'gem = 700
Dim As Integer n, r, g, b
Dim As Integer points = 36 * 13 ' 10 degrees needs 36 points for 1 circle
'cy = 350
'ga = 10
dim As Integer x(points), y(points)
Dim As UInteger kl(points)
'scale = .7
for n = 0 to points
   x(n) = 350 + .7 * n * cos(RAD * (n * 10))
   y(n) = 350 + .7 * n * sin(RAD * (n * 10))
   if x(n) < 700 and x(n) > 0 and y(n) < 700 and y(n) > 0 then
     g = 127 - abs(350 - x(n)) * 127 \ 350  + 127 - abs(350 - y(n)) * 127 \ 350
   else
     g = 0
   End if
   if x(n) < 700 and x(n) > 0 then r = 255 - x(n) * 255 \ 700 else r = 0
   if y(n) < 700 and y(n) > 0 then b = y(n) * 255 \ 700 else b = 0
   kl(n) = rgb(r, g, b)
   Circle(x(n), y(n)), 1, rgb(r, g, b), , , , F
Next
'pause
Dim As Integer xx, yy, d, i, kkl, q
For xx = 0 to 700
   for yy = 0 to 700
      d = 700 * 700 + 1
      for i = 0 to points
         q = (x(i) - xx) * (x(i) - xx) + (y(i) - yy) * (y(i) - yy)
         if q < d then d = q: kkl = i
      next
      pset (xx, yy), kl(kkl)
   next
Next
Locate 2, 2
Print "Seconds = "; (((timer - t) * 100) \ 1) / 100
Sleep

Around 10 secs or less

PS, testing download:

Code: [Select]

Print "Seconds = "; (((timer - t) * 100) \ 1) / 100Dang it! FB is throwing in crap when dividing an integer by 100, don't always get just 2 decimals.