Revert last change to examples/viewpict

This reverts commit 896fd8937b.

examples/benchmarks.pas

@@ -0,0 +1,299 @@
+{$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.

examples/viewpict.pas

@@ -1,79 +1,21 @@
 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: PaletteData;
+		palette: array [0..15] of integer;
 		pixeldata: array [0..31999] of integer;
 	end;
 
+
 var pic:PictData;
     filename:string;
     infile:file;
     ch:char;
 
-procedure setBlackPalette;
+procedure loadPalette(var pic:PictData);
 var i:integer;
 begin
 	for i := 0 to 15 do
-		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]);
+		setpalette(i, pic.palette[i]);
 end;
 
 procedure loadPic(var pic:PictData);
@@ -81,30 +23,6 @@ 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)
@@ -120,18 +38,7 @@ begin
 
 	writeln('magic: ', pic.magic, ' mode:', pic.mode);
 
-	initgraphics;
-
-	setBlackPalette;
+	loadPalette(pic);
 	loadPic(pic);
-	fadeIn(pic);
-
 	read(ch);
-
-	if ch <> 'k' then
-	begin
-		fadeOut(pic);
-		initgraphics;
-	end;
-		
 end.