DUzun's Web
Programare, proiecte personale, divertisment

unit USpace;

interface

uses crt,graph,dos;

type Punct=record x,y,z:real end;

const o:punct=(x:0;y:0;z:0);

var h,i,j:longint;mx,my,ex,ey:integer;

    Page:boolean;key:char;

    dx,dy,dz,da,db,dl:real;

​

procedure init(way:byte);

procedure ChangePage;

function tex(x:longint):string;

function r(g:real):real;

function g(r:real):real;

Function ArcTg(y,x:real):real;

function distp(p1,p2:punct):real;

procedure RotAx(o:char;u:integer;x,y,z:longint;var ox,oy,oz:longint);

procedure RotSp(a,b,c:integer;x,y,z:longint;var ox,oy,oz:longint);

implementation

var cuv:string;

 procedure init(way:byte);

begin

way:=way-1;

  Repeat

way:=way+1;

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

drawborder:=false;randomize;

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

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

OutTextXY(ex-100, ey-10, 'Please wait...');

end;

 procedure ChangePage;

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;

function tex(x:longint):string;

var st:string;

begin

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

end;

​

 function r(g:real):real;

begin

r:=g*pi/180;

end;

 function g(r:real):real;

begin

g:=r*180/pi;

end;

    Function ArcTg(y,x:real):real;

 Var u:real;

begin

if x>0 then u:=arctan(y/x);

if x=0 then begin

if (y=0) then u:=0;

if (y>0) then u:=pi/2;

if (y<0) then u:=-pi/2;

end;

if x<0 then begin

if (y=0) then u:=-pi;

if (y>0) then u:=arctan(y/x)+pi;

if (y<0) then u:=arctan(y/x)-pi;

 end;

 Arctg:=u;

end;

 function distp(p1,p2:punct):real;

 begin

  distp:=sqr(p2.x-p1.x)+sqr(p2.y-p1.y)+sqr(p2.z-p1.z);

 end;

 procedure RotAx(o:char;u:integer;x,y,z:longint;var ox,oy,oz:longint);

var cx,cy,cz:longint;rad:real;

 begin

rad:=r(u);cx:=x;cy:=y;cz:=z;

   case o of 'x':begin

oy:=round(cy*cos(rad)-cz*sin(rad));

oz:=round(cz*cos(rad)+cy*sin(rad));

ox:=cx;end;   'y':begin

oz:=round(cz*cos(rad)-cx*sin(rad));

ox:=round(cx*cos(rad)+cz*sin(rad));

oy:=cy;end;   'z':begin

ox:=round(cx*cos(rad)-cy*sin(rad));

oy:=round(cy*cos(rad)+cx*sin(rad));

oz:=cz;end;

   end;

 end;

 procedure RotSp(a,b,c:integer;x,y,z:longint;var ox,oy,oz:longint);

 begin

RotAx('z',c,x,y,z,ox,oy,oz);

RotAx('y',b,ox,oy,z,ox,oy,oz);

RotAx('x',a,ox,oy,oz,ox,oy,oz);

 end;

Begin

page:=true;

End.

​