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

program lab2_10;

uses crt,graph,cohen;

const
M1 : array[1..4,1..2] of real =((20,20),
(250,20),
(250,180),
(20,180));
M2: array[1..3,1..2] of real =((500,300),
(600,400),
(400,400));
W1: array[1..2,1..2] of integer =((100,100),
(500,400));
W2: array[1..2,1..2] of integer = ((200,250),
(400,400));

D:integer=1;
var
X,xc1,xc2,xc3,xc4,yc1,yc2,yc3,yc4: real;
check:boolean;
gd,gm:integer;
DXY: array[1..4,1..2] of real;
M,MM: array[1..4] of integer;
Y, Q, P: array[1..4] of real;
i:byte;

procedure DrawWindow;
begin
MoveTo(w1[1,1],w1[1,2]);
LineTo(w1[2,1],w1[1,2]);
LineTo(w1[2,1],w1[2,2]);
LineTo(w1[1,1],w1[2,2]);
LineTo(w1[1,1],w1[1,2]);
MoveTo(w2[1,1],w2[1,2]);
LineTo(w2[2,1],w2[1,2]);
LineTo(w2[2,1],w2[2,2]);
SetColor(White);
LineTo(w2[1,1],w2[2,2]);
Setcolor(Magenta);
LineTo(w2[1,1],w2[1,2]);
end;

procedure Dr(x1,x2,x3,x4,y1,y2,y3,y4:real;kind:byte);
var
minx,maxx,miny,maxy:integer;
begin
case kind of
1:
begin
minx:=w1[1,1];
miny:=w1[1,2];
maxx:=w2[1,1];
maxy:=w1[2,2];
end;
2:
begin
minx:=w2[1,1];
miny:=w1[1,2];
maxx:=w2[2,1];
maxy:=w2[1,2];
end;
3:
begin
minx:=w2[2,1];
miny:=w1[1,2];
maxx:=w1[2,1];
maxy:=w1[2,2];
end;
end;
clip(round(x1),round(y1),round(x2),round(y2),minx,miny,maxx,maxy);
clip(round(x2),round(y2),round(x3),round(y3),minx,miny,maxx,maxy);
clip(round(x3),round(y3),round(x4),round(y4),minx,miny,maxx,maxy);
clip(round(x4),round(y4),round(x1),round(y1),minx,miny,maxx,maxy);
end;

procedure filling;
var
counter,J,K : integer;
begin
MoveTo(round(M1[1,1]), round(M1[1,2]));
xc1:= M1[1,1];
xc2:=M1[2,1];
xc3:=M1[3,1];
xc4:=M1[4,1];
yc1:=M1[1,2];
yc2:=M1[2,2];
yc3:=M1[3,2];
yc4:=M1[4,2];
for i:=1 to 3 do Dr(xc1, xc2, xc3, xc4, yc1, yc2, yc3, yc4, i);
ReadKey;

for counter:=1 to 15 do
begin
Delay(20000);
if not check then
begin
setcolor(white);
for i:=1 to 3 do Dr(xc1, xc2, xc3, xc4, yc1, yc2, yc3, yc4, i);
setcolor(magenta);
end;
xc1:= xc1+dxy[1,1];
xc2:= xc2+dxy[2,1];
xc3:= xc3+dxy[3,1];
xc4:= xc4+dxy[4,1];
yc1:= (M2[M[1],2]- M1[1,2])/(M2[M[1],1]- M1[1,1])*(xc1-M1[1,1])+M1[1,2];
yc2:= (M2[M[2],2]- M1[2,2])/(M2[M[2],1]- M1[2,1])*(xc2-M1[2,1])+M1[2,2];
yc3:= (M2[M[3],2]- M1[3,2])/(M2[M[3],1]- M1[3,1])*(xc3-M1[3,1])+M1[3,2];
yc4:= (M2[M[4],2]- M1[4,2])/(M2[M[4],1]- M1[4,1])*(xc4-M1[4,1])+M1[4,2];

MoveTo(round(xc1), round(yc1));
for i:=1 to 3 do Dr(xc1, xc2, xc3, xc4, yc1, yc2, yc3, yc4, i);
end;

MoveTo(round(x), round(yc1));
for i:=1 to 3 do Dr(X, x, x, x, yc1, yc2, yc3, yc4, i);
DXY[1,1]:= (M2[1,1]-X)/15;
DXY[2,1]:= (M2[2,1]-X)/15;
DXY[3,1]:= (M2[3,1]-X)/15;
DXY[4,1]:= (M2[D,1]-X)/15;
P[1]:= X;
P[2]:=x;
P[3]:=x;
P[4]:=x;

for counter:=1 to 15 do
begin
if not check then
begin
setcolor(white);
for i:=1 to 3 do Dr(x, x, x, x, yc1, yc2, yc3, yc4, i);
setcolor(magenta);
end;
P[1]:= P[1]+dxy[1,1];
P[2]:= P[2]+dxy[2,1];
P[3]:= P[3]+dxy[3,1];
P[4]:= P[4]+dxy[4,1];
Q[1]:= (M2[1,2]-M1[MM[1],2])/(M2[1,1]-M1[MM[1],1])*(P[1]-M1[MM[1],1])+M1[MM[1],2];
Q[2]:= (M2[2,2]- M1[MM[2],2])/(M2[2,1]- M1[MM[2],1])*(P[2]-M1[MM[2],1])+M1[MM[2],2];
Q[3]:= (M2[3,2]- M1[MM[3],2])/(M2[3,1]- M1[MM[3],1])*(P[3]-M1[MM[3],1])+M1[MM[3],2];
Q[4]:= (M2[D,2]- M1[MM[4],2])/(M2[D,1]- M1[MM[4],1])*(P[4]-M1[MM[4],1])+M1[MM[4],2];
Delay(20000);
if not check then begin ClearDevice; DrawWindow end;
MoveTo(round(P[1]), round(Q[1]));
for i:=1 to 3 do Dr(P[1], P[2], P[3], P[4], Q[1], Q[2], Q[3], Q[4],i);
end;
MoveTo(round(M2[1,1]), round(M2[1,2]));
for i:=1 to 3 do Dr(M2[1,1], M2[2,1], M2[3,1], M2[D,1], M2[1,2], M2[2,2], M2[3,2], M2[D,2], i);
end;

procedure corr;
var
I,B, J,K: integer;
bb: boolean;
begin
randomize;
for I:=1 to 4 do
begin
MM[I]:= 0;
M[I]:=0;
end;
for I:=1 to 4 do
begin
while true do
begin
bb:=false;
B:= random(4)+1;
for J:=1 to 4 do
if M[J]= B then
begin
bb:= true;
break;
end;
if not bb then
begin
M[I]:= B;
MM[B]:=I;
break;
end;
end;

end;
for I:=1 to 4 do
if M[I]=4 then
M[I]:= D;
X:= (M1[3,1]+M2[3,1])/2;
y[1]:=(M2[M[1],2]- M1[1,2])/(M2[M[1],1]- M1[1,1])*(xc1-M1[1,1])+M1[1,1];
y[2]:=(M2[M[2],2]- M1[2,2])/(M2[M[2],1]- M1[2,1])*(xc2-M1[2,1])+M1[2,1];
y[3]:=(M2[M[3],2]- M1[3,2])/(M2[M[3],1]- M1[3,1])*(xc3-M1[3,1])+M1[3,1];
y[4]:=(M2[M[4],2]- M1[4,2])/(M2[M[4],1]- M1[4,1])*(xc4-M1[4,1])+M1[4,1];
for I:=1 to 4 do
begin
DXY[I,1]:= (X-M1[I,1])/15;
DXY[I,2]:= (Y[I]-M1[I,2])/15;
end;
end;

procedure preparation;
var i:integer;
c:char;
begin
writeln('Points correspondence:');
for i:=1 to 4 do
writeln(MM[i],'-',M[i]);
writeln('Do you want to show all current figures (slave) (y/n)?');
readln(c);
if (c='y') or (c='Y') then check:=true else check:=false;
end;


begin
corr;
preparation;
gd:=detect;
gm:=0;
initgraph(GD,gm,'');
SetBkColor(White);
SetColor(Magenta);
DrawWindow;
filling;
ReadKey;
closegraph;
end.