uses crt,graph;
type tablica=array[0..16] of integer;
punkty=array[1..5] of pointtype;
keys=(ShiftUp,
ShiftDn,
shiftleft,
shiftright,
HOME,
TAB,
CR,
F1,
F2,
F3,
F4,
F5,
F6,
F7,
F8,
F9,
F10,
INS,
ESC);
const dl1=80;
dl2=30;
dl3=50;
pz2=-80;
pz3=20;
pz4=50;
pz5=100;
xp:tablica=(0,-dl1,dl1,dl1,-dl1,-dl2,dl2,dl2,-dl2,-dl3,dl3,dl3,-dl3,-dl3,dl3,0,0);
yp:tablica=(0,-dl1,-dl1,dl1,dl1,-dl2,-dl2,dl2,dl2,-dl3,-dl3,dl3,dl3,-dl3,dl3,-dl3,dl3);
zp:tablica=(-100,pz2,pz2,pz2,pz2,pz3,pz3,pz3,pz3,pz4,pz4,pz4,pz4,pz5,pz5,pz4,pz4);
stala=0.9;
var k:real;
koniec:boolean;
katpoz,katpion:integer;
x,y,z:tablica;
function key:keys;
var ch:char;
begin
ch:=readkey;
if ch=#0 then
begin
ch:=readkey;
case ch of
#59:key:=F1;
#60:key:=F2;
#61:key:=F3;
#62:key:=F4;
#63:key:=F5;
#64:key:=F6;
#65:key:=F7;
#66:key:=F8;
#71:key:=home;
#72:key:=ShiftUp;
#75:key:=shiftleft;
#77:key:=shiftright;
#80:key:=ShiftDn;
#82:key:=ins;
end
end
else
case ch of
#9 :key:=TAB;
#13:key:=CR;
#27:key:=ESC;
end;
end;
procedure inicjuj;
var gd,gm:integer;
x,y:word;
begin
gd:=9;
gm:=2;
initgraph(gd,gm,'c:\tp70\bgi');
setviewport(getmaxx div 2,getmaxy div 2,getmaxx,getmaxy,clipoff);
getaspectratio(x,y);
k:=x/y;
end;
procedure translacja(p1,p2,p3,p4:byte{;w1,sr,w2:byte});
var pun:punkty;
wz,wx,wy,z1,z2,x1,x2,y1,y2:integer;
begin
{ x1:=x[sr]-x[w1];
x2:=x[sr]-x[w2];
y1:=y[sr]-y[w1];
y2:=y[sr]-y[w2];}
x1:=x[p1]-x[p2];
x2:=x[p3]-x[p2];
y1:=y[p1]-y[p2];
y2:=y[p3]-y[p2];
z1:=z[p1]-z[p2];
z2:=z[p1]-z[p2];
wz:=x1*y2-y1*x2;
wx:=y1*z2-z1*y2;
wy:=x1*z2-x2*z1;
wz:=round((-wy+wz)/sqr(2));
{ if wz<=0 then}
begin
pun[1].x:=round(x[p1]+z[p1]*stala);
pun[1].y:=round(k*(y[p1]-z[p1]*stala));
pun[2].x:=round(x[p2]+z[p2]*stala);
pun[2].y:=round(k*(y[p2]-z[p2]*stala));
pun[3].x:=round(x[p3]+z[p3]*stala);
pun[3].y:=round(k*(y[p3]-z[p3]*stala));
pun[4].x:=round(x[p4]+z[p4]*stala);
pun[4].y:=round(k*(y[p4]-z[p4]*stala));
pun[5]:=pun[1];
drawpoly(5,pun);
end;
end;
procedure oblicz_punkty;
var z1,x1,y1,i:integer;
kat1,kat2:real;
begin
kat1:=2*pi*katpoz/360;
kat2:=2*pi*katpion/360;
for i:=0 to 16 do
begin
x1:=round(xp[i]*cos(kat1)+zp[i]*sin(kat1));
z1:=round(-xp[i]*sin(kat1)+zp[i]*cos(kat1));
x[i]:=x1;
y1:=round(yp[i]*cos(kat2)+z1*sin(kat2));
z[i]:=round(-yp[i]*sin(kat2)+z1*cos(kat2));
y[i]:=y1;
end;
end;
procedure narysuj_figure;
begin
{1}
oblicz_punkty;
cleardevice;
translacja(0,1,2,0{,0,1,2});
translacja(0,2,3,0);
translacja(0,3,4,0);
translacja(0,4,1,0);
translacja(1,5,6,2);
translacja(2,6,7,3);
translacja(3,7,8,4);
translacja(4,8,5,1);
translacja(5,9,10,6);
translacja(6,10,11,7);
translacja(7,11,12,8);
translacja(8,12,9,5);
translacja(9,13,16,9);
translacja(12,13,16,12);
translacja(9,13,12,9);
translacja(16,14,10,16);
translacja(10,14,11,10);
translacja(11,14,16,11);
end;
begin
inicjuj;
koniec:=false;
katpoz:=0;
katpion:=0;
repeat
narysuj_figure;
case key of
ESC:koniec:=true;
shiftup:inc(katpion,5);
shiftdn:dec(katpion,5);
shiftleft:inc(katpoz,5);
shiftright:dec(katpoz,5);
end;
until koniec;
closegraph;
end.