DUzun's Web
Programare, proiecte personale, divertisment

Uses mouse,crt,graph,tuspace;

const maxd=500000;

type Scart=record x,y,z:longint;end;

     Sungl=record a,b:real;d:longint;end;

​

var Screen:^array[1..650,1..480]of longint;

    c:record x,y,z:longint;a,b:real;end;

​

    key:char;

    speed:real;

    deeph,viewu:real;

​

​

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;

​

Procedure Info;

begin

with c do begin

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

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

outtextxy(2,2+textheight('a')*2,'x:'+tex(x));

outtextxy(2,2+textheight('a')*3,'y:'+tex(y));

outtextxy(2,2+textheight('a')*4,'z:'+tex(z));

end;

end;

 function Unghi(a:real):real;

 Begin

 if a>pi then begin a:=a-pi;end;

 if a<-pi then begin a:=a+pi;end;

 Unghi:=a;

 a:=Unghi(a);

 End;

 Procedure SpPixel(x,y,z:real);

Var dx,dy,dz,da,db,pdx,pdz,d:real;

    px,py:longint;

​

function v(a:real):real;

begin

v:=arctg(ey,deeph)*cos(a);

end;

 Begin

  dx:=x+c.x;dz:=z+c.z;

  da:=(arctg(dx,dz)-c.a);

   if abs(da)<=viewu then begin

      dy:=y-c.y;pdx:=dx*dx;pdz:=dz*dz;

      db:=(arctg(dy,sqrt(pdx+pdz))-c.b);

      if abs(db)<=v(da) then begin

         d:=sqrt(pdx+pdz+dy*dy);

         if (d>deeph)and(d<maxd) then begin

         px:=round(sin(da)*deeph/cos(da));

         py:=round (sin(db)*deeph/(cos(db)*cos(da)));

         putpixel(px+ex,py+ey,random(100));

         end;

      end;

   end;

 End;

Procedure SpLine(x1,y1,z1,x2,y2,z2:real);

var lx,ly,lz,l:real;

 begin

  lx:=x2-x1;ly:=y2-y1;lz:=z2-z1;l:=sqrt(lx+ly+lz);

  lx:=lx/l;ly:=ly/l;lz:=lz/l;

   For i:=1 to round(l) do SpPixel(x1+i*lx,y1+i*ly,z1+i*lz);

 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;

begin

init;

randomize;

initmouse;

 SetMouseRange(0, 0, 1444, 1444); SetMousePos(720,720);

​

speed:=1000;

SetViewU(50);

​

with c do begin x:=0;y:=0;z:=0;a:=0;b:=0;end;

​

repeat

repeat

for i:=1 to 10 do for j:=1 to 30 do for h:= 1 to 10 do

    SpPixel((i)*4000,(j)*1000,h*8000);

 {SpLine(i*100,j*10,h*100,i*100+100,j*100+100,h*100+100);}

info;

changepage;

if getmousex=1444 then setmousepos(4,getmousey);

if getmousex=0 then setmousepos(1440,getmousey);

if getmousey=1444 then setmousepos(getmousex,4);

if getmousey=0 then setmousepos(getmousex,1440);

with c do begin

a:=r(getmousex/4-181);

b:=r(getmousey/4-181);

end;

until (keypressed)or(LeftButtonPressed)or(RightButtonPressed);

if LeftButtonPressed then key:=#80 else if RightButtonPressed then key:=#72 else

key:=readkey;

with c do case key of

#80:begin z:=z-round(cos(a)*cos(b)*speed);x:=x-round(sin(a)*cos(b)*speed);y:=y+round(sin(b)*speed)end;

#72:begin z:=z+round(cos(a)*cos(b)*speed);x:=x+round(sin(a)*cos(b)*speed);y:=y-round(sin(b)*speed)end;

#75:begin x:=x+round(cos(a)*cos(b)*speed);z:=z-round(sin(a)*cos(b)*speed)end;

#77:begin x:=x-round(cos(a)*cos(b)*speed);z:=z+round(sin(a)*cos(b)*speed)end;

'8':b:=b+r(1);'5':b:=b-r(1);

'4':a:=a+r(1);'6':a:=a-r(1);

's':speed:=speed+2;'S':speed:=speed-2;

'u':SetViewU(Round(G(ViewU)+1));'U':SetViewU(Round(G(ViewU)-1));

end;

until key=#27;

​

closegraph;

donemouse;

end.

​