{$M 64000,100000,100000}
program _3dican_pascal_esimerkki_ohjelma_nro_3_by_kaitsu_;
{säälittävän näköinen z-gouraud, reaalilukumatriisi}
uses sumthing,loadasc,polygon,extra,matrix,vector,kello;

const xnopeus=600000; {objektin pyöritysnopeus}
      ynopeus=500000;
      znopeus=400000;

var torus:objtype; {objecti jota pyöritellään}
    rot:array[0..maxvertices-1] of vertextype; {pyörityksen tulos}
    start_time,finish_time,frames:longint;

procedure rotate(obj:objtype; rx,ry,rz:word; x,y,z:longint);
var i,x1,y1,z1:integer;
    mat:matriisi;
begin
 teepyoritysmatriisi(mat,st[rx]/256,st[ry]/256,st[rz]/256,
                     ct[rx]/256,ct[ry]/256,ct[rz]/256,x,y,z);
 for i:=0 to obj.vertices-1 do vek_mul_mat(torus.vertex[i],rot[i],mat);
end;

procedure draw(obj:objtype);
var i,a:integer;
    c1,c2,c3:longint;
    order:array[0..maxfaces-1] of word;
    zval:array[0..maxfaces-1] of longint;

function partition(left,righ:word):word;
var i,j,t:longint;
    x:integer;
begin
 x:=zval[order[left]];
 i:=longint(left)-1;
 j:=longint(righ)+1;
 while (0=0) do begin
  repeat dec(j); until (zval[order[j]]<=x);
  repeat inc(i); until (zval[order[i]]>=x);
  if i<j then begin
   t:=order[i];
   order[i]:=order[j];
   order[j]:=t;
  end else begin
   partition:=j;
   exit;
  end;
 end;
end;

procedure qsort(lef,rig:word);
var gap:word;
begin
 if (lef<rig) then begin
  gap:=partition(lef,rig);
  qsort(lef,gap);
  qsort(gap+1,rig);
 end;
end;

begin
 for i:=0 to obj.faces-1 do order[i]:=i;
 for i:=0 to obj.faces-1 do
  zval[i]:=longint(rot[obj.face[order[i]].a].z)+
           longint(rot[obj.face[order[i]].b].z)+
           longint(rot[obj.face[order[i]].c].z);
 qsort(0,obj.faces-1);
 with obj do
  for a:=0 to faces-1 do begin
   i:=order[a];
   if visable(rot[face[i].a].x,rot[face[i].a].y,
              rot[face[i].b].x,rot[face[i].b].y,
              rot[face[i].c].x,rot[face[i].c].y)
    then begin

     c1:=(rot[face[i].a].z+50) div 4;
     c2:=(rot[face[i].b].z+50) div 4;
     c3:=(rot[face[i].c].z+50) div 4;

     if c1<1 then c1:=1 else if c1>63 then c1:=63;
     if c2<1 then c2:=1 else if c2>63 then c2:=63;
     if c3<1 then c3:=1 else if c3>63 then c3:=63;

     gouraud_kol(rot[face[i].a].x,rot[face[i].a].y,
                 rot[face[i].b].x,rot[face[i].b].y,
                 rot[face[i].c].x,rot[face[i].c].y,
                 c1,c2,c3,virt);
    end;
  end;

end;
procedure main;
var rx,ry,rz:longint;
    falku,floppu:longint;
begin
 rx:=0;
 ry:=0;
 rz:=0;
 frames:=0;
 start_time:=klo;
 falku:=klo;
 repeat
  inc(frames);
  rotate(torus,(rx shr 22) and 1023,
               (ry shr 22) and 1023,
               (rz shr 22) and 1023,
               160,100,0);
  draw(torus);
  flips(virt);
  clear(virt);
  floppu:=klo;
  inc(rx,(floppu-falku)*xnopeus);
  inc(rz,(floppu-falku)*ynopeus);
  inc(ry,(floppu-falku)*znopeus);
  falku:=floppu;
 until keypressed;
 finish_time:=klo;
end;

procedure pal;
var i,t:integer;
    cosi:real;
begin
{ for i:=1 to 63 do setcolor(i,i,i,i);}
 for i:=1 to 63 do begin
  cosi:=(i*pi/128);
  t:=round((1+cosi*40+cosi*cosi*30)/2);
  if t<0 then t:=0;
  if t>63 then t:=63;
  setcolor(i,32+t div 2,t,t);
 end;
end;

begin
 init;
 lataa_asc('toorus.asc',torus,1.7);
 setmode($13);
 pal;
 lataa;
 main;
 while keypressed do readkey;
 poista;
 setmode($3);
 close;
 writeln('average fps ',frames*1000/(finish_time-start_time):0:2);
end.