uses graph,crt,tuspace,dos;
const np=12;
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;
    U: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);
{with vp[n1]do  outtextxy(ex+vx,ey+vy,tex(n1));}
 setcolor(getcolor+$fff);
 end;
Procedure Atrib;
 begin
 u:=round(g(2*arctan(2/(sqrt(5)+1))));
  for i:=1 to np do with p[i] do begin
  x:=0;y:=rat;z:=0;
 end;
  for i:=7 to np do with p[i] do y:=-Y;

  for i:=2 to np-1 do
  with p[i] do RotAx('z',u,x,y,z,x,y,z);

  for i:=2 to 6 do with p[i] do RotAx('y',72*i,x,y,z,x,y,z);
  for i:=7 to np-1 do with p[i] do RotAx('y',72*(i-3),x,y,z,x,y,z);
 end;
begin
 Init(6);
 randomize;
 rat:=(my+mx)div 5;a:=0;b:=0;c:=0;
 h:=mx+my+rat;deeph:=true;cerc:=false;
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:=2 to 6 do sfline(1,i);for i:=7 to np-1 do sfline(np,i);
for I:=2 to 6 do begin
 sfLine(i,(i-1)mod 5+2);
 sfLine(i+5,(i-1)mod 5+7);
 sfLine(i,i+5);
 sfLine(i,(i-1)mod 5+7);
end;

 {  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.