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.