Voronoi Spiral gem

[B+]

Code: [Select]

'Voronoi spiral gem.sdlbas
'translated from SmallBASIC 2016-08-19 MGA/B+

gem = 700
setdisplay(gem, gem, 32, 1)
setcaption("Voronoi Spiral Gem")
points = 36 * 13 ' 10 degrees needs 36 points for 1 circle
pi = acos(-1)
rad = pi / 180
cy = gem/2
ga = 10
dim x[points],  y[points], kl[points]
scale = .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(rgb(r, g, b))
   fillcircle(x[n], y[n], 2)
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 : end if
      next
  ink(kl[kkl])
      dot(xx, yy)
   next
next
waitkey(27)



[Mike Lobanovsky]

How long does it take SDL Basic to run through those triply nested For/Dot/Next loops in real time?

[B+]

SmallBASIC took 530 seconds in one test (showpage).

SdlBasic took 560 seconds (autoback(-1000) and screenswap).

[Mike Lobanovsky]

Thanks B+!

Nine minutes, hehe... It takes FBSL BASIC ~3.5 minutes on my 3.2GHz PC to loop through this mess in a 700*700 px window. How fast is your PC, just for comparison purposes?

[B+]

My laptop travels approximately 0 MPH in relation to earth's rotation (when it is being used). 

It's processor is AMD E-300 APU with Radeon (tm) HD graphics 1.3 GHz

Mike have you compared the numbers in our screen shots? Yours 500 x 500 but 100 KB, mine 700 x 700 and 53 KB.

[Mike Lobanovsky]

Thanks again, Mark!

My laptop travels approximately 0 MPH in relation to earth's rotation (when it is being used). 

Don't you ever walk it out to, say, your kitchen to have a beer or a coffee?

It's processor is AMD E-300 APU with Radeon (tm) HD graphics 1.3 GHz

The graphics accelerator wouldn't matter much for pure GDI drawing we're dealing with here. PSet'ing (Dot'ing in your notation) proper takes less than half a second on my computer. The rest goes to loop frame code and arith.

Mike have you compared the numbers in our screen shots? Yours 500 x 500 but 100 KB, mine 700 x 700 and 53 KB.

That's a good question. See my next message because the forum doesn't allow me more than two attachments per post.

Here's my code with all the appropriate timing instruments included, and the precompiled executable is attached in the zip below for you to try out on your PC. Once drawn, the window canvas stays persistent and allows you to resize the drawing scaling it up or down smoothly as you like. My typical output can also be seen in the screenshot below (the file can't be made any smaller without compromising the quality; that's the absolute minimum).

Code: [Select]

'VoronoiGem.fbs for FBSL v3.5 2016-08-22 [ML<=MGA/B+] :)
'Voronoi spiral gem.sdlbas
'translated from SmallBASIC 2016-08-19 MGA/B+

#AppType Console
#Option Implicit

#Include <Include\Windows.inc>
#Define IDC_BUTTON 1001

gem = 700
points = 36 * 13 ' 10 degrees needs 36 points for 1 circle
fi = ACos(-1)
rad = fi / 180
cy = gem / 2
ga = 10
scale = .7

Dim %x[points], %y[points], %kl[points] ' strong typing for C jitter access

memdc = Voronoi()[0]
oldbmp = Voronoi[1]

Let(width, height) = gem
button = FbslControl("button", ME, "Click me for JIT...", IDC_BUTTON, width - 120, height - 70, 100, 40, WS_CHILD BOr WS_VISIBLE, 0)

Window(width, height)
FbslSetText(ME, "Voronoi Spiral Gem")
Center(ME)
Show(ME)

Begin Events
  Select Case CBMSG
    Case WM_COMMAND
      If CBWPARAM = IDCANCEL Then
        PostMessage(ME, WM_CLOSE, 0, 0)
        Return 0
      ElseIf CBWPARAM = IDC_BUTTON Then
        PitchBlack()
        DoSameInJIT()
        Return 0
      End If
    Case WM_SIZE
      width = LoWord(CBLPARAM)
      height = HiWord(CBLPARAM)
      Resize(button, width - 120, height - 70, 100, 40)
      InvalidateRect(ME, NULL, FALSE)
    Case WM_ERASEBKGND
      Return 1
    Case WM_PAINT
      Dim $ps * 64
      hdc = BeginPaint(ME, ps)
      SetStretchBltMode(hdc, HALFTONE)
      StretchBlt(hdc, 0, 0, width, height, memdc, 0, 0, gem, gem, SRCCOPY)
      EndPaint(ME, ps)
      Return 0
    Case WM_CLOSE
      DeleteObject(SelectObject(memdc, oldbmp))
      DeleteDC(memdc)
  End Select
End Events

Function Voronoi() ' returns 2-element array
  hdc = GetDC(ME)
  Static mdc = CreateCompatibleDC(hdc)
  Static bmp = CreateCompatibleBitmap(hdc, gem, gem)
  Static obmp = SelectObject(mdc, bmp)
  ReleaseDC(ME, hdc)
 
  gtc = GetTickCount()
  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 AndAlso x[n] > 0 AndAlso y[n] < gem AndAlso 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 AndAlso x[n] > 0 Then: r = 255 - x[n] * 255 / gem: Else: r = 0: End If
    If y[n] < gem AndAlso y[n] > 0 Then: b = y[n] * 255 / gem: Else: b = 0: End If
    kl[n] = RGB(r, g, b)
  Next
  colors = GetTickCount() - gtc
 
  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: End If
      Next
      PSet(mdc, xx, yy, kl[kkl])
    Next
    ? xx, "/700"
  Next
  ? colors, " milliseconds to calc colors" // <~10 ticks @3.2GHz
  ? ((GetTickCount() - gtc) / 1000) / 60, " minutes BASIC time" // ~3.5 min @3.2GHz
 
  Return {mdc, obmp}
End Function

// Dynamic C jitter
DynC DoSameInJIT(%xp = @x, %yp = @y, %klp = @kl, %gm = gem, %pts = points, %mdc = memdc, %hwnd = ME)
  int __attribute__((stdcall)) GetTickCount();
  void __attribute__((stdcall)) SetPixelV();
  void __attribute__((stdcall)) InvalidateRect();
 
  void main(int x[], int y[], int kl[], int gem, int points, int memdc, int hwnd)
  {
    int xx, yy, i, a, b, d, q, kkl;
   
    int gtc = GetTickCount();
    for (xx = 0; xx <= gem; xx++) {
      for (yy = 0; yy <= gem; yy++) {
        d = gem * gem + 1;
        for (i = 0; i <= points; i++) {
          a = x[i] - xx; b = y[i] - yy;
          q = a* a + b* b;
          if (q < d) {d = q; kkl = i;}
        }
        SetPixelV(memdc, xx, yy, kl[kkl]); // PSet analog
      }
    }
    printf("%.2f seconds C time\n", (double)(GetTickCount() - gtc) / 1000); // ~1.25 sec @3.2GHz)
    InvalidateRect(hwnd, 0, 0);
  }
End DynC

// Utilities
Sub Window(w, h)
  Dim %rc[3]
  SetRect(@rc, 50, 50, 50 + w, 50 + h)
  AdjustWindowRectEx(@rc, &HCF0000, FALSE, &H100)
  Resize(ME, 0, 0, rc[2] - rc[0], rc[3] - rc[1])
End Sub

Sub PitchBlack(w = gem, h = gem)
  Line(memdc, 0, 0, w, h, 0, TRUE, TRUE)
  Refresh(ME)
End Sub

[Mike Lobanovsky]

Mike have you compared the numbers in our screen shots? Yours 500 x 500 but 100 KB, mine 700 x 700 and 53 KB.

PNGs can be saved in various BPP (bits per pixel) color formats and with at least 9 different levels of compression depth. On the other hand, the real depth (i.e. smallest size) is largely dependent on the color content of the image. Our client area content is the same but your window's non-client frame area (a.k.a. "decoration" in linuxoid lingo) is miserable android-ish looking Windows 10 (or 8.1 at best) while mine is gorgeous colorful gradient XP.

That's what makes the difference. Using very special PNG cleaners and recompressors from my magic hat ( ), your file can actually be made yet almost twice smaller (~28.8KB) regardless of its 32 bpp format while mine of exactly the same image size can't be made any smaller than ~95KB even in 24 bits per pixel.

See both files attached below.

[B+]

Hi Mike,

Thanks for the download attachment. I was wondering if you would employ C or assembler and compile to speed things up.

What you call "strange arithmetics" I would call terrible, which is why I edited them out (apparently not quick enough). 

[Mike Lobanovsky]

I was wondering if you would employ C or assembler and compile to speed things up.

That's exactly why FBSL v4.0 whenever it matures to something worth speaking of will have its BASIC JIT-compiled, rather than interpreted, to match the speeds of its two other companions.

What you call "strange arithmetics" I would call terrible, which is why I edited them out ...

No problem, I've just cut out my respective comments too.

[Mopz]

naalaa doesn't have support for filled circles, so i'm doing those manually. Believe it took 30 seconds or something when i tried it at home.

Code: [Select]

gem = 700
gems = gem - 1

set window 16, 16, gem, gem
set redraw off

points = 36*13
cy = gem/2
ga# = 10.0

x[points]
y[points]
kl[points]
s# = 0.7
wln "Working, please wait ..."
t = time()
ps = points - 1
for n = 0 to ps
   x[n] = cy + int(s*float(n)*cos(float(n)*ga))
   y[n] = cy + int(s*float(n)*sin(float(n)*ga))
   if x[n] < gem and x[n] > 0 and y[n] < gem and y[n] > 0
     g = 127 - abs(cy - x[n])*127 / cy + 127 - abs(cy - y[n]) * 127 / cy
   else
     g = 0
   endif
   if x[n] < gem and x[n] > 0; r = 255 - x[n]*255/gem; else; r = 0; endif
   if y[n] < gem and y[n] > 0; b = y[n]*255 / gem; else; b = 0; endif
   kl[n] = (r SHL 16) + (g SHL 8) + b
   set colori kl[n]
   _DrawFilledCircle int(x[n]), int(y[n]), 2
next

for xx = 0 to gem
for yy = 0 to gem
d = gem*gem + 1
for i = 0 to points - 1
a = x[i] - xx; b = y[i] - yy
q = a*a + b*b
if q < d; d = q; kkl = i; endif
next
set colori kl[kkl]
set pixel xx, yy
next
next

set color 255, 255, 255
set caret 0, 0
wln "Time: ", (time() - t)/1000
redraw
wait keydown

procedure DrawCircle(x0, y0, radius)
x = radius
y = 0
err = 0
while x >= y
draw pixel x0 + x, y0 + y
draw pixel x0 - x, y0 + y
draw pixel x0 + y, y0 + x
draw pixel x0 - y, y0 + x
draw pixel x0 - x, y0 - y
draw pixel x0 + x, y0 - y
draw pixel x0 - y, y0 - x
draw pixel x0 + y, y0 - x
y = y + 1
err = err + 1 + 2*y
if 2*(err - x) + 1 > 0
x = x - 1
err = err + 1 - 2*x
endif
wend
endproc

procedure DrawFilledCircle(x0, y0, radius)
x = radius
y = 0
err = 0
while x >= y
x2 = x*2; y2 = y*2
draw rect x0 - x, y0 + y, x2, 1, true
draw rect x0 - y, y0 + x, y2, 1, true
draw rect x0 - x, y0 - y, x2, 1, true
draw rect x0 - y, y0 - x, y2, 1, true
y = y + 1
err = err + 1 + 2*y
if 2*(err - x) + 1 > 0
x = x - 1
err = err + 1 - 2*x
endif
wend
endproc


[Mike Lobanovsky]

Thanks Mopz,

That's what I'd expect from a good bytecode interpreter!

Yet that's ~20 times slower (exact figures are largely CPU dependent) than JIT compilation. Note also that the filled circles aren't necessary for the overall looks. They are entirely covered with subsequent PSet'ing. Evidently they are leftovers from B+'s earlier experimentation with the color palette. I've removed them from my code entirely (could've done them with BASIC filled Circle() and C filled Ellipse() calls though) because they don't have any noticeable effect on the overall timing of color array calc'ing portion.


P.S. Somebody is obviously using a multithreaded download manager to DL the attachments from here. This leads to substantial misrepresentation of the forum's DL statistics.

[Mopz]

Somebody is obviously using a multithreaded download manager to DL the attachments from here. This leads to substantial misrepresentation of the forum's DL statistics.

Haha, only a programmer would note and find that amusing 

[Cybermonkey]

A nice distraction from my actual project, so I made a port to FreeBASIC using Pulsar2d (i.e. NOT using the built-in FreeBASIC drawing capabilities)

Code: [Select]

#include once "pulsar2d.bi"
using p2d

dim win as p2d.window
dim as integer gem = 700

win=openwindow ("Voronoi Spiral Gem",-1,-1,gem,gem)
setactivewindow (win)
setvirtualsize (gem,gem)
clearwindow
const points = 36 * 13 ' 10 degrees needs 36 points for 1 circle
const  pi = acos(-1)
const  rad = pi / 180
dim as integer cy = gem/2
dim as integer ga = 10
dim as integer x(0 to points), y(0 to points),rd(0 to points),gr(0 to points),bl(0 to points)
dim as double scale = .7
dim as integer n,r,g,b,xx,yy,i,d,q,a,kkl, time1, time2
texttype (2)
textsize (2)

time1=timerticks
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
    endif
   if y(n) < gem and y(n) > 0 then
    b = y(n) * 255 / gem
    else
    b = 0
    endif
   rd (n)=r
   gr(n)=g
   bl(n)=b
   color (r, g, b,255)
   fillcircle(x(n), y(n), 2)
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
  color (rd(kkl),gr(kkl),bl(kkl),255)
      dot(xx, yy)
   next
next
time2=timerticks
color (0,0,0,255)
drawtext ("Time: " & str ((time2-time1)/1000) & " seconds",0,0)
redraw
p2d.inkey
closewindow (win)
closeapplication

It takes 1.884 seconds ...

[Aurel]

...and what is this FreeBasic execute on SDL canvas ?

[Cybermonkey]

Okay, apart from BASIC I ported this to Pascal:

Code: [Select]

{$IFDEF Windows}
  {$APPTYPE GUI}
{$ENDIF}
program voronoi;

uses p2dvideo, p2dinput, SDL2, sysutils,math;

const points = 36 * 13;
const rad = pi /180;
const gem=700;
var   cy:integer = gem div 2;
  ga:integer = 10;
  x:array [0..points] of integer;
    y:array [0..points] of integer;
    rd:array [0..points] of integer;
    gr:array [0..points] of integer;
    bl:array [0..points] of integer;
    scale:float = 0.7;      
      n,r,g,b,xx,yy,i,d,q,a,kkl, time1, time2: integer;
   
   
   
    win: p2dwindow;
   
BEGIN   

win:=openwindow ('Voronoi Spiral Gem FreePascal',-1,-1,gem,gem);
setactivewindow (win);
setvirtualsize (gem,gem);
clearwindow;

texttype (2);
textsize (2);

time1:=timerticks;
for n := 0 to points do begin
   x[n] := round (cy + scale * n * cos(rad * n * ga));
   y[n] := round (cy + scale * n * sin(rad * n * ga));
   if (x[n] < gem) and (x[n] > 0) and (y[n] < gem) and (y[n] > 0) then begin
     g := round (127 - abs(cy - x[n]) * 127 / cy  + 127 - abs(cy - y[n]) * 127 / cy);
   end
   else begin
     g := 0;
   end;
   
   if (x[n] < gem) and (x[n] > 0) then begin
    r := round (255 - x[n] * 255 / gem);
   end
   else  begin
     r := 0;
    end;
   
   if (y[n] < gem) and (y[n] > 0) then begin
    b := round (y[n] * 255 / gem);
    end
    else  begin
    b := 0 ;
    end;
   rd [n]:=r;
   gr[n]:=g;
   bl[n]:=b;
   color (r, g, b,255);
   fillcircle(x[n], y[n], 2);
end;

for xx := 0 to gem do begin
   for yy := 0 to gem do begin
      d := gem * gem + 1;
      for i := 0 to points do begin
         a := x[i] - xx;
         b := y[i] - yy;
         q := a * a + b * b;
         if q < d then begin
          d := q ;
          kkl := i;
         end;
      end;
  color (rd[kkl],gr[kkl],bl[kkl],255);
      dot(xx, yy);
   end;

end;
time2:=timerticks;
color (0,0,0,255);
drawtext ('Time: ' + FloatToStr ((time2-time1)/1000) + ' seconds',0,0);
redraw;
inkey();
closewindow (win);
closeapplication;


END.

Interesting is, though i am using the totally same framework (Pulsar2D) on the same computer and the same operating system, the Free Pascal version is always slightly faster. So, I guess the compiler does a better speed optimization.