add line/points drawing benchmark

This commit is contained in:
slederer 2026-01-31 17:26:13 +01:00
parent 1e56251fc1
commit c119a2a5bb

92
examples/graphbench.pas Normal file
View file

@ -0,0 +1,92 @@
program graphbench;
var starttime,endtime:DateTime;
procedure startBench(name:string);
begin
write(name:20, ' ');
starttime := GetTime;
end;
procedure endBench;
var secDelta, minDelta, hourDelta:integer;
procedure write2Digits(i:integer);
begin
if i < 10 then
write('0');
write(i);
end;
begin
endTime := GetTime;
hourDelta := endtime.hours - starttime.hours;
minDelta := endtime.minutes - starttime.minutes;
secDelta := endtime.seconds - starttime.seconds;
if secDelta < 0 then
begin
secDelta := 60 + secDelta;
minDelta := minDelta - 1;
end;
if minDelta < 0 then
begin
minDelta := 60 + minDelta;
hourDelta := hourDelta - 1;
end;
write2Digits(hourDelta);
write(':'); write2Digits(minDelta);
write(':'); write2Digits(secDelta);
writeln;
end;
function randint(lessthan:integer):integer;
var r:integer;
begin
r := random and 511;
if r >= lessthan then
r := r - lessthan;
randint := r;
end;
procedure drawlines(count:integer);
var i,col,x1,y1,x2,y2:integer;
begin
col := 1;
for i := 1 to count do
begin
x1 := randint(500);
y1 := randint(400);
x2 := randint(500);
y2 := randint(400);
DrawLine(x1,y1,x2,y2,col);
col := col + 1;
if col > 15 then col := 1;
end;
end;
procedure drawpoints(count:integer);
var i,col,x,y:integer;
begin
col := 1;
for i := 1 to count do
begin
x := randint(500);
y := randint(400);
PutPixel(x,y,col);
col := col + 1;
if col > 15 then col := 1;
end;
end;
begin
InitGraphics;
startBench('200K points');
drawpoints(200000);
endBench;
InitGraphics;
startBench('10K lines');
drawlines(10000);
endBench;
end.