Вращение прямоугольника

[Ponaroshku]

Задали в институте. Бился головой об стену, завершить не могу. Подскажите ошибку.

Текст задачи: Изобразить на экране прямоугольник, вращающийся в плоскости экрана вокруг одной из своих вершин.

Собственно, проблема в том, что не могу найти верные координаты четвертой точки (x4,y4). Надеюсь на помощь. Спасибо.

program three;
uses crt,GraphABC;
var
  a,b,r: real;
  x1_ekr,y1_ekr, x2_ekr, y2_ekr, x3_ekr,y3_ekr, x4_ekr,y4_ekr: integer;
begin
     a:=100;
  Repeat
    r:=a;
	  x1_ekr:=250;
	  y1_ekr:=150;
	  x2_ekr:=round(250+r*Cos(Pi*b/180));
	  y2_ekr:=round(150-r*Sin(Pi*b/180));
	  x3_ekr:=round(250+r*sin(Pi*b/180));
	  y3_ekr:=round(150+r*cos(Pi*b/180));
	  x4_ekr:=round(250+r*cos(Pi*b/180));
	  y4_ekr:=round(250+r*sin(Pi*b/180));
    SetPenColor(clBlack);
    Line(x1_ekr,y1_ekr,x2_ekr,y2_ekr);
    Line(x3_ekr,y3_ekr,x4_ekr,y4_ekr);
    Line(x1_ekr,y1_ekr,x3_ekr,y3_ekr);
    Line(x2_ekr,y2_ekr,x4_ekr,y4_ekr);
    SetPenColor(clWhite);
    Line(x1_ekr,y1_ekr,x2_ekr,y2_ekr);
    Line(x3_ekr,y3_ekr,x4_ekr,y4_ekr);
    Line(x1_ekr,y1_ekr,x3_ekr,y3_ekr);
    Line(x2_ekr,y2_ekr,x4_ekr,y4_ekr);
    b:=b+0.001
  until keypressed;
end.

[Sazary]

Вот. Написал заново. Писал на FPC. У вас, я вижу, PascalABC, но, думаю, переделать сможете.

program three;
uses crt,Graph;
var
a,b: integer;
d,m : smallint;
x1,x2,x3,x4,y1,y2,y3,y4: integer;
alpha,beta : real;
x0,y0 : integer;
begin
clrscr;
initgraph(d,m,'');
alpha := 0;
x0 := 300;  // координаты левого верхнего угла
y0 := 300;
a := 100;   // сторона a
b := 200;   // сторона b
beta := arctan(b/a);
setcolor(15);
repeat
line(x1,y1,x2,y2);
line(x2,y2,x3,y3);
line(x3,y3,x4,y4);
line(x4,y4,x1,y1);

x1 := x0;
y1 := y0;
x2 := x0+round(a*cos(alpha));
y2 := y0+round(a*sin(alpha));
x3 := x0+round(sqrt(sqr(a)+sqr(b))*cos(alpha-beta));
y3 := y0+round(sqrt(sqr(a)+sqr(b))*sin(alpha-beta));
x4 := x0+round(b*cos(alpha-pi/2));
y4 := y0+round(b*sin(alpha-pi/2));

alpha := alpha + 0.1;
if alpha>=2*pi then alpha := 0;
delay(70);
cleardevice;
until keypressed;

closegraph;
end.

[Ponaroshku]

2Sazary


В PABC замена черной линии белой происходит практически мгновенно, и получается, что прямоугольник виден на тысячные доли секунды. Но это скорее всего корявость тамошней графики. Постоянно с ней такие проблемы.

Огромное спасибо, буду дорабатывать.

Чуть позже : Исправил уменьшением прироста параметра alpha.

Финальный код:

program three;
uses crt,GraphABC;
var
  a,b: integer;
  x0,y0,x1,y1,x2,y2,x3,y3,x4,y4: integer;
  alpha,beta: real;
begin
     setwindowsize(800,600);
     x0:=400;
     y0:=300;
     a:=100;
     b:=200;
     alpha:=0;
     beta:=arctan(b/a);
  Repeat
    x1:=x0;
    y1:=y0;
    x2:=x0+round(a*cos(alpha));
    y2:=y0+round(a*sin(alpha));
    x3:=x0+round(sqrt(sqr(a)+sqr(b))*cos(alpha-beta));
    y3:=y0+round(sqrt(sqr(a)+sqr(b))*sin(alpha-beta));
    x4:=x0+round(b*cos(alpha-pi/2));
    y4:=y0+round(b*sin(alpha-pi/2));
    SetPenColor(clBlack);
    line(x1,y1,x2,y2);
    line(x2,y2,x3,y3);
    line(x3,y3,x4,y4);
    line(x4,y4,x1,y1);
    SetPenColor(clWhite);
    line(x1,y1,x2,y2);
    line(x2,y2,x3,y3);
    line(x3,y3,x4,y4);
    line(x4,y4,x1,y1);
    alpha:=alpha + 0.0001;
    if alpha>=2*pi then alpha:=0;
  until keypressed;
end.

[Sazary]

В PABC замена черной линии белой происходит практически мгновенно, и получается, что прямоугольник виден на тысячные доли секунды.

Я не зарисовываю предыдущую линию. Я просто очищаю экран через cleardevice.
Уменьшите приращение угла alpha.
Еще можете попробовать увеличить задержку в Delay.

[Ponaroshku]

А как сделать так чтобы прямоугольник вращался относительно центра?

[Sazary]

Сообщение от Ponaroshku

А как сделать так чтобы прямоугольник вращался относительно центра?

Учим геометрию

x1 := x0+round(sqrt(sqr(a)+sqr(b))*cos(alpha+(pi-beta))/2);
y1 := y0+round(sqrt(sqr(a)+sqr(b))*sin(alpha+(pi-beta))/2);
x2 := x0+round(sqrt(sqr(a)+sqr(b))*cos(alpha+beta)/2);
y2 := y0+round(sqrt(sqr(a)+sqr(b))*sin(alpha+beta)/2);
x3 := x0+round(sqrt(sqr(a)+sqr(b))*cos(alpha-beta)/2);
y3 := y0+round(sqrt(sqr(a)+sqr(b))*sin(alpha-beta)/2);
x4 := x0+round(sqrt(sqr(a)+sqr(b))*cos(alpha-(pi-beta))/2);
y4 := y0+round(sqrt(sqr(a)+sqr(b))*sin(alpha-(pi-beta))/2);

[Ponaroshku]

Вы правы, очень с ней все плохо...

[Kopova]

Нашёл темку, которая мне нужна Спасибо за прогу - очень помогла Помогите написать цикл в котором прямоугольник поворачивался бы по нажатии одной клавиши в одну сторону, по нажатии другой - в противоположную. Я пытался, ничего не получается. Просто выключает программу при нажатии забинденной клавиши. Я ещё новичёк, поэтому сразу извините за тупость...

[Sazary]

program three;
uses crt,Graph;
var
a,b: integer;
d,m : smallint;
x1,x2,x3,x4,y1,y2,y3,y4: integer;
alpha,beta,koef : real;
x0,y0 : integer;
ch : char;
begin
clrscr;
initgraph(d,m,'');
alpha := 0;
koef := 1;
x0 := 300;  // êîîðäèíàòû ëåâîãî âåðõíåãî óãëà
y0 := 300;
a := 100;   // ñòîðîíà a
b := 200;   // ñòîðîíà b
beta := arctan(b/a);
setcolor(15);
repeat
line(x1,y1,x2,y2);
line(x2,y2,x3,y3);
line(x3,y3,x4,y4);
line(x4,y4,x1,y1);

x1 := x0;
y1 := y0;
x2 := x0+round(a*cos(alpha));
y2 := y0+round(a*sin(alpha));
x3 := x0+round(sqrt(sqr(a)+sqr(b))*cos(alpha-beta));
y3 := y0+round(sqrt(sqr(a)+sqr(b))*sin(alpha-beta));
x4 := x0+round(b*cos(alpha-pi/2));
y4 := y0+round(b*sin(alpha-pi/2));

alpha := alpha + koef*0.1;
if alpha>=2*pi then alpha := 0;
delay(70);
cleardevice;

if keypressed then
 begin
  ch := readkey;
  if ch = '1' then koef := 1
  else if ch='2' then koef := -1
  else if ch=#27 then break;
 end;
until ch=#27;

closegraph;
end.

Клавиша 1 - вращение по часовой, 2 - против, Esc - выход.

[Kopova]

Sazary, спасибо, но немного не то. Нужно, чтобы прямоугольник недвигался, пока не нажата клавиша. То есть, например, у нас есть обычный прямоугольник. По нажатию клавиши он начинает поворачиваться. Как только клавишу отпустили, он перестаёт крутиться.
На основе Вашей программы пытался сделать, вышло что-то такое...

...
alpha := alpha + koef*0.1;
if alpha>=2*pi then alpha := 0;
delay(70);
cleardevice;

if keypressed then
 begin
  ch := readkey;
  if ch = #75 then begin
  koef:= 1;
  alpha := alpha + koef*0.1;
  if alpha>=2*pi then alpha := 0;
  delay(70);
  end;
  else if ch=#77 then
  koef := -1;
  alpha := alpha + koef*0.1;
  if alpha>=2*pi then alpha := 0;
  delay(70);
  end;
  if ch=#27 then break;
 end;
until ch=#27;

... но мой Паскаль такое компилировать отказывается В чём ошибка? Или ошибки?