program array1 ;

{This is to the the Leibniz random model of reality. Each point gets a small
amount of noise. Then it is averaged with points around it. It is iterated b
number of times.} 

uses dos, crt;

var
	basic, calc : array[0..257,0..257] of real; {arrays sized with bound edges}
	i,j,k : integer; 
	r,s,t : integer;
	{a,}b : integer;
	n : longint; {or integer, investigate compiler}
	x,y : real;
	outfile : text;
	x1, y1, z1, t1 : string;

procedure output_tga;
var
	b,l,h : byte;
	t : integer;
	outfile : file of byte;
begin
	l := lo(i); h := hi(i);
	writeln(' low bite ',l,' high bite ',h);
	h := $2a ;
	writeln(' hex 2a ', h);

	assign( outfile, 'test2.tga' );
	rewrite(outfile);

	h := $2a; write(outfile, h);
	h := $0; write(outfile, h);
	h := $3; write(outfile, h);
	h := $0; write(outfile, h);
	h := $0; write(outfile, h);
	h := $0; write(outfile, h);

	h := $0; write(outfile, h);
	h := $0; write(outfile, h);
	h := $0; write(outfile, h);
	h := $0; write(outfile, h);
	h := $0; write(outfile, h);

	h := $0; write(outfile, h);
	h := $2; write(outfile, h);
	h := $1; write(outfile, h);
	h := $2; write(outfile, h);
	h := $1; write(outfile, h);
	h := $8; write(outfile, h);
	h := $20; write(outfile, h);
	
	h := 0;for t := 18 to 60 do write(outfile,h); 
	for r := 0 to 257 do
	begin
	for s := 0 to 257 do
	begin
		t := trunc( basic[r,s] ) ;

		{if ( r=0) or (r=257) or (s=0) or (s=257) then t := 0;} 

		l := lo(t); h := hi(t);
{		writeln(t,' ',l,' ',h);}
		write(outfile, l, h);
	end;
	end;
	close(outfile);
	
end;

{
	format3.tga black image 40Wx20H
tga uncompressed 
byte 0 2a 
byte 1 00
byte 2 03
byte 3 -11 00 
byte 12-13 low-high width
byte 14-15 low-high height
byte 16-17 08 20 
byte 18-60 appears to be ID text
rest data lo-high format

2a00 0300 0000 0000 0000 0000 2800 1400 
0820 4352 4541 544f 523a 2054 6865 2047 
494d 5027 7320 5447 4120 4669 6c74 6572 
2056 6572 7369 6f6e 2031 2e32 0000 0000 

	format.tga white image 258Wx258H
appears the same 

2a00 0300 0000 0000 0000 0000 0201 0201 
0820 4352 4541 544f 523a 2068 616e 646d 
6164 6520 7072 6f64 7563 7469 6f6e 7372 
2056 6572 7369 6f6e 2031 2e32 ffff ffff 

2a00 0300 0000 0000 0000 0002 0102 0108 
2000 0000 0000 0000 0000 0000 0000 0000 
0000 0000 0000 0000 0000 0000 0000 0000 
0000 0000 0000 0000 0000 0000 0000 0000 


}

procedure output; 

begin
	assign(outfile,'mesh');
	rewrite(outfile);
begin
	for r := 0 to 256 do
	begin
	for s := 0 to 256 do
	begin
		str(r,x1);
		str(basic[r,s],y1);
		str(s,z1);
		write(outfile,' triangle { < ' ,x1, ', ' ,y1, ', ' ,z1, '>,'); 

		str(r+1,x1);
		str(basic[r+1,s],y1);
		str(s,z1);
		write(outfile,' < ' ,x1, ', ' ,y1, ', ' ,z1, '>,'); 

		str(r,x1);
		str(basic[r,s+1],y1);
		str(s+1,z1);
		writeln(outfile,' < ' ,x1, ', ' ,y1, ', ' ,z1, '> pigment{color White} }'); 


		str(r,x1);
		str(basic[r,s+1],y1);
		str(s+1,z1);
		write(outfile,' triangle { < ' ,x1, ', ' ,y1, ', ' ,z1, '>,'); 

		str(r+1,x1);
		str(basic[r+1,s],y1);
		str(s,z1);
		write(outfile,' < ' ,x1, ', ' ,y1, ', ' ,z1, '>,'); 

		str(r+1,x1);
		str(basic[r+1,s+1],y1);
		str(s+1,z1);
		writeln(outfile,' < ' ,x1, ', ' ,y1, ', ' ,z1, '> pigment{color White}}'); 
	end;
	end;
end;
end;

procedure revert; {puts averaging results back into basic}
begin
	for i := 1 to 256 do
	for j := 1 to 256 do
		begin
			basic[i,j]:=calc[i,j];
		end;
end;


procedure average_array; {averages the one step away local points} 
var t1,t2,t3 : real;
begin
	for i := 1 to 256 do
	for j := 1 to 256 do
	begin
		t1 := basic[i-1,j-1]/9 + basic[i,j-1]/9 + basic[i+1,j-1]/9;
		t2:=basic[i-1,j]/9+basic[i,j]/9+basic[i+1,j]/9;
		t3:=basic[i-1,j+1]/9+basic[i,j+1]/9+basic[i+1,j+1]/9;
		calc[i,j]:=t1+t2+t3;
	end;
	revert;
end;

procedure run;
begin
	while (k < b) do
	begin
		for i := 1 to 256 do { to a do}
		begin
		for j := 1 to 256 do
		begin
			basic[i,j] := basic[i,j] + random(n);
		end;
		end;
	k := k + 1;
	write('.'); 
	end;
	average_array;
end; 

procedure initialize;
begin
	randomize;
	{a := 256;} {fraction of array to use} {unimportant with 333 PII}
	b := 5000; {sets the number of iterations}
	k := 0;
	n := 10000; {resolution of random number} 
	x := 0; 
	for i := 0 to 257 do 
		for j:= 1 to 257 do
			begin
			basic[i,j] := 0;
			calc[i,j] := 0;
			end;
end;

begin
	assign(outfile, 'mesh');
	rewrite(outfile);
	close(outfile);
	initialize;
	run;
	{output;}
	output_tga;
	writeln(' at end array 128,128 ',basic[128,128]);
	{flush(outfile);}
	{close(outfile);}
end.