Лаба Лаб 1-4; ПЗ 1-4 Все лабы по дисциплине Условия - в методе из ЭУМК (Пешков АТ) [Вариант 10] / Архив указанных лаб / LAB4_10

program lab4_10;

uses
crt,graph;

const
prism : array[1..8,1..3] of real = ((300,170,0),
(300,170,100),
(500,170,100),
(500,170,0),
(300,320,0),
(300,320,100),
(500,320,100),
(500,320,0));
edge : array [1..12,1..2] of byte = ((1,2),
(1,4),
(1,5),
(2,3),
(2,6),
(3,4),
(3,7),
(4,8),
(5,8),
(5,6),
(6,7),
(7,8));
sk1 : array [1..6,1..4] of byte = ((1,2,6,4),
(1,5,10,3),
(4,7,11,5),
(6,8,12,7),
(2,3,9,8),
(9,10,11,12));
skeleton : array [1..6,1..4] of byte =((1,4,3,2),
(1,2,6,5),
(6,2,3,7),
(7,3,4,8),
(8,4,1,5),
(6,7,8,5));
TransMatr : array[1..4,1..4] of real =((1,0,0,0),
(0,1,0,0),
(0.70710678,0.70710678,0,0),
(0,0,0,1));

var
gd,gm:integer;
seeedge:array[1..6] of boolean;
Matr2D:array[1..8,1..2] of real;
chk:byte;

procedure ConvTo2D;
var
i:byte;
begin
for i:=1 to 8 do
begin
Matr2D[i,1]:=prism[i,1]+prism[i,3]*sqrt(0.5 );
Matr2D[i,2]:=prism[i,2]+prism[i,3]*sqrt(0.5);
end
end;

procedure check;
var
c:boolean;
cnt:byte;
ax,bx,cx,ay,by,cy:real;
begin
for cnt:=1 to 6 do
begin
ax:=Matr2D[skeleton[cnt,1],1];
ay:=Matr2D[skeleton[cnt,1],2];
bx:=Matr2D[skeleton[cnt,2],1];
by:=Matr2D[skeleton[cnt,2],2];
cx:=Matr2D[skeleton[cnt,3],1];
cy:=Matr2D[skeleton[cnt,3],2];
seeedge[cnt]:=((ax*by+ay*cx+bx*cy-by*cx-ay*bx-cy*ax)>0)
end
end;

procedure retsc(r:byte; var e1,e2:byte);
var
i,j:byte;
begin
e1:=0;
e2:=0;
for i:=1 to 6 do
for j:=1 to 4 do
if r=sk1[i,j] then
if e1<>0 then e2:=i else e1:=i;
end;

procedure DrawPrism(an:integer);
var
i,j,e1,e2: byte;
begin
for i:=1 to 12 do
begin
retsc(i,e1,e2);
case chk of
1:
Line(round(Matr2D[edge[i,1],1]),round(Matr2D[edge[i,1],2]),round(Matr2D[edge[i,2],1]),round(Matr2D[edge[i,2],2]));
2:
begin
if ((seeedge[e1]) or (seeedge[e2])) then
SetLineStyle(SolidLn,0,NormWidth)
else SetLineStyle(DashedLn,0,NormWidth);
Line(round(Matr2D[edge[i,1],1]),round(Matr2D[edge[i,1],2]),round(Matr2D[edge[i,2],1]),round(Matr2D[edge[i,2],2]));
end;
3:
if ((seeedge[e1]) or (seeedge[e2])) then
Line(round(Matr2D[edge[i,1],1]),round(Matr2D[edge[i,1],2]),round(Matr2D[edge[i,2],1]),round(Matr2D[edge[i,2],2]));
end;
end;
end;

procedure Turn;
var
phi,an:integer;
rvec:real;
i:byte;
zt,xt:real;
begin
an:=0;
for phi:=1 to 360 do
begin
for i:=1 to 8 do
if ((i<>1) and (i<>5)) then begin
zt:=prism[i,3];
xt:=prism[i,1];
prism[i,3]:=(zt-prism[1,3])*cos(-pi*1/180)-(xt-prism[1,1])*sin(-pi*1/180)+prism[1,3];
prism[i,1]:=(zt-prism[1,3])*sin(-pi*1/180)+(xt-prism[1,1])*cos(-pi*1/180)+prism[1,1];
end; ConvTo2D;
check;
Setcolor(Magenta);
DrawPrism(an);
Delay(5000);
Setcolor(White); DrawPrism(an);
end
end;

begin
writeln('Choose the kind of the model:');
writeln('1-wire frame model;');
writeln('2-dashed unvisible lines;');
writeln('3-opaque model.');
readln(chk);
gd:=detect;
gm:=0;
initgraph(GD,gm,'');
ConvTo2D;
check;
SetBkColor(White);
SetColor(Magenta);
DrawPrism(0);
ReadKey;
Setcolor(White); DrawPrism(0);
Turn;
Setcolor(Magenta); DrawPrism(0);
ReadKey;
closegraph;
end.