DUzun's Web
Programare, proiecte personale, divertisment

unit Grph3d;

interface

uses graph, D3, Fig3D, Dos, mouse;

var mx,my,ex,ey:integer;

    viewu:real;

    Page:boolean;

    rx,ry,vm:byte;

​

procedure init(way:byte);

procedure ChgPg;

Procedure ShowInfo;

Procedure SetViewU(a:integer);

function Tex(x:longint):string;

Procedure GetUngls;

Procedure SPLine(p1,p2:point);

Procedure Sfer(p:point;r:integer);

Procedure SPTriangle(p1,p2,p3:point);

Procedure VecLine(v:vector;p:point);

​

implementation

​

Procedure VecLine;

var x1,x2,y1,y2:integer;

 begin

​

 end;

 Procedure ShowInfo;

  var r:real;

 begin

{Map}

 r:=100000;

 setcolor($67);

 circle(ex-25,my-51,50);

 circle(ex-25-round((sin(a))*50),my-51-round((cos(a))*50),5);

 circle(ex-25-round((cos(a)*o[3]-sin(a)*o[1])/r),my-51+round((sin(a)*o[3]+cos(a)*o[1])/r),2);

 for i:=0 to fig.nFig-1 do with fig.Figs[i]^do begin

  setcolor(Clr^);

  putpixel(ex-25+round((cos(a)*(ac[3]-o[3])-sin(a)*(ac[1]-o[1]))/r),my-51-round((sin(a)*(ac[3]-o[3])+cos(a)*(ac[1]-o[1]))/r));

 end;

​

{Info}

 outtextxy(2,2,'a:'+tex(round(g(a)))); outtextxy(2,17,'b:'+tex(round(-g(b))));

 outtextxy(2,32,'x:'+tex(o[1])); outtextxy(2,47,'y:'+tex(o[2])); outtextxy(2,62,'z:'+tex(o[3]));

 outtextxy(2,my-22,'V:'+tex(round(vmodul(mv))));

 end;

​

Procedure SPTriangle;

begin

 spline(p1,p2);spline(p2,p3);spline(p3,p1);

end;

​

Procedure SPLine;

 var r1,r2:real;c1,c2:longint;

 begin

   c1:=PCrd(p1,1);

   if(c1>0)then begin c2:=PCrd(p2,1);if(c2>0)then begin

    r1:=DphP(c1);r2:=DphP(c2);

    line(ex+round(pCrd(p1,3)*r1),ey-round(PCrd(p1,2)*r1),

         ex+round(PCrd(p2,3)*r2),ey-round(PCrd(p2,2)*r2));

   end end

 end;

​

​

Procedure Sfer;

 begin

  TLi:=PCrd(p,1);

  if TLi>0 then begin

   TR:=DphP(TLi);

   circle(ex+round(PCrd(p,3)*TR),ey-round(PCrd(p,2)*TR),round(r*TR));

  end;

 end;

​

 procedure init;

begin

way:=way-1;

  Repeat

 inc(way);

 case way of

1:SetSVGAMode(1280, 1024, 16, LfbOrBanked);

2:SetSVGAMode(800, 600, 16, LfbOrBanked);

3:SetSVGAMode(800, 600, 8, LfbOrBanked);

4:SetSVGAMode(640, 480, 32, LfbOrBanked);

5:SetSVGAMode(640, 480, 16, LfbOrBanked);

6:SetSVGAMode(640, 480, 8, LfbOrBanked);

 end;

  Until (GraphResult=0)or(way>6);

If way>6 then writeln('Sorry, but there was an error while initializing graphic mode')

         else begin

OutTextXY(270, 230, 'Please wait...');

drawborder:=false;

mx:=getmaxx+1;my:=getmaxy+1;

ex:=mx div 2;ey:=my div 2;

initmouse;

SetMouseRange(0, 0, rx*361, ry*180);

SetMousePos(round(a)*rx,round(b+90)*ry);

          end;

end;

​

 procedure ChgPg;

begin

  if Page then begin

    SetActivePage(0);SetVisualPage(1,true);

    Page:=false;

  end else begin

    SetActivePage(1);SetVisualPage(0,true);

    Page:=true;

  end;

  ClearPage;

end;

​

 Procedure GetUngls;

   begin

 a:=getmousex;

 b:=getmousey;

 if a=361*rx then setmousepos(rx,round(b));

 if a=0 then setmousepos(360*rx,round(b));

 a:=r(a/rx);b:=r(b/ry-90);

   end;

 Procedure SetViewU(a:integer);

 Begin

   if a <1 then else begin

  a:=(a-1) mod 80+1;

  viewu:=r(a);

  deeph:=ex*cos(viewu)/sin(viewu);

   end;

 End;

​

 function tex(x:longint):string;

var st:string;

begin

     str(x,st);tex:=st;

end;

​

Begin

     vm:=6;

     page:=true;

     deeph:=1200;

     rx:=4;

     ry:=8;

End.

​