program kg;
uses crt,graph,windos;
var vx,vy,vz,tx,ty,tz:array[0..61] of double;
drv,mode,i,x0,y0,p:integer; q,outa:string;
r,a,ks,ax,ay,az,rad,zc,z:real; help,n:byte;
xi,yi:array[0..61] of integer;
procedure mline(x:integer);
begin
lineto(xi[x],yi[x]);
end;
procedure mmove(x:integer);
begin
moveto(xi[x],yi[x]);
end;
procedure spinx;{rotate around x}
begin
ax:=ax+a;
for i:=0 to n do begin
vy[i]:=(vy[i]*cos(a)-vz[i]*sin(a))*ks;
vz[i]:=(vz[i]*cos(a)+vy[i]*sin(a))*ks;
end;
end;
procedure spinmx;{-rotate around x}
begin
ax:=ax-a;
for i:=0 to n do begin
vy[i]:=(vy[i]*cos(-a)-vz[i]*sin(-a))*ks;
vz[i]:=(vz[i]*cos(-a)+vy[i]*sin(-a))*ks;
end;
end;
procedure spiny;{rotate around y}
begin
ay:=ay-a;
for i:=0 to n do begin
vx[i]:=(vx[i]*cos(a)+vz[i]*sin(a))*ks;
vz[i]:=(vz[i]*cos(a)-vx[i]*sin(a))*ks;
end;
end;
procedure spinmy;{-rotate around x}
begin
ay:=ay+a;
for i:=0 to n do begin
vx[i]:=(vx[i]*cos(-a)+vz[i]*sin(-a))*ks;
vz[i]:=(vz[i]*cos(-a)-vx[i]*sin(-a))*ks;
end;
end;
procedure spinz;{rotate around z}
begin
az:=az+a;
for i:=0 to n do begin
vx[i]:=(vx[i]*cos(a)-vy[i]*sin(a))*ks;
vy[i]:=(vy[i]*cos(a)+vx[i]*sin(a))*ks;
end;
end;
procedure spinmz;{-rotate around z}
begin
az:=az-a;
for i:=0 to n do begin
vx[i]:=(vx[i]*cos(-a)-vy[i]*sin(-a))*ks;
vy[i]:=(vy[i]*cos(-a)+vx[i]*sin(-a))*ks;
end;
end;
begin
n:=61;
drv:=9;mode:=1;
initgraph(drv,mode,''); {enter graph mode}
setfillstyle(0,0);
r:=-0.08; {-1/Zc <Zc-cam. dist.>}
help:=0;
z:=15; {zoom value}
rad:=180/Pi; {degrees in 1 radian}
ax:=0;ay:=0;az:=0; {vertex coords}
{vx[0]:=0;vy[0]:=0;vz[0]:=0;
vx[1]:=1;vy[1]:=0;vz[1]:=0;
vx[2]:=1;vy[2]:=1;vz[2]:=0;
vx[3]:=0;vy[3]:=1;vz[3]:=0; {cube
vx[4]:=0;vy[4]:=1;vz[4]:=1;
vx[5]:=0;vy[5]:=0;vz[5]:=1;
vx[6]:=1;vy[6]:=0;vz[6]:=1;
vx[7]:=1;vy[7]:=1;vz[7]:=1; }
vx[0]:=-5;vy[0]:=4;vz[0]:=-2; {body r/l side}
vx[1]:=5;vy[1]:=4;vz[1]:=-2;
vx[2]:=5;vy[2]:=-4;vz[2]:=-2;
vx[3]:=4;vy[3]:=-4;vz[3]:=-2;
vx[4]:=4;vy[4]:=0;vz[4]:=-2;
vx[5]:=-4;vy[5]:=0;vz[5]:=-2;
vx[6]:=-4;vy[6]:=-4;vz[6]:=-2;
vx[7]:=-5;vy[7]:=-4;vz[7]:=-2;
for i:=8 to 15 do begin
vx[i]:=vx[i-8];vy[i]:=vy[i-8];vz[i]:=2;
end; {body r/l side end}
vx[16]:=5;vy[16]:=4;vz[16]:=0.5; {tail}
vx[19]:=5;vy[19]:=4;vz[19]:=-0.5;
vx[18]:=5;vy[18]:=3;vz[18]:=-0.5;
vx[17]:=5;vy[17]:=3;vz[17]:=0.5;
vx[20]:=7.5;vy[20]:=1;vz[20]:=-0.4;
vx[21]:=7;vy[21]:=0.5;vz[21]:=-0.4;
vx[22]:=7;vy[22]:=0.5;vz[22]:=0.4;
vx[23]:=7.5;vy[23]:=1;vz[23]:=0.4;
vx[24]:=5;vy[24]:=-4;vz[24]:=-1; {legs}
vx[25]:=4;vy[25]:=-4;vz[25]:=-1;
vx[26]:=-4;vy[26]:=-4;vz[26]:=-1;
vx[27]:=-5;vy[27]:=-4;vz[27]:=-1;
vx[28]:=5;vy[28]:=-4;vz[28]:=1;
vx[29]:=4;vy[29]:=-4;vz[29]:=1;
vx[30]:=-4;vy[30]:=-4;vz[30]:=1;
vx[31]:=-5;vy[31]:=-4;vz[31]:=1;
for i:=32 to 39 do begin
vx[i]:=vx[i-8];vz[i]:=vz[i-8];
vy[i]:=0
end; {legs end}
vx[40]:=-8;vy[40]:=3.5;vz[40]:=-1.5;{head}
vx[41]:=-8;vy[41]:=1.5;vz[41]:=-1.5;
vx[42]:=-8;vy[42]:=1.5;vz[42]:=1.5;
vx[43]:=-8;vy[43]:=3.5;vz[43]:=1.5;
for i:=44 to 47 do begin
vx[i]:=-5;vy[i]:=vy[i-4];vz[i]:=vz[i-4];end;
vx[48]:=-9;vy[48]:=2.5;vz[48]:=0.5;
vx[49]:=-9;vy[49]:=1.7;vz[49]:=0.5;
vx[50]:=-9;vy[50]:=1.7;vz[50]:=-0.5;
vx[51]:=-9;vy[51]:=2.5;vz[51]:=-0.5;
vx[52]:=-10.5;vy[52]:=2.1;vz[52]:=-0.1;
vx[53]:=-10.5;vy[53]:=1.9;vz[53]:=-0.1;
vx[54]:=-10.5;vy[54]:=1.9;vz[54]:=0.1;
vx[55]:=-10.5;vy[55]:=2.1;vz[55]:=0.1; {head end}
vx[56]:=-7;vy[56]:=3.5;vz[56]:=-1.5; {ears}
vx[57]:=-7;vy[57]:=5;vz[57]:=-1;
vx[58]:=-7;vy[58]:=3.5;vz[58]:=-0.5;
vx[59]:=-7;vy[59]:=3.5;vz[59]:=0.5;
vx[60]:=-7;vy[60]:=5;vz[60]:=1;
vx[61]:=-7;vy[61]:=3.5;vz[61]:=1.5; {ears end}
setcolor(14);
x0:=320; {screen center}
y0:=175;
p:=0;
for i:=0 to n do begin {set temp coords}
{vx[i]:=vx[i]-0.5;
vy[i]:=vy[i]-0.5;
vz[i]:=vz[i]-0.5; }
tx[i]:=vx[i];
ty[i]:=vy[i];
tz[i]:=vz[i];
end;
a:=0.01; {angle}
ks:=1;
repeat
q:=#0;
if keypressed then case readkey of {key controls}
'd': spiny;
'a': spinmy;
'x': begin spiny; spinx; spinz; end;
's': spinx;
'w': spinmx;
'q': spinz;
'e': spinmz;
#75: for i:=0 to n do vx[i]:=vx[i]-0.04;
#77: for i:=0 to n do vx[i]:=vx[i]+0.04;
#72: for i:=0 to n do vy[i]:=vy[i]+0.04;
#80: for i:=0 to n do vy[i]:=vy[i]-0.04;
'r': begin
ax:=0;ay:=0;az:=0;
for i:=0 to n do begin
vx[i]:=tx[i];
vy[i]:=ty[i];
vz[i]:=tz[i];
end; end;
#59: if help=0 then help:=1 else help:=0;
'+': z:=z+0.5;
'-': if z>0 then z:=z-0.5;
',': if r>(-0.14) then r:=r-0.001;
'.': if r<0 then r:=r+0.001;
#27:exit;
end;
if r>0 then r:=0; {3d to 2d coords}
for i:=0 to n do begin
xi[i]:=round(x0+(vx[i]/(r*vz[i]+1))*z);
yi[i]:=round(y0-(vy[i]/(r*vz[i]+1))*z);
end ;
if p=0 then begin setactivepage(1); setvisualpage(0);end else begin
setactivepage(0); {switch page to avoid image flicker}
setvisualpage(1) ;end;
bar(0,0,640,350); {draw object}
{moveto(xi[0],yi[0]);
for i:=0 to 3 do
lineto(xi[i],yi[i]);
lineto(xi[0],yi[0]);
lineto(xi[5],yi[5]);
for i:=4 to 7 do
lineto(xi[i],yi[i]);
lineto(xi[4],yi[4]);
lineto(xi[7],yi[7]);
lineto(xi[2],yi[2]);
lineto(xi[1],yi[1]);
lineto(xi[6],yi[6]);
moveto(xi[4],yi[4]);
lineto(xi[3],yi[3]); }
mmove(0);
for i:=1 to 7 do mline(i);
mline(0);
mmove(8);
for i:=9 to 15 do mline(i);
mline(8);
mline(0);
mmove(1);
mline(9);
mmove(16);
for i:=17 to 23 do mline(i);
mline(20);
mmove(16);
mline(23);
mmove(22);
mline(17);
mmove(18);
mline(21);
mmove(2);mline(24);mline(25);mline(3);
mmove(6);mline(26);mline(27);mline(7);
mmove(10);mline(28);mline(29);mline(11);
mmove(14);mline(30);mline(31);mline(15);
mmove(24);mline(32);mline(33);mline(25);mmove(4);mline(33);
mmove(26);mline(34);mline(35);mline(27);mmove(5);mline(34);
mmove(28);mline(36);mline(37);mline(29);mmove(12);mline(37);
mmove(30);mline(38);mline(39);mline(31);mmove(13);mline(38);
mmove(36);mline(32);mmove(39);mline(35);
mmove(40);mline(41);mline(42);mline(43);mline(40);
mline(44);mline(45);mline(46);mline(47);mline(44);
mmove(45);mline(41);mmove(46);mline(42);mmove(47);mline(43);
mline(48);mline(49);mline(50);mline(51);mline(48);
mmove(49);mline(42);mmove(50);mline(41);mmove(40);mline(51);
mline(52);mline(53);mline(54);mline(55);mline(52);
mmove(48);mline(55);mmove(54);mline(49);mmove(53);
mline(50);
mmove(56);mline(57);mline(58);
mmove(59);mline(60);mline(61);mline(59);mmove(58);mline(56);
outtextxy(0,0,'F1:key help'); {help text}
if help=1 then begin
outtextxy(0,8,'wsad:rotate xy');
outtextxy(0,16,'qe:rotate z');
outtextxy(0,24,'arrows:pan');
outtextxy(0,32,'+-:zoom in/out');
outtextxy(0,40,'r:reset object position');
outtextxy(0,48,'hold x:spin');
outtextxy(0,56,',.:inc/dec Zc');
outtextxy(0,64,'esc:exit');
end; {if angle=360 then angle:=0}
if abs(ax)>=2*Pi then ax:=abs(ax)-2*Pi;
if abs(ay)>=2*Pi then ay:=abs(ay)-2*Pi;
if abs(az)>=2*Pi then az:=abs(az)-2*Pi;
str((ax*rad):3:2,outa); {write xyz angles}
outtextxy(592,0,outa);
str((ay*rad):3:2,outa);
outtextxy(592,8,outa);
str((az*rad):3:2,outa);
outtextxy(592,16,outa);
if r<0 then begin {write cam. dist.}
zc:=-1/r;
str(zc:3:2,outa);
outtextxy(592,24,outa);
end else outtextxy(592,24,'inf.');
outtextxy(578,0,'X:');
outtextxy(578,8,'Y:');
outtextxy(578,16,'Z:');
outtextxy(570,24,'Zc:');
if p=0 then begin setvisualpage(0);p:=1;end else begin setvisualpage(1);
p:=0; {switch page}
end;
until q=chr(27);
closegraph; {exit graph mode}
end.