Compare commits
No commits in common. "9177f29308d9ed02757a344454ff73bc1875f290" and "896fd8937bebf04c4bb314c1abe56cf37cd809ae" have entirely different histories.
9177f29308
...
896fd8937b
2 changed files with 98 additions and 304 deletions
|
|
@ -1,299 +0,0 @@
|
|||
{$H350}
|
||||
program benchmarks;
|
||||
var starttime:DateTime;
|
||||
endtime:DateTime;
|
||||
|
||||
procedure startBench(name:string);
|
||||
begin
|
||||
write(name:35, ' ');
|
||||
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;
|
||||
|
||||
procedure bench0;
|
||||
var i:integer;
|
||||
begin
|
||||
startBench('empty loop 10M');
|
||||
for i := 1 to 10000000 do;
|
||||
endBench;
|
||||
end;
|
||||
|
||||
procedure bench1;
|
||||
var i:integer;
|
||||
v:integer;
|
||||
begin
|
||||
startBench('write variable 10M');
|
||||
for i := 1 to 10000000 do
|
||||
v := 0;
|
||||
endBench;
|
||||
end;
|
||||
|
||||
procedure bench2;
|
||||
var i:integer;
|
||||
v,r:integer;
|
||||
begin
|
||||
v := 4711;
|
||||
startBench('read variable 10M');
|
||||
for i := 1 to 10000000 do
|
||||
r := v;
|
||||
endBench;
|
||||
end;
|
||||
|
||||
procedure bench3;
|
||||
var i:integer;
|
||||
a,b:integer;
|
||||
begin
|
||||
a := 0;
|
||||
b := 100;
|
||||
|
||||
startBench('integer addition 10M');
|
||||
for i := 1 to 10000000 do
|
||||
a := b + i;
|
||||
endBench;
|
||||
end;
|
||||
|
||||
procedure bench4;
|
||||
var i:integer;
|
||||
a,b:real;
|
||||
begin
|
||||
a := 0.0;
|
||||
b := 100.0;
|
||||
|
||||
startBench('real addition 1M');
|
||||
for i := 1 to 1000000 do
|
||||
a := b + i;
|
||||
endBench;
|
||||
end;
|
||||
|
||||
procedure bench5;
|
||||
var i:integer;
|
||||
a,b:integer;
|
||||
begin
|
||||
a := 0;
|
||||
b := 100;
|
||||
|
||||
startBench('integer multiplication 1M');
|
||||
for i := 1 to 1000000 do
|
||||
a := b * i;
|
||||
endBench;
|
||||
end;
|
||||
|
||||
procedure bench6;
|
||||
var i:integer;
|
||||
a,b:real;
|
||||
begin
|
||||
a := 0;
|
||||
b := 100;
|
||||
|
||||
startBench('real multiplication 1M');
|
||||
for i := 1 to 1000000 do
|
||||
a := b * i;
|
||||
endBench;
|
||||
end;
|
||||
|
||||
procedure bench7;
|
||||
var i:integer;
|
||||
a,b:integer;
|
||||
begin
|
||||
a := 0;
|
||||
b := 31415926;
|
||||
|
||||
startBench('integer division 1M');
|
||||
for i := 1 to 1000000 do
|
||||
a := b div i;
|
||||
endBench;
|
||||
end;
|
||||
|
||||
procedure bench8;
|
||||
var i:integer;
|
||||
a,b,c:real;
|
||||
begin
|
||||
a := 0;
|
||||
b := 31415926.0;
|
||||
|
||||
startBench('real division 1M');
|
||||
for i := 1 to 1000000 do
|
||||
a := b / i;
|
||||
endBench;
|
||||
end;
|
||||
|
||||
procedure bench9;
|
||||
var i,j:integer;
|
||||
s:string[100];
|
||||
c:char;
|
||||
begin
|
||||
s := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmn0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmn';
|
||||
|
||||
startBench('string indexing 1M');
|
||||
for i := 1 to 100000 do
|
||||
for j := 1 to 100 do
|
||||
c := s[j];
|
||||
endBench;
|
||||
end;
|
||||
|
||||
procedure bench10;
|
||||
var i:integer;
|
||||
s:string[100];
|
||||
c,d:char;
|
||||
begin
|
||||
s := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmn0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmn';
|
||||
|
||||
startBench('string iteration 1M');
|
||||
for i := 1 to 100000 do
|
||||
for c in s do
|
||||
d := c;
|
||||
endBench;
|
||||
end;
|
||||
|
||||
procedure bench11;
|
||||
var ptr: ^array[0..255] of integer;
|
||||
dummy1,dummy2,dummy3: ^array[0..127] of boolean;
|
||||
i:integer;
|
||||
begin
|
||||
new(dummy1);
|
||||
new(dummy2);
|
||||
new(dummy3);
|
||||
dispose(dummy1);
|
||||
|
||||
startBench('new/dispose 1k 1M');
|
||||
for i := 1 to 1000000 do
|
||||
begin
|
||||
new(ptr);
|
||||
dispose(ptr);
|
||||
end;
|
||||
endBench;
|
||||
|
||||
dispose(dummy2);
|
||||
dispose(dummy3);
|
||||
end;
|
||||
|
||||
procedure bench12;
|
||||
var ptr: ^array[0..32767] of integer;
|
||||
dummy1,dummy2,dummy3: ^array[0..127] of boolean;
|
||||
i:integer;
|
||||
begin
|
||||
new(dummy1);
|
||||
new(dummy2);
|
||||
new(dummy3);
|
||||
dispose(dummy1);
|
||||
|
||||
startBench('new/dispose 128k 1M');
|
||||
for i := 1 to 1000000 do
|
||||
begin
|
||||
new(ptr);
|
||||
dispose(ptr);
|
||||
end;
|
||||
endBench;
|
||||
|
||||
dispose(dummy2);
|
||||
dispose(dummy3);
|
||||
end;
|
||||
|
||||
procedure bench13;
|
||||
var ptr1: ^array[0..255] of integer;
|
||||
ptr2: ^array[0..255] of integer;
|
||||
i:integer;
|
||||
begin
|
||||
new(ptr1);
|
||||
new(ptr2);
|
||||
startBench('array copy 1k 10K');
|
||||
for i := 1 to 10000 do
|
||||
ptr1^ := ptr2^;
|
||||
endBench;
|
||||
dispose(ptr1);
|
||||
dispose(ptr2);
|
||||
end;
|
||||
|
||||
procedure bench14;
|
||||
var ptr1: ^array[0..32767] of integer;
|
||||
ptr2: ^array[0..32767] of integer;
|
||||
i:integer;
|
||||
begin
|
||||
new(ptr1);
|
||||
new(ptr2);
|
||||
startBench('array copy 128k 1K');
|
||||
for i := 1 to 1000 do
|
||||
ptr1^ := ptr2^;
|
||||
endBench;
|
||||
dispose(ptr1);
|
||||
dispose(ptr2);
|
||||
end;
|
||||
|
||||
procedure bench15;
|
||||
var i,j:integer;
|
||||
a:real;
|
||||
begin
|
||||
startBench('exp() 10K');
|
||||
for i := 1 to 1000 do
|
||||
for j := 1 to 10 do
|
||||
a := exp(j);
|
||||
endBench;
|
||||
end;
|
||||
|
||||
procedure bench16;
|
||||
var i,j:integer;
|
||||
a,b:real;
|
||||
begin
|
||||
startBench('cos() 10K');
|
||||
b := 0.0;
|
||||
for i := 1 to 10000 do
|
||||
begin
|
||||
a := cos(b);
|
||||
b := b + 0.0001;
|
||||
end;
|
||||
endBench;
|
||||
end;
|
||||
|
||||
begin
|
||||
bench0;
|
||||
bench1;
|
||||
bench2;
|
||||
bench3;
|
||||
bench4;
|
||||
bench5;
|
||||
bench6;
|
||||
bench7;
|
||||
bench8;
|
||||
bench9;
|
||||
bench10;
|
||||
bench11;
|
||||
bench12;
|
||||
bench13;
|
||||
bench14;
|
||||
bench15;
|
||||
bench16;
|
||||
end.
|
||||
|
|
@ -1,21 +1,79 @@
|
|||
program viewpict;
|
||||
const FadeDelay = 20;
|
||||
FadeLevels = 15;
|
||||
|
||||
type PaletteData = array[0..15] of integer;
|
||||
Palettes = array[1..FadeLevels] of PaletteData;
|
||||
|
||||
type PictData = record
|
||||
magic, mode:integer;
|
||||
palette: array [0..15] of integer;
|
||||
palette: PaletteData;
|
||||
pixeldata: array [0..31999] of integer;
|
||||
end;
|
||||
|
||||
|
||||
var pic:PictData;
|
||||
filename:string;
|
||||
infile:file;
|
||||
ch:char;
|
||||
|
||||
procedure loadPalette(var pic:PictData);
|
||||
procedure setBlackPalette;
|
||||
var i:integer;
|
||||
begin
|
||||
for i := 0 to 15 do
|
||||
setpalette(i, pic.palette[i]);
|
||||
setPalette(i, 0);
|
||||
end;
|
||||
|
||||
procedure createFade(var pic:PictData;var fadedPalette: Palettes);
|
||||
var i:integer;
|
||||
c:integer;
|
||||
rgb:integer;
|
||||
r,g,b:integer;
|
||||
|
||||
procedure fade(var col:integer);
|
||||
var delta:integer;
|
||||
begin
|
||||
|
||||
delta := col * 10 div 100;
|
||||
if delta < 1 then
|
||||
delta := 1;
|
||||
col := col - delta;
|
||||
if col < 0 then
|
||||
col := 0;
|
||||
end;
|
||||
|
||||
begin
|
||||
fadedPalette[1] := pic.palette;
|
||||
|
||||
for i := 2 to FadeLevels - 1 do
|
||||
begin
|
||||
for c := 0 to 15 do
|
||||
begin
|
||||
rgb := fadedPalette[i-1][c];
|
||||
r := (rgb shr 8) and $F;
|
||||
g := (rgb shr 4) and $F;
|
||||
b := (rgb) and $F;
|
||||
|
||||
fade(r);
|
||||
fade(g);
|
||||
fade(b);
|
||||
|
||||
rgb := (r shl 8) or
|
||||
(g shl 4) or
|
||||
(b);
|
||||
|
||||
fadedPalette[i][c] := rgb;
|
||||
end;
|
||||
end;
|
||||
|
||||
for c := 0 to 15 do
|
||||
fadedPalette[FadeLevels][c] := 0;
|
||||
end;
|
||||
|
||||
procedure loadPalette(var p:PaletteData);
|
||||
var i:integer;
|
||||
begin
|
||||
for i := 0 to 15 do
|
||||
setpalette(i, p[i]);
|
||||
end;
|
||||
|
||||
procedure loadPic(var pic:PictData);
|
||||
|
|
@ -23,6 +81,30 @@ begin
|
|||
PutScreen(pic.pixeldata);
|
||||
end;
|
||||
|
||||
procedure fadeIn(var pic:PictData);
|
||||
var i:integer;
|
||||
fadedPalette:Palettes;
|
||||
begin
|
||||
createFade(pic, fadedPalette);
|
||||
for i := FadeLevels - 1 downto 1 do
|
||||
begin
|
||||
delay(FadeDelay);
|
||||
loadPalette(fadedPalette[i]);
|
||||
end
|
||||
end;
|
||||
|
||||
procedure fadeOut(var pic:PictData);
|
||||
var i:integer;
|
||||
fadedPalette:Palettes;
|
||||
begin
|
||||
createFade(pic, fadedPalette);
|
||||
for i := 1 to FadeLevels do
|
||||
begin
|
||||
delay(FadeDelay);
|
||||
loadPalette(fadedPalette[i]);
|
||||
end
|
||||
end;
|
||||
|
||||
begin
|
||||
if ParamCount > 0 then
|
||||
filename := ParamStr(1)
|
||||
|
|
@ -38,7 +120,18 @@ begin
|
|||
|
||||
writeln('magic: ', pic.magic, ' mode:', pic.mode);
|
||||
|
||||
loadPalette(pic);
|
||||
initgraphics;
|
||||
|
||||
setBlackPalette;
|
||||
loadPic(pic);
|
||||
fadeIn(pic);
|
||||
|
||||
read(ch);
|
||||
|
||||
if ch <> 'k' then
|
||||
begin
|
||||
fadeOut(pic);
|
||||
initgraphics;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue