DUzun's Web
Programare, proiecte personale, divertisment

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.

​