uses graph,crt,tuspace,dos;
const np=144;
type Punct=record x,y,z:longint end;
     VPunct=record vx,vy,vz:longint end;
var p:array[1..np]of punct;
    vp:array[1..np]of vpunct;
    h,a,b,c,rat:integer;
    cerc,deeph:boolean;

Function Rap(t,u:integer):integer;
 begin
  rap:=round(h*t/(h+u));
 end;
procedure sfLine(n1,n2:integer);
 begin
  with vp[n1] do if deeph then
  line(ex+rap(vx,vz),ey+rap(vy,vz),ex+rap(vp[n2].vx,vp[n2].vz),ey+rap(vp[n2].vy,vp[n2].vz)) else
  line(ex+vx,ey+vy,ex+vp[n2].vx,ey+vp[n2].vy);
 end;
procedure sfcircle(n1,r:integer);
 begin
 setcolor(getcolor-$fff);
  with vp[n1] do if deeph then
  circle(ex+rap(vx,vz),ey+rap(vy,vz),rap(r,vz)) else
  Circle(ex+vx,ey+vy,r);
 setcolor(getcolor+$fff);
 end;
Procedure Atrib;
 begin
  for i:=1 to np do with p[i] do begin
  x:=0;y:=rat;z:=0;
 end;p[np-1].y:=-p[np-1].y;

  for i:=1 to 12 do for j:=2 to 7 do
  with p[(i-1)*12+j] do RotAx('z',30*(j-1),x,y,z,x,y,z);

 for i:=1 to 12 do for j:=1 to 6 do
 with p[(i-1)*12+j] do RotAx('y',30*(i-1),x,y,z,x,y,z);
 end;
begin
 Init(2);
 randomize;
 rat:=(my+mx)div 5;a:=0;b:=0;c:=0;
 h:=mx+my+rat;deeph:=true;cerc:=true;
setcolor(random($ffff));
Atrib;
 repeat
  repeat
  inc(a);if a=360 then a:=0;
  inc(b);if b=360 then b:=0;
  inc(c);if c=360 then c:=0;

   for i:=1 to np do with p[i],vp[i] do rotsp(a,b,c,x,y,z,vx,vy,vz);
   for i:=1 to 12 do for j:=1 to 6 do sfline((i-1)*12+j,(i-1)*12+j mod 12+1);
   for i:=1 to 12 do for j:=1 to 6 do sfline((i-1)*12+j,(i mod 12)*12+j);
   for i:=1 to np do sfcircle(i,5);
   if cerc then circle(ex,ey,rat);

   changepage;
  until keypressed;
  key:=readkey;
  case key of
   '+':rat:=rat+3;'-':rat:=rat-3;
   's':readkey;
   'c':setcolor(random($ffff));
   'd':deeph:=not deeph;'f':cerc:=not cerc;
  end;
  atrib;
 until key=#27;
closegraph;
end.