DUzun's Web
Programare, proiecte personale, divertisment

  uses graph,crt,tuspace,OpenFgr,windos;

type VPunct=record vx,vy,vz:longint end;

​

var vp:array[1..200]of vpunct;

    h,i,a,b,c:integer;

    U,rat:Integer;

    cerc,deeph:boolean;

    DirInfo: TSearchRec;

    fn:string;

    gm:byte;

​

Procedure putinvirt(f:figura);

var i:integer;

 begin

  i:=1;

  with f do while p[i]<>nil do begin

   with p[i]^,vp[i] do rotsp(a,b,c,x,y,z,vx,vy,vz);

   inc(i);

  end;

 end;

​

Function Rap(t,u:integer):integer;

 begin

  rap:=round(h*t/(h+u));

 end;

​

procedure sfLine(n1,n2:integer);

var cl:word;

    x1,x2,y1,y2:integer;

 begin

 cl:=(vp[n1].vz+vp[n2].vz)div (rat div 2);

 setcolor(getcolor-cl);

  with vp[n1] do if deeph then begin

   x1:=ex+rap(vx,vz);

   y1:=ey+rap(vy,vz);

   x2:=ex+rap(vp[n2].vx,vp[n2].vz);

   y2:=ey+rap(vp[n2].vy,vp[n2].vz);

  end else begin

    x1:=ex+vx;

    y1:=ey+vy;

    x2:=ex+vp[n2].vx;

    y2:=ey+vp[n2].vy;

  end;

  line(x1,y1,x2,y2);

  {outtextxy(x1,y1,tex(n1));

  outtextxy(x2,y2,tex(n2));}

  setcolor(getcolor+cl);

 end;

​

​

begin

 gm:=6;

 Init(gm);

 randomize;

 a:=0;b:=0;c:=0;rat:=(mx+my)div 3;deeph:=true;cerc:=false;

 h:=mx+my+rat;

 if ParamStr(1)='' then begin

  FindFirst('*.fgr', faanyfile, DirInfo);

  fn:=DirInfo.Name;

 end else fn:=ParamStr(1);

 readfile(fn);

 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;

  putinvirt(f);with f do

  for i:=1 to nl do with ls[i]^ do sfline(n1,n2);

  if cerc then circle(ex,ey,my div 2-4);

   changepage;

  until keypressed;

  key:=readkey;

  case key of

   's':readkey;

   'c':setcolor(random($ffff));

   'd':deeph:=not deeph;'f':cerc:=not cerc;

   'm':begin gm:=(gm+4)mod 6 +1;Init(gm);end;

   'n':if paramstr(1)='' then begin FindNext(dirinfo);fn:=dirinfo.name;readfile(fn);end;

  end;

​

 until key=#27;

 closegraph;

{ textmode(258);

 writeln;

with f do begin

 for i:=1 to nl do with ls[i]^ do writeln(n1:2,#32,n2:2);     writeln;

 for i:=1 to np do with p[i]^ do writeln(x:5,#32,y:5,#32,z:5);writeln;

end;

readkey;}

halt(0);

end.

​