uses crt,graph;

label poz;

type
virsotnes=array[1..10,1..3]of real;
shkjautnes=array[1..10]of string;

const
n=10;
solis=0.05;
v0:virsotnes=((0,0,1),(-0.866,-0.5,0.33),(0.866,-0.5,0.33),(0,1,0.33),
(-0.866,-0.5,-0.33),(0.866,-0.5,-0.33),(0,1,-0.33),(0,0,-1),(0,0,-1.5),(0,0,1.5));
sh0:shkjautnes=('234','345','46','7','678','78','8','','8','1');

var
att,reiz:real;
i,j,k,d,m,h,p:integer;
q:char;
v:virsotnes;
sh:shkjautnes;

procedure koordin(s,x,y,z:real; var a,b:integer);
begin
if x*x=0 then begin a:=0; b:=round(s*z/(s-y)*reiz); end else
begin
a:=round(s*sqrt(x*x+z*z)/(s-y)/sqrt(1+z*z/x/x)*reiz);
b:=round(s*sqrt(x*x+z*z)/(s-y)/sqrt(1+z*z/x/x)*reiz*z/x);
end;
if x*a<0 then a:=-a;
if z*b<0 then b:=-b;
a:=a+320;
b:=b+240;
if p=2 then if k=2 then a:=a-160 else a:=a+160;
end;

procedure rotate(q:char; var x,y,z:real);
var
s:string;
h,alfa,beta,x1,y1,z1:real;
begin
if(q>'0')and(q<='9') then begin
alfa:=(1-(ord(q)-1) mod 3)*solis;
beta:=(1-(ord(q)-49) div 3)*solis;

if alfa<>0 then begin
if (x=0) and (y>0) then h:=pi/2 else
if (x=0) and (y<0) then h:=-pi/2 else
if x<>0 then h:=arctan(y/x);
if x<0 then h:=h+pi;
x1:=sqrt(x*x+y*y)*cos(h+alfa);
y1:=sqrt(x*x+y*y)*sin(h+alfa);
x:=x1;
y:=y1; end;

if beta<>0 then begin
if (y=0) and (z>0) then h:=pi/2 else
if (y=0) and (z<0) then h:=-pi/2 else
if y<>0 then h:=arctan(z/y);
if y<0 then h:=h+pi;
y1:=sqrt(y*y+z*z)*cos(h+beta);
z1:=sqrt(y*y+z*z)*sin(h+beta);
z:=z1;
y:=y1; end;
end else

if (q='a') or (q='d') then begin
if q='a' then alfa:=-solis else alfa:=solis;
if (x=0) and (z>0) then h:=pi/2 else
if (x=0) and (z<0) then h:=-pi/2 else
if x<>0 then h:=arctan(z/x);
if x<0 then h:=h+pi;
x1:=sqrt(x*x+z*z)*cos(h+alfa);
z1:=sqrt(x*x+z*z)*sin(h+alfa);
x:=x1;
z:=z1;
end;
end;

procedure linija(x,y,z,x1,y1,z1:real);
var
a,b:integer;
begin
koordin(att,x,y,z,a,b);
moveto(a,b);
koordin(att,x1,y1,z1,a,b);
lineto(a,b);
end;

procedure zimetObj;
var i,j:integer;
begin
cleardevice;
for k:=1 to p do begin
for i:=1 to n do
    for j:=1 to length(sh[i]) do
        begin
        h:=ord(sh[i,j])-48;
        linija(v[i,1],v[i,2],v[i,3],v[h,1],v[h,2],v[h,3]);
        end;
if p=2 then
if k=2 then
for i:=1 to n do
rotate('6',v[i,1],v[i,2],v[i,3]) else
for i:=1 to n do
rotate('4',v[i,1],v[i,2],v[i,3]);
end;

end;

function lasitTaust:boolean;
var w:boolean;
    i:integer;
begin
w:=false;
q:=readkey;
for i:=1 to n do
rotate(q,v[i,1],v[i,2],v[i,3]);
case q of
'w':begin reiz:=reiz+1; att:=350/reiz; end;
's':begin reiz:=reiz-1; att:=350/reiz; end;
'n':begin closegraph;  w:=true; end;
end;
lasitTaust:=w;
end;

procedure rediget;
var q:char;
    xx,yy,zz:real;
    h,a,b:integer;
    rinda:array[1..n,1..2]of integer;
    viet:array[1..n]of integer;
    i,j,ii,sel:integer;
procedure apredel;
var i,ii:integer;
begin
for i:=1 to n do
    begin
    k:=1;
    koordin(att,v[i,1],v[i,2],v[i,3],a,b);
    j:=1;
    while (j<i) and (a<rinda[j,1]) do inc(j);
    for ii:=i-1 downto j do begin
        rinda[ii+1,1]:=rinda[ii,1];
        rinda[ii+1,2]:=rinda[ii,2];
        viet[ii+1]:=viet[ii]; end;
    rinda[j,1]:=a;
    rinda[j,2]:=b;
    viet[j]:=i;
    end;
end;
begin
apredel;
setfillstyle(1,4);
sel:=1;
setcolor(yellow);
zimetObj;
repeat
setcolor(red);
fillellipse(rinda[sel,1],rinda[sel,2],4,4);
if p=2 then
begin
k:=2;
xx:=v[viet[sel],1];
yy:=v[viet[sel],2];
zz:=v[viet[sel],3];
rotate('4',xx,yy,zz);
koordin(att,xx,yy,zz,a,b);
fillellipse(a,b,4,4);
end;
repeat q:=readkey; until (q=',') or (q='.') or (q='e') or (q=#27) or (q=#13);
if q=',' then inc(sel) else
if q='.' then dec(sel);
if sel=0 then sel:=n;
if sel=n+1 then sel:=1;
if q=#13 then begin
setcolor(yellow);
zimetObj;
repeat
repeat q:=readkey;
until(q='a')or(q='s')or(q='d')or(q='w')or(q='+')or(q='-')or(q=#13)or(q=#27)or(q='e');
case q of
'a':v[viet[sel],1]:=v[viet[sel],1]-0.05;
's':v[viet[sel],3]:=v[viet[sel],3]+0.05;
'd':v[viet[sel],1]:=v[viet[sel],1]+0.05;
'w':v[viet[sel],3]:=v[viet[sel],3]-0.05;
'-':v[viet[sel],2]:=v[viet[sel],2]-0.05;
'+':v[viet[sel],2]:=v[viet[sel],2]+0.05;
end;
setcolor(yellow);
zimetObj;
if(q=#13)or(q=#27)or(q='e') then begin q:=#1;apredel;end;
until(q=#1);
end;
setcolor(yellow);
zimetObj;
until (q='e') or (q=#27);
setcolor(15);
zimetObj;
q:=#0;
end;

begin
poz:
textcolor(15);
clrscr;
v:=v0;
sh:=sh0;
writeln('(1) Parastais skats');
writeln('(2) 3D skats');
p:=0;
repeat
p:=ord(readkey)-48;
until (p=1) or (p=2);
if p=2 then reiz:=80 else reiz:=130;
att:=350/reiz;
initgraph(d,m,'');
setcolor(15);
repeat
setcolor(15);
zimetObj;
if lasitTaust then goto poz;
if q='e' then rediget;
until (q=#27) or (q=#13);
closegraph;
end.