RetroBASIC
Basicprogramming(.org) => Code and examples => Topic started by: B+ on August 20, 2016, 02:50:09 AM
-
'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)
-
How long does it take SDL Basic to run through those triply nested For/Dot/Next loops in real time?
-
SmallBASIC took 530 seconds in one test (showpage).
SdlBasic took 560 seconds (autoback(-1000) and screenswap).
-
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?
-
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.
-
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? :D
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).
'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 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. :D
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.
-
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). :-[
-
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. :D
-
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.
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
-
Thanks Mopz,
That's what I'd expect from a good bytecode interpreter! :D
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. :D
-
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. :D
Haha, only a programmer would note and find that amusing ;D
-
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)
#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 ...
-
...and what is this FreeBasic execute on SDL canvas ?
-
Okay, apart from BASIC I ported this to Pascal:
{$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.
-
Okay, apart from BASIC I ported this to Pascal:
Did you port it to Lua, as well? I wonder how fast would it be.
-
OK, I wonder how fast it would be in Julia.
-
OK, I wonder how fast it would be in Julia.
It will be fast, but it will take ages to start.
-
Here (http://www.allbasic.info/basic/vs.html) is a JavaScript version of a Voronoi Spiral variation.
-
Here (http://www.allbasic.info/basic/vs.html) is a JavaScript version of a Voronoi Spiral variation.
Looks beautiful. Looks like classic palette rotation :3
-
This is cool.
https://www.youtube.com/embed/UrprUfAtYSM
-
@Cybermonkey:
Looks cool!
Again for fair comparison only, what CPU are you using? Is the FreeBASIC-translated output built against unoptimizing GAS or optimizing GCC? What bitness is your exe?
My exe feels fine unmodified under Ubuntu Wine, and surprisingly, under Mac OSX Lion Wine too even on a slightly slower Hackintosh! :)
@John:
Voronoi plasma looks impressive. Must be using prebuilt multi-threaded WebGL classes or something, but I'm too lazy to check tonight. :)
-
Voronoi plasma looks impressive. Must be using prebuilt multi-threaded WebGL classes or something, but I'm too lazy to check tonight.
Nope. Just JavaScript.
D3 - Data-Driven Documents (https://d3js.org/)
Library Preview
(https://raw.githubusercontent.com/d3/d3.github.com/master/preview.png)
<!DOCTYPE html>
<meta charset="utf-8">
<canvas width="660" height="660"></canvas>
<script src="https://d3js.org/d3.v4.0.0-alpha.28.min.js"></script>
<script>
var canvas = d3.select("canvas").node(),
context = canvas.getContext("2d"),
width = canvas.width,
height = canvas.height;
var sites = d3.range(100).map(function() { return [Math.random() * width, Math.random() * height]; }),
cells = d3.voronoi().size([width, height]).polygons(sites),
formatHex = d3.format("02x");
var colors = d3.range(256)
.map(d3.scaleRainbow().domain([0, 255]))
.map(function(c) { return d3.rgb(c); });
for (var i = 0; i < 256; ++i) {
context.beginPath();
cells.forEach(function(cell) {
drawCell(cell);
var p0 = cell.shift(),
p1 = cell[0],
t = Math.min(0.5, 4 / distance(p0, p1)),
p2 = [p0[0] * (1 - t) + p1[0] * t, p0[1] * (1 - t) + p1[1] * t];
cell.push(p2);
});
context.fillStyle = "#" + formatHex(i) + "0000";
context.fill();
}
var source = context.getImageData(0, 0, width, height).data,
targetBuffer = context.createImageData(width, height),
target = targetBuffer.data;
for (var i = 0, y = 0; y < height; ++y) {
for (var x = 0; x < width; ++x, i += 4) {
target[i + 0] =
target[i + 1] =
target[i + 2] =
target[i + 3] = 255;
}
}
context.clearRect(0, 0, width, height);
d3.timer(function(elapsed) {
for (var i = 0, y = 0; y < height; ++y) {
for (var x = 0; x < width; ++x, i += 4) {
var c = colors[Math.floor(source[i] + elapsed / 10) % 256];
target[i + 0] = c.r;
target[i + 1] = c.g;
target[i + 2] = c.b;
}
}
context.putImageData(targetBuffer, 0, 0);
});
function drawCell(cell) {
context.moveTo(cell[0][0], cell[0][1]);
for (var i = 1, n = cell.length; i < n; ++i) context.lineTo(cell[i][0], cell[i][1]);
context.closePath();
}
function distance(a, b) {
var dx = a[0] - b[0], dy = a[1] - b[1];
return Math.sqrt(dx * dx + dy * dy);
}
</script>
FYI: My next Script BASIC extension module. (hoping it's thread safe)
V7: Embedded JavaScript engine (https://github.com/cesanta/v7)
-
@Cybermonkey:
Looks cool!
Again for fair comparison only, what CPU are you using? Is the FreeBASIC-translated output built against unoptimizing GAS or optimizing GCC? What bitness is your exe?
My exe feels fine unmodified under Ubuntu Wine, and surprisingly, under Mac OSX Lion Wine too even on a slightly slower Hackintosh! :)
-Computer-
Processor : 6x AMD FX(tm)-6100 Six-Core Processor @ 3.3 GHz
Memory : 8157MB
Operating System : Ubuntu 16.04.1 LTS
Kernel : Linux 4.4.0-34-generic (x86_64)
Default C Compiler : GNU C Compiler version 5.4.0 20160609 (Ubuntu 5.4.0-6ubuntu1~16.04.2)
I don't know what optimizing FBC does. I just invoke fbc voronoi.bas; the resulting exe is 64 Bit.
-
Okay, here's the ChipmonkeyLua version (painted in the backbuffer):
points = 36 * 13
rad = math.pi /180
gem=700
cy = gem / 2
ga = 10
x={}
y={}
rd={}
gr={}
bl={}
scale = 0.7
visualpage (0)
activepage (1)
cls()
time1=gettickcount()
for n = 0, points do
x[n] = round (cy + scale * n * math.cos(rad * n * ga))
y[n] = round (cy + scale * n * math.sin(rad * n * ga))
if (x[n] < gem) and (x[n] > 0) and (y[n] < gem) and (y[n] > 0) then
g = round (127 - math.abs(cy - x[n]) * 127 / cy + 127 - math.abs(cy - y[n]) * 127 / cy);
else
g = 0
end
if (x[n] < gem) and (x[n] > 0) then
r = round (255 - x[n] * 255 / gem)
else
r = 0
end
if (y[n] < gem) and (y[n] > 0) then
b = round (y[n] * 255 / gem)
else
b = 0
end
rd [n]=r
gr[n]=g
bl[n]=b
ink (rgb (r, g, b))
fillcircle(x[n], y[n], 2)
end
for xx = 0, gem do
for yy = 0, gem do
d = gem * gem + 1
for i = 0, points do
a = x[i] - xx
b = y[i] - yy
q = a * a + b * b
if q < d then
d = q
kkl = i
end
end
ink (rgb (rd[kkl],gr[kkl],bl[kkl]))
pset (xx, yy);
end
end
time2=gettickcount()
visualpage (1)
ink (0)
print ("Time: ".. ((time2-time1)/1000) .." seconds")
Time: over 87 seconds.
-
And just again for comparison if someone thinks I am cheating because I don't use PulsarLua. This time another Pascal version using the same graphics routines as the Lua example:
{$IFDEF Windows}
{$APPTYPE GUI}
{$ENDIF}
program voronoi;
uses graphtools,ptcgraph,ptccrt,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;
BEGIN
mode (3);
textsize (2);
setvisualpage (0);
setactivepage (1);
cleardevice;
time1:=gettickcount64;
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;
ink (r, g, b);
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;
ink (rd[kkl],gr[kkl],bl[kkl]);
pset(xx, yy);
end;
//redraw;
end;
time2:=gettickcount64;
setvisualpage (1);
ink (0,0,0);
OuttextXY (0,0,'Time: ' + FloatToStr ((time2-time1)/1000) + ' seconds');
getkey;
mode (0);
END.
Time: 1.655 seconds
Just for comparison: with my slow (but nice) notebook using an Intel Celeron N2940 (quadcore @ 1.83 GHz), I got the following times (all 32 Bit exe on a 64 Bit Windows 10 system - and all done working with the battery):
Free Pascal (Graph): 2.985 seconds
FreeBASIC (SDL2): 3.78 seconds
ChipmonkeyLua: 190.5 seconds
-
I don't know what optimizing FBC does. I just invoke fbc voronoi.bas; the resulting exe is 64 Bit.
FBC per se doesn't perform any optimizations. With such invokation, it translates BASIC to AT&T assembly and uses GAS as the backend. To the best of my knowledge, GAS isn't capable of optimizing anything either.
Invoking fbc -gen gcc voronoi.bas will force it to emit C output and use GCC as the back end. GCC has excellent optimization capabilities and your process times may improve considerably.
-
Nope. Just JavaScript
I probably failed to express myself clear. I meant the 2D canvas that the script is drawing to must be some sort of WebGL widget class to be able to perform color fills so quickly. The particular implementation is of course hidden from JavaScript and data interchange is wrapped in a set of familiarly sounding accessor methods like canvas.moveTo(), canvas.lineTo(), canvas.fillStyle(), canvas.fill(), etc. Those are the names of system WinAPIs from the standard Gdi32.dll library. :)
-
Those are the names of system WinAPIs from the standard Gdi32.dll library. :)
I'm running it in Firefox on Linux.
I'm not sure how Firefox's canvas element works under the covers but I like the D3 library's use of it.
-
... and data interchange is wrapped in a set of familiarly sounding accessor methods like canvas.moveTo(), canvas.lineTo(), canvas.fillStyle(), canvas.fill(), etc. Those are the names of system WinAPIs from the standard Gdi32.dll library. :)
I'm pretty sure that is just a a coincidence. :)
-
Good News!
I was able to get the JavaScript extension module (http://www.allbasic.info/forum/index.php?topic=450.msg4807#msg4807) working with Script BASIC.
-
Well that is good news!
Too bad this forum does not have an announcement section for the community.
oh wait... :D
-
My port to BaCon runs in less than a second when using GCC compiler optimizations.
'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
-
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.
-
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
-
I know this topic is old but someone might like to see FreeBASIC example (I have no idea if this optimum FB can do.):
'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:
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.