Program kocka;
uses Graph;
type  tbod= record x:real; y:real; z:real; end;
var
    pocetbodov, pocethran, pocetstien, koniecbodov:integer;
    i,j:integer;
    b:array[1..20] of tbod;
    h:array[1..30,0..1] of integer;
    s:array[1..20,0..3] of integer;
    Gd,Gm: integer;


procedure bod(x,y:integer;f:byte);
begin
asm
mov ah, $0C
mov bh, 0
mov dx, y
mov cx, x
mov al, f
int $10
end;
end;

procedure usecka(x1,y1,x2,y2:integer;farba: byte);
var dy, dx, x, y, p : integer;
    vymena,zniz:boolean;
    pom,pp,ppp: integer;
begin
    vymena:=false;
    zniz:=false;

    if abs(y2-y1)>=abs(x2-x1) then
       begin pom:=x1; x1:=y1; y1:=pom;
             pom:=x2; x2:=y2; y2:=pom;
             vymena:=true;
       end;

    if x2<x1 then begin pom:=x1; x1:=x2; x2:=pom;
                        pom:=y1; y1:=y2; y2:=pom;
                  end;

    if y2<y1 then zniz:=true;
     dy:=abs(y2-y1);
     dx:=abs(x2-x1);
     x:=x1;
     y:=y1;
     p:=2*dy-dx;
     pp:=2*dy;
     ppp:=pp-2*dx;

     while x<=x2 do
        begin
         if vymena then bod(y,x,farba) else bod(x,y,farba);
         if p<=0 then p:=p+pp else begin p:=p+ppp;
                                        if zniz then dec(y) else inc(y);
                                  end;
         inc(x);
        end;

         { bod(x,y,farba);
                if p<0 then p:=p+2*dy
                else begin p:=p+2*dy-2*dx;
                           y:=y+1;
                     end;
                inc(x);}
          end;


procedure nastav;
begin
asm
mov ah, 0
mov al, $11
int $10
end;
end;

procedure zrus;
begin
asm
mov ah, 0
mov al, 3
int $10
end;
end;

procedure nacitaniezosuboru;

var subor:text;
    i,j,k:integer;

begin
assign(subor,'obj.def');
reset(subor);

readln(subor,pocetbodov);
for i:=1 to pocetbodov do readln(subor,b[i].x, b[i].y, b[i].z);


readln(subor, pocethran);
for j:=1 to pocethran do readln(subor,h[j,0], h[j,1]);

readln(subor, pocetstien);
for k:=1 to pocetstien do readln(subor,s[k,0], s[k,1], s[k,2], s[k,3]);
readln(subor);
for i:=pocetbodov+1 to pocetbodov+pocetstien do readln(subor,b[i].x, b[i].y, b[i].z);
koniecbodov:=pocetbodov;
pocetbodov:=pocetbodov+pocetstien;
close(subor);
end;




procedure zobrazhrany(pocethran:integer; farba:integer);
var i:integer;

begin
for i:=1 to pocethran do usecka(round(b[h[i,0]].x), round(b[h[i,0]].y), round(b[h[i,1]].x),round(b[h[i,1]].y),farba );
end;

procedure zobrazsteny(cislosteny:integer;farba:byte);
var i:integer;

begin
for i:=0 to 2 do usecka(round(b[s[cislosteny,i]].x),round(b[s[cislosteny,i]].y), round(b[s[cislosteny,i+1]].x),
round(b[s[cislosteny,i+1]].y), farba);
usecka(round(b[s[cislosteny,3]].x), round(b[s[cislosteny,3]].y), round(b[s[cislosteny,0]].x),
 round(b[s[cislosteny,0]].y),farba);

end;



procedure kreslivid(farba:byte);
var i:integer;

begin
for i:=1 to pocetstien do
    if b[koniecbodov+i].z>0 then zobrazsteny(i,farba);
end;


{procedure ovladanie(vstup : char);
begin
     case vstup of
          'l':dolava;
         'p':doprava;
          'd':dole;
          'h':hore;
     end;         }

procedure otoceniez(fi:real; pocetbodov:integer );
var x,y,z: real;
    i:integer;
    cosinus, sinus:real;
begin cosinus:=cos(fi);
      sinus:=sin(fi);
      for i:=1 to pocetbodov do
      begin
      x:=b[i].x*cosinus-b[i].y*sinus ;
      y:=b[i].x*sinus+b[i].y*cosinus;
      z:=b[i].z;
      b[i].x:=x;
      b[i].y:=y;
      b[i].z:=z;
      end;
end;

procedure otoceniex(fi:real; pocetbodov:integer );
var x,y,z: real;
    i:integer;
    cosinus, sinus:real;
begin cosinus:=cos(fi);
      sinus:=sin(fi);
      for i:=1 to pocetbodov do
      begin
      x:=b[i].x ;
      y:=b[i].y*cosinus-b[i].z*sinus;
      z:=b[i].y*sinus+b[i].z*cosinus;
      b[i].x:=x;
      b[i].y:=y;
      b[i].z:=z;
      end;
end;

procedure otoceniey(fi:real; pocetbodov:integer );
var x,y,z: real;
    i:integer;
    cosinus, sinus:real;
begin cosinus:=cos(fi);
      sinus:=sin(fi);
      for i:=1 to pocetbodov do
      begin
      x:=b[i].x*cosinus+b[i].z*sinus ;
      y:=b[i].y;
      z:=-b[i].x*sinus+b[i].z*cosinus;
      b[i].x:=x;
      b[i].y:=y;
      b[i].z:=z;
      end;
end;

procedure posunutie(xs, ys, zs:integer; pocetbobov:integer);
var i: integer;
    x,y,z:real;
begin for i:=1 to pocetbodov do
       begin x:=b[i].x+xs;
             y:=b[i].y+ys;
             y:=b[i].z+zs;
             b[i].x:=x;
             b[i].y:=y;
             b[i].z:=z;
       end;
end;




procedure delay (p:integer);
var i,j : integer;
    pom: real;
begin
for j:=1 to 100 do
for i:=1 to p*1000 do
   pom:=sin(p/i);
end;


procedure vyplnenie(i:integer; farba:byte);
var
 j: integer;
 nuholnik: array[1..10] of PointType;
begin
{SetFillStyle(1, 3);}
for j:=1 to 4 do
  begin
  nuholnik[j].x:=round(b[s[i,j-1]].x);
  nuholnik[j].y:=round(b[s[i,j-1]].y);
  end;

  FillPoly(4, nuholnik);
end;

begin
{clrscr; }
 Gd := Detect;
 InitGraph(Gd, Gm, '');


{if GraphResult <> grOk then
   Halt(1);}
{nastav; }

nacitaniezosuboru;
delay(800);


SetFillStyle(1, 3);
for j:=1 to pocetstien do
  if b[koniecbodov+j].z>0 then
     vyplnenie(j,7);
kreslivid(15);
{zobrazhrany(pocethran,15);}

delay(500);
for i:=20 downto 1 do
begin

delay(550);
SetFillStyle(1, 0);
for j:=1 to pocetstien do
  if b[koniecbodov+j].z>0 then
     vyplnenie(j,0);
kreslivid(0);

otoceniez(PI/36, pocetbodov);
otoceniex(PI/36, pocetbodov);
delay(400);

SetFillStyle(1, 3);
for j:=1 to pocetstien do
  if b[koniecbodov+j].z>0 then
     vyplnenie(j,7);
{posunutie(100,100,100, pocetbodov);}
kreslivid(15);
end;
readln;

zrus;





{for i:=100 to 300 do
  begin
        usecka(200,200,100,i,3);
        usecka(200,200,300,i,3);
        usecka(200,200,i,100,3);
        usecka(200,200,i,300,3);

  end;
{usecka(50,50,300,200,3);
{for i:=1 to 80*8 do
 kreslibod(i,i,random(255));
{mem[$a000 :(10*320+i-1) ]:=4;
readln;
zrus;            }


end.