program Plugin(output);

type
   texture    = array[0..255, 0..255] of integer;
   point2d    = record
		   x : real;
		   y : real;
		end; 
   point3d    = record
		   x : real;
		   y : real;
		   z : real;
		end; 
   plotpoint  = record
		   x	 : integer;
		   y	 : integer;
		   depth : real;
		end;	 
   cameraInfo = record
		   p	 : point3d;
		   theta : point3d;
		   ds	 : real; {Distance to screen.}
		   sinx	 : real;
		   cosx	 : real;
		   siny	 : real;
		   cosy	 : real;
		   cacz	 : real;
		   sinz	 : real;
		   cosz	 : real;
		end;	 
   vertices   = array[0..7] of point3d;
   torus      = array[0..59] of point3d;
   projected  = array[0..59] of plotpoint;
   
var	   
   tex		    : texture;
   texsize	    : integer;
   subdivi, subdivj : integer;
   
procedure clearTexture(var t : texture);
var
   i, j : integer;
begin
   for i := 0 to texsize do
      for j := 0 to texsize do
	 t[i, j] := 0;
end;

procedure initCamera(var c : cameraInfo; x, y, z, ds, tx, ty, tz : real);
begin
   c.p.x := x;
   c.p.y := y;
   c.p.z := z;
   c.ds := ds;
   c.theta.x := tx;
   c.theta.y := ty;
   c.theta.z := tz;
   c.cosx := cos(tx);
   c.sinx := sin(tx);
   c.cosy := cos(ty);
   c.siny := sin(ty);
   c.cosz := cos(tz);
   c.sinz := sin(tz);
end;

function distance3d(var a, b : point3d) : real;
var
   dx, dy, dz : real;
begin
   dx := a.x - b.x;
   dy := a.y - b.y;
   dz := a.z - b.z;
   distance3d := sqrt(dx*dx + dy*dy + dz*dz);
end;

function project(var c : cameraInfo; var p : point3d) : plotpoint;
var
   xt, yt, zt	    : real;
   centreX, centreY : Integer;
   result	    : plotpoint;
   scale	    : real;

begin
   centrex := 128;
   centrey := 128;
   scale := 150;
   { Rotate. }
   xt := c.cosy*c.cosz*p.x + (-c.cosx*c.sinz + c.sinx*c.siny*c.cosz)*p.y + (c.sinx*c.sinz + c.cosx*c.siny*c.cosz)*p.z;
   yt := c.cosy*c.sinz*p.x + (c.cosx*c.cosz + c.sinx*c.siny*c.sinz)*p.y + (-c.sinx*c.cosz + c.cosx*c.siny*c.sinz)*p.z;
   zt := -c.siny*p.x + c.sinx*c.cosy*p.y + c.cosx*c.cosy*p.z;

   { Translate. }
   xt := xt - c.p.x;
   yt := yt - c.p.y;
   zt := zt - c.p.z;
{
   writeln('Intermediaries:');
   writeln(round(c.ds*xt/zt));
   writeln(xt);
   writeln(yt);
   writeln(zt);
}   
   result.x := centrex + round(scale*xt*c.ds/zt);
   result.y := centrey - round(scale*yt*c.ds/zt);
   result.depth := zt;
 {  writeln('Projected:');
   writeln(result.x);
   writeln(result.y);
   writeln(result.depth);}
   project := result;
end;

procedure writePGM (var t : texture; fname : String);
var
   i, j	: integer;
   fileout : text;
   
begin
   assign(fileout, fname);
   rewrite(fileout);
   writeln(fileout, 'P2');
   writeln(fileout, '256 256');
   writeln(fileout, '255');
   for j := 0 to texsize do
      begin
	 for i := 0 to texsize do
	 begin
	    write(fileout, t[i, j]:4);
	 end;
	 writeln(fileout, ' '); 
      end;
   close(fileout);
end;   

procedure buildbox(var varr : vertices);
var
   i :  integer;
   
begin
   varr[0].x := 0;
   varr[0].y := 0;
   varr[0].z := 0;

   varr[1].x := 1;
   varr[1].y := 0;
   varr[1].z := 0;

   varr[2].x := 1;
   varr[2].y := 1;
   varr[2].z := 0;

   varr[3].x := 0;
   varr[3].y := 1;
   varr[3].z := 0;

   varr[4].x := 0;
   varr[4].y := 0;
   varr[4].z := 1;

   varr[5].x := 1;
   varr[5].y := 0;
   varr[5].z := 1;

   varr[6].x := 1;
   varr[6].y := 1;
   varr[6].z := 1;

   varr[7].x := 0;
   varr[7].y := 1;
   varr[7].z := 1;

   { Shift centre to origin and scale }
   for i := 0 to 7 do
   begin
      varr[i].x := (varr[i].x - 0.5)*2;
      varr[i].y := (varr[i].y - 0.5)*2;
      varr[i].z := (varr[i].z - 0.5)*2;
   end;
      
end;	       

procedure buildtorus(var t : torus);
var
   i,j		    : integer;
   angle, rot	    : real;
   major, minor	    : real;
   pi		    : real;
   x, y, z	    : real;
   ind		    : integer;
begin
   major := 0.8;
   minor := 0.2;
   pi := 3.141592654;
   
   for i := 0 to subdivj-1 do
   begin
      angle := (1.0*i)/subdivj*2.0*pi;
      for j := 0 to subdivi-1 do
      begin
	 rot := (1.0*j)/subdivi*2.0*pi;
	 x := major + minor*cos(rot);
	 y := minor*sin(rot);
         z := 0;
	 ind := i*subdivi + j;
	 t[ind].x := x*cos(angle) + z*sin(angle);
	 t[ind].y := y;
	 t[ind].z := -x*sin(angle) + z*cos(angle);
      end;
   end;
end;		     

procedure setpixel(var t : texture; p : plotpoint; value : Integer);
var
   xs, ys, ds : String;
   
begin
   if (p.x >= 0) and (p.x < texsize) and (p.y >= 0) and (p.y < texsize) and (p.depth >= 0) then
      if t[p.x, p.y] < value then
	 t[p.x, p.y] := value
      else
   else
   begin
      str(p.x, xs);
      str(p.y, ys);
      str(p.depth, ds);
      writeln('Bad point (' + xs + ', ' + ys + ', ' + ds + ').');
   end;
end;

procedure drawline(var t : texture; var p1, p2 : plotpoint; color1, color2 : integer);
var
   i, steps   : integer;
   dx, dy     : integer;
   incx, incy : real;
   inccolor   : real;
   pp	      : plotpoint;
   color      : integer;

begin
   dx := p2.x - p1.x;
   dy := p2.y - p1.y;
   if abs(dx) > abs(dy) then
      steps := abs(dx)
   else
      steps := abs(dy);

   if steps > 0 then
   begin
      incx := (1.0*dx)/steps;
      incy := (1.0*dy)/steps;
      inccolor := (1.0*(color2-color1))/steps;
   end
   else
   begin
      incx := 0.0;
      incy := 0.0;
      inccolor := 0.0;
   end;
   
   for i := 0 to steps do
   begin
      pp.x := p1.x + trunc(i*incx);
      pp.y := p1.y + trunc(i*incy);
      color := color1 + trunc(i*inccolor);
      pp.depth := 3;
      setpixel(t, pp, color);
   end
end;

function depthtocolor(depth : real) : integer;
begin
   depthtocolor := trunc(255.0*(5.5-depth)/3.0);
end;

procedure drawwireframe(var tex	: texture; var proj : projected);
var
   i, j, curind	  : integer;
   p1, p2	  : plotpoint;
   color1, color2 : integer;
   
begin
   { First the circles. }
   for j := 0 to subdivj-1 do
   begin
      for i := 0 to subdivi-1 do
      begin
	 p1 := proj[j*subdivi + i];
	 p2 := proj[(j*subdivi)+((i+1) mod subdivi)];
	 color1 := depthtocolor(p1.depth);
	 color2 := depthtocolor(p2.depth);
	 drawline(tex, p1, p2, color1, color2);
      end
   end;

   { Then the radial line thingys. }
   for i := 0 to subdivi-1 do
   begin
      for j := 0 to subdivj-1 do
      begin
	 p1 := proj[j*subdivi+i];
	 p2 := proj[((j+1)*subdivi + i) mod (subdivi*subdivj)];
	 color1 := depthtocolor(p1.depth);
	 color2 := depthtocolor(p2.depth);
	 drawline(tex, p1, p2, color1, color2);
      end
   end;
end;

procedure renderframe(var c : cameraInfo; var vertices : torus; var tex : texture);
var
   proj	: projected;
   i	: integer;
   
begin
   for i := 0 to (subdivi*subdivj - 1) do
   begin
      proj[i] := project(c, vertices[i]);
   end;
   drawwireframe(tex, proj);
end;


procedure plottest();
var
   c	 : cameraInfo;
   varr	 : vertices;
   tex	 : texture;
   s	 : String;
   i	 : integer;
   r	 : real;
   pi	 : real;
   angle : real;
   tilt	 : real;
   tor	 : torus;
   
begin
   r := 4.0;
   pi := 3.141592654;
   buildbox(varr);
   buildtorus(tor);
   tilt := pi/4;
   for i := 0 to 35 do
   begin
      angle := 2*pi*(i*10)/360.0;
      initCamera(c, 0.0, 0.0, -r, r/2.0, angle, angle*2, angle/3);
      clearTexture(tex);
      renderframe(c, tor, tex);
      str(i, s);
      writePGM(tex, 'output/pascal_frame' + s + '.pgm');
   end
end;


begin
   texsize := 255;
   subdivi := 6;
   subdivj := 10;
   plottest;
{   clearTexture(tex);
   writePGM(tex);}
end.
