DUzun's Web
Programare, proiecte personale, divertisment

unit Grph3d;

interface

uses graph, D3, Fig3D, Dos, Mouse, Keyboard, crt;

var

    mx,my,ex,ey: integer;

    msx, msy   : word;

    viewu      : real;

    Page       : byte;

    vm         : word;

​

procedure init(way:byte);

function  ChgPage: byte;

Procedure ShowInfo;

Procedure SetViewU(a:integer);

function  Tex(x:longint):string;

procedure GetMouseAngles;

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

  Repeat

  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);

    else

      SetSVGAMode(640, 480, 8, LfbOrBanked);

  end;

  inc(way);

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

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

  else begin

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

    DrawBorder:=false;

    mx:=getmaxx+1;   ex:=mx div 2;

    my:=getmaxy+1;   ey:=my div 2;

​

    InitMouse;

    SetMouseRange(0, 0, 2*msx, 2*msy);

    SetMousePos(msx, msy);

  end;

end;

​

function ChgPage: byte;

begin

  SetActivePage(Page mod 2);        {Pagina pe care se deseneaza}

  if(Page=255)then Page := 0 else

  inc(Page);                        {Page = 0 sau 1}

  SetVisualPage(Page mod 2, true);  {Pagina care se afiseaza}

  ClearViewPort;                    {Pagina activa se sterge}

  ChgPage := Page;

end;

​

procedure GetMouseAngles;

var b, x, y: word;

begin

   GetMouseInfo(B, X, Y);

   if((X+Y) <> 0) then begin

     IncAngles((GetMouseX-msx) / 8, (GetMouseY-msy) / 4);

     SetMousePos(msx, msy);

   end;

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  := 1;

     deeph := 1200;

     msx := 720;

     msy := 720;

End.

​