Построить двумерное изображение заданной фигуры - Pascal ABC

uses graphABC,Crt;
const m=5;{фигура}
      n=3;{размер матриц коэффициентов}
type mas=array[1..m] of real;
     mtr=array[1..n,1..n] of real;
var xa,ya,xb,yb:mas;{фигуры после перемещения}
    a,r:mtr;{матрицы преобразований}
    xc,yc:integer;{центр экрана}
    ms:real;{масштаб для перевода реальных координат в экранные}
    i,j,k:byte;{счетчики циклов}
    c:char;{символ-команда}
procedure Osi;{рисование осей координат}
begin
setpencolor(clBlue);
line(0,yc,windowwidth,yc);{оси}
line(xc,0,xc,windowheight);
for i:=1 to 10 do{максимальное количество засечек в одну сторону}
if i mod 2=0 then
  begin
    line(xc-3,yc-round(i*ms),xc+3,yc-round(i*ms));{засечки на оси У}
    line(xc-3,yc+round(i*ms),xc+3,yc+round(i*ms));
    {подпись оси У}
    textout(xc-20,yc-round(i*ms),inttostr(i));{соответственно засечкам}
    textout(xc-25,yc+round(i*ms),inttostr(-i));
    line(xc+round(i*ms),yc-3,xc+round(i*ms),yc+3); {засечки на оси Х}
    line(xc-round(i*ms),yc-3,xc-round(i*ms),yc+3);
    {подпись оси Х}
    textout(xc+round(i*ms),yc+10,inttostr(i));
    textout(xc-round(i*ms),yc+10,inttostr(-i));
  end;
{центр}
textout(xc+5,yc+10,'0');
{подписи концов осей}
textout(windowwidth-20,yc-20,'X');
textout(xc+5,10, 'Y');
setpencolor(14);
textout(30,10,'Rotate - 1');
textout(30,30,'Stretching - 2');
textout(30,50,'Compression - 3');
textout(30,70,'MirrorX - 4');
textout(30,90,'MirrorY - 5');
textout(30,110,'MoveRight - 6');
textout(30,130,'MoveLeft - 7');
textout(30,150,'MoveUp - 8');
textout(30,170,'MoveDown - 9');
textout(30,190,'Exit - Esc');
end;
procedure Figura(x,y:mas);{рисование фигуры}
begin
Osi;
setpencolor(clRed);
setpenwidth(2);
moveto(xc+round(ms*x[1]),yc-round(ms*y[1]));
lineto(xc+round(ms*x[2]),yc-round(ms*y[2]));
lineto(xc+round(ms*x[3]),yc-round(ms*y[3]));
lineto(xc+round(ms*x[4]),yc-round(ms*y[4]));
lineto(xc+round(ms*x[5]),yc-round(ms*y[5]));
lineto(xc+round(ms*x[1]),yc-round(ms*y[1]));
end;
procedure Ed; { присвоение матрице R значения единичной }
begin
for i:=1 to n do
 begin                             {  1 0 0  }
  for j:=1 to n do  r[i,j]:=0;     {  0 1 0  }
  r[i,i]:=1;                       {  0 0 1  }
 end;
end;
procedure Mult; {умножение матриц А и R:  R = B = A*R }
var b:mtr;
    z:real;
begin
for i:=1 to n do
for j:=1 to n do
 begin
  z:=0;
  for k:=1 to n do
  z:=z+a[i,k]*r[k,j];
  b[i,j]:=z
 end;
for i:=1 to n do
for j:=1 to n do
r[i,j]:=b[i,j]
end;
procedure Stretch;  {расчет матриц А и R для растягивания фигуры}
begin
for i:=1 to n do
 begin                         {  1  0  0  }
  for j:=1 to n do a[i,j]:=0;  {  0 1.05  0  }
  a[i,i]:=1;                   {  0  0  1  }
 end;
a[2,2]:=1.05;{коэффициент растяжения}
a[1,1]:=1.05;
Mult;
end;
procedure Compress;  {расчет матриц А и R для сжатия фигуры}
begin
for i:=1 to n do
 begin                         {  1  0  0  }
  for j:=1 to n do a[i,j]:=0;  {  0 1.05  0  }
  a[i,i]:=1;                   {  0  0  1  }
 end;
a[2,2]:=0.95;{коэффициент растяжения}
a[1,1]:=0.95;
Mult;
end;
procedure MirrorX;  {расчет матриц А и R для отражения фигуры по Х}
begin
for i:=1 to n do
 begin                         {  1  0  0  }
  for j:=1 to n do a[i,j]:=0;  {  0 -1  0  }
  a[i,i]:=1;                   {  0  0  1  }
 end;
a[2,2]:=-1;
Mult;
end;
procedure MirrorY;  {расчет матриц А и R для отражения фигуры по Х}
begin
for i:=1 to n do
 begin                         { -1  0  0  }
  for j:=1 to n do a[i,j]:=0;  {  0  1  0  }
  a[i,i]:=1;                   {  0  0  1  }
 end;
a[1,1]:=-1;
Mult;
end;
procedure MoveY(dy:integer);  {расчет матриц А и R для перемещения фигуры по Y}
begin
for i:=1 to n do
 begin                         {  1  0  0  }
  for j:=1 to n do a[i,j]:=0;  {  0  1 dy  }
  a[i,i]:=1;                   {  0  0  1  }
 end;
a[2,3]:=dy;
Mult;
end;
procedure MoveX(dx:integer);  {расчет матриц А и R для перемещения фигуры по Y}
begin
for i:=1 to n do
 begin                         {  1  0  dx }
  for j:=1 to n do a[i,j]:=0;  {  0  1  0  }
  a[i,i]:=1;                   {  0  0  1  }
 end;
a[1,3]:=dx;
Mult;
end;
procedure Rotate(u:real); {расчет матриц А и R для поворота  фигуры}
var c, s: real;                                                                               {---на угол alfa(рад)---}
begin                {  cos(u) -sin(u) 0  }
for i:=1 to 3 do     {  sin(u)  cos(u) 0  }
for j:=1 to 3 do     {   0       0     1  }
a[i,j]:=0;
a[3,3]:=1;
c:=cos(u);   a[1,1]:= c;  a[2,2]:=c;
s:=sin(u);   a[1,2]:=-s;  a[2,1]:=s;
Mult;
end;
 
procedure New_XY;{расчет новых координат фигуры по исходным}
begin           {с использованием матрицы преобразования R}
for i:=1 to m do
 begin
  xb[i]:=xa[i]*r[1, 1]+ ya[i]*r[1, 2]+ r[1, 3];
  yb[i]:=xa[i]*r[2, 1]+ ya[i]*r[2, 2]+ r[2, 3]
 end;
end;
 
 
begin
setwindowsize(500,500);
centerwindow;
xc:=windowwidth div 2;
yc:=windowheight div 2; { центр экрана }
ms:=(yc-30)/10;
{зададим координаты вершин фмгуры}
xa[1]:=-3;ya[1]:=-1.5;
xa[2]:=-2;ya[2]:=3;
xa[3]:=2;ya[3]:=1.5;
xa[4]:=-1;ya[4]:=-1.5;
xa[5]:=-1;ya[5]:=0;
Figura(xa,ya);{исходный}
repeat
if keypressed then
 begin
  c:=readkey;
  case c of
  #49:begin
      clearwindow;
      Ed;
      Rotate(pi/3); {поворот на pi/4 относительно начала координат}
      New_XY;
      Figura(xb,yb);
      xa:=xb;ya:=yb;{запомним новое положение}
      end;
  #50:begin
      clearwindow;
      Ed;
      Stretch; { растяжение}
      New_XY;
      Figura(xb,yb);
      xa:=xb;ya:=yb;
      end;
  #51:begin
      clearwindow;
      Ed;
      Compress; { сжатие}
      New_XY;
      Figura(xb,yb);
      xa:=xb;ya:=yb;
      end;
  #52:begin
      clearwindow;
      Ed;
      MirrorX; { отражение по Х}
      New_XY;
      Figura(xb,yb);
      xa:=xb;ya:=yb;
      end;
  #53:begin
      clearwindow;
      Ed;
      MirrorY; { отражение по Y}
      New_XY;
      Figura(xb,yb);
      xa:=xb;ya:=yb;
      end;
  #54:begin
      clearwindow;
      Ed;
      MoveX(1); { отражение по Х}
      New_XY;
      Figura(xb,yb);
      xa:=xb;ya:=yb;
      end;
  #55:begin
      clearwindow;
      Ed;
      MoveX(-1); { отражение по Y}
      New_XY;
      Figura(xb,yb);
      xa:=xb;ya:=yb;
      end;
  #56:begin
      clearwindow;
      Ed;
      MoveY(1); { отражение по Х}
      New_XY;
      Figura(xb,yb);
      xa:=xb;ya:=yb;
      end;
  #57:begin
      clearwindow;
      Ed;
      MoveY(-1); { отражение по Y}
      New_XY;
      Figura(xb,yb);
      xa:=xb;ya:=yb;
      end;
  #27:exit;
  end;
 end;
until c=#27;
end.