visual test , based on Nitorami optimization , i got 577ms , with -O4 -XX -WG -XS -Cfsse2
program mandelbrot;
{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
uses windows;
const
w = 800;
h = 600;
ixmax = 2000;
iymax = 2000;
cxmin = -2.5;
cxmax = 1.5;
cymin = -2.0;
cymax = 2.0;
pixelwidth = (cxmax - cxmin) / ixmax;
pixelheight = (cymax - cymin) / iymax;
maxcolorcomponentvalue = 255;
maxiteration = 200;
escaperadius = 2.0;
er2 = escaperadius * escaperadius;
var
wc : twndclassex;
wnd: hwnd;
msg: tmsg;
bmp: HBITMAP;
fnt : HFONT;
dc,back_dc : longword;
data : plongword;
ix, iy : longword;
cx, cy : real;
tm : longword;
function inttostr(i : integer):ansistring;
begin
str(i,inttostr);
end;
procedure setup(win : longword);
var
binfo : BITMAPINFO;
begin
dc := GetDC(win);
back_dc := CreateCompatibleDC(dc);
fillchar(binfo,sizeof(BITMAPINFO),0);
binfo.bmiHeader.biSize := sizeof(BITMAPINFOHEADER);
binfo.bmiHeader.biWidth := ixmax;
binfo.bmiHeader.biHeight := -iymax;
binfo.bmiHeader.biPlanes :=1;
binfo.bmiHeader.biBitCount :=32;
binfo.bmiHeader.biCompression :=BI_RGB;
binfo.bmiHeader.biSizeImage :=0;
binfo.bmiHeader.biClrUsed :=256;
binfo.bmiHeader.biClrImportant:=256;
bmp := CreateDIBSection(back_dc,binfo,DIB_RGB_COLORS,data,0,0);
selectObject(back_dc,bmp);
fnt := CreateFont(14, 0, 0, 0, FW_LIGHT, 0, 0, 0,
ANSI_CHARSET, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS, 0,
FF_DONTCARE or DEFAULT_PITCH, 'tahoma');
SelectObject(dc,fnt);
end;
procedure clean();
begin
deleteDC(back_dc);
deleteDC(dc);
deleteObject(bmp);
deleteObject(fnt);
end;
function Iterate (const cx,cy,er2: real): dword; inline;
var i: dword;
zx,zy,zx2,zy2: real;
begin
i := 0; zx := 0; zy := 0; zx2 := 0; zy2 := 0;
while (zx2 + zy2 < er2) and (i < maxiteration) do
begin
zy := cy + zx*zy*2;
zx := cx + zx2 - zy2;
zx2 := zx*zx;
zy2 := zy*zy;
inc (i);
end;
result := i;
end;
procedure draw();
var
s : ansistring;
c : longword;
begin
tm := GetTickCount;
for iy := 0 to iymax-1 do
begin
cy := cymin + iy*pixelheight;
if abs(cy) < pixelheight / 2 then cy := 0.0;
for ix := 0 to ixmax-1 do
begin
cx := cxmin + ix*pixelwidth;
if iterate (cx,cy,er2) = maxiteration
then c := 0
else c := $ffffff;
data[ (iymax * iy ) + ix] := c;
end;
end;
SetStretchBltMode(dc,HALFTONE);
StretchBlt(dc,0,0,w,h,back_dc,0,0,ixmax,iymax,SRCCOPY);
s := inttostr(GetTickCount()-tm) + 'ms';
SetBKMode(dc,TRANSPARENT);
TextoutA(dc,0,0,pchar(s),length(s));
end;
function wndproc(wnd, message:longword;wParam,lParam: longint):longint; stdcall;
begin
case (message) of
WM_CLOSE:
ExitProcess(0);
end;
wndproc := DefWindowProc (wnd, message, wParam, lParam);
end;
begin
FillChar(wc,sizeof(wc),0);
wc.cbSize := sizeof(twndclassex);
wc.style := CS_HREDRAW or CS_VREDRAW;
wc.lpfnWndProc := @wndproc;
wc.hbrBackground := 1;
wc.lpszClassName := 'wclass';
registerclassex (@wc);
wnd := CreateWindowEx(WS_EX_TOOLWINDOW or WS_EX_APPWINDOW ,
'wclass',
'mandelbrot',
WS_OVERLAPPEDWINDOW or WS_VISIBLE,
GetSystemMetrics( SM_CXSCREEN ) div 2 - w div 2,
GetSystemMetrics( SM_CYSCREEN ) div 2 - h div 2,
w,
h,
0,
0,
0,
nil);
setup(wnd);
draw();
while ( msg.message <> WM_QUIT ) do
begin
if( PeekMessage( @msg, 0, 0, 0, PM_REMOVE ) ) then
begin
TranslateMessage( @msg );
DispatchMessage( @msg );
end else
begin
end;
end;
clean();
unregisterclass(@wc,hinstance);
ExitProcess(wnd);
end.