Построить дом в паскале

uses Graph, CRT;
 
var
  Gd, Gm : Integer;
 
type
  XY = record
    X : Integer;
    Y : Integer;
  end;
 
procedure LineXY(A, B : XY);
begin
   Line(A.X, A.Y, B.X, B.Y);
end;
 
procedure AddXY(A, B : XY; var Res : XY);
begin
  Res.X := A.X + B.X;
  Res.Y := A.Y + B.Y;
end;
 
procedure SubXY(A, B : XY; var Res : XY);
begin
  Res.X := A.X — B.X;
  Res.Y := A.Y — B.Y;
end;
 
procedure MulXY(A : XY; L : Integer; var Res : XY);
begin
  Res.X := A.X * L;
  Res.Y := A.Y * L;
end;
 
procedure CopyXY(A : XY; var Res : XY);
begin
  Res.X := A.X;
  Res.Y := A.Y;
end;
 
procedure DrawRect(Origin, Dir1, Dir2 : XY;
    X1, Y1, X2, Y2 : Integer; Fill, Draw : Boolean);
var
  a, b, c, d, e, f, g : XY;
  Points :  array[1 .. 5] of XY;
begin
  MulXY(Dir1, X1, a);
  MulXY(Dir1, X2, b);
  MulXY(Dir2, Y1, c);
  MulXY(Dir2, Y2, d);
  AddXY(Origin, a, e);
  AddXY(e, c, Points[1]);
  AddXY(e, d, Points[2]);
  AddXY(Origin, b, f);
  AddXY(f, d, Points[3]);
  AddXY(f, c, Points[4]);
  CopyXY(Points[1], Points[5]);
  if Fill then
    FillPoly(5, Points);
  if Draw then
    DrawPoly(5, Points);
end;
 
procedure DrawWall(Origin, Dir1, Dir2 : XY;
    L1, L2 : Integer; Oddity : Boolean);
{ Рисует кирпичную стену }
var
  i, j : Integer;
  a, b, c, d, e : XY;
  Poly : array[1 .. 5] of XY;
begin
  { Внешний контур }
  CopyXY(Origin, Poly[1]);
  MulXY(Dir1, L1, c);
  MulXY(Dir2, L2, d);
  AddXY(c, d, e);
  AddXY(Origin, c, Poly[2]);
  AddXY(Origin, e, Poly[3]);
  AddXY(Origin, d, Poly[4]);
  CopyXY(Origin, Poly[5]);
  FillPoly(5, Poly);
  DrawPoly(5, Poly);
  { Кирпичи }
  for i := 1 to L2 — 1 do
  begin
    { Line(Origin + Dir2 * i,
           Origin + Dir2 * i + Dir1 * L1) }
    MulXY(Dir2, i, a);
    AddXY(Origin, a, b);
    AddXY(b, c, d);
    LineXY(b, d);
  end;
  for i := 1 to L2 do
  begin
    MulXY(Dir2, i — 1, a);
    AddXY(Origin, a, b);
    MulXY(Dir2, i, a);
    AddXY(Origin, a, c);
    for j := 1 to L1 — 1 do
    begin
      if ((i mod 2) = 1) xor ((j mod 2) = 1) xor Oddity then
      begin
        { Line(Origin + Dir2 * (i — 1) + Dir1 * j,
               Origin + Dir2 * i       + Dir1 * j) }
        MulXY(Dir1, j, a);
        AddXY(b, a, d);
        AddXY(c, a, e);
        LineXY(d, e);
      end;
    end;
  end;
end;
 
type XYC = record
    X, Y, C : LongInt; { проективные координаты }
  end;
 
procedure XY2XYC(A : XY; var Res : XYC);
begin
  Res.X := A.X;
  Res.Y := A.Y;
  Res.C := 1;
end;
 
procedure XYC2XY(A : XYC; var Res : XY);
var
  ResX, ResY : LongInt;
begin
  ResX := A.X div A.C;
  ResY := A.Y div A.C;
  Res.X := ResX;
  Res.Y := ResY;
end;
 
procedure IncidXYC(A, B : XYC; var Res : XYC);
begin
  Res.X :=  A.Y * B.C — A.C * B.Y;
  Res.Y := -A.C * B.X + A.X * B.C;
  Res.C :=  A.X * B.Y — A.Y * B.X;
end;
 
procedure Intersect(a1, a2, b1, b2 : XY; var Res : XY);
{ Точка пересечения линий a1a2 и b1b2 }
var pa1, pa2, pb1, pb2, { проективные координаты точек a1, a2, b1 и b2 }
    pal, pbl, { проективные координаты линий a1a2 и b1b2 }
    pRes : XYC; { проективные координаты точки пересечения }
begin
  XY2XYC(a1, pa1); XY2XYC(a2, pa2); XY2XYC(b1, pb1); XY2XYC(b2, pb2);
  IncidXYC(pa1, pa2, pal);
  IncidXYC(pb1, pb2, pbl);
  IncidXYC(pal, pbl, pRes);
  XYC2XY(pRes, Res);
end;
 
procedure Cloud(X, Y : Integer);
const CloudImage : array[1 .. 7] of String =
(‘        .  .    .    .             ‘,
 ‘     .    .   .   .     .  .       ‘,
 ‘   .  .  .   .      .  .  .  .     ‘,
 ‘  .   . .  .  .  .    .   .   .  . ‘,
 ‘   .  .   .  .  .  . .  .   .  .   ‘,
 ‘     .   .   . . .  .    . .       ‘,
 ‘                                   ‘);
var
  i, j : Integer;
begin
  for i := 1 to 7 do
    for j := 1 to Length(CloudImage[1]) do
      if CloudImage[i, j] = ‘.’ then
        PutPixel(X + j — 1, Y + i — 1, LightGray);
end;
 
var
  a, b, c, d, e, f, g, h, i, j, k, l, m, n, o,
  p, q, r, s, t, u, v, w, x, y, z, a0, b0, c0 : XY;
  Roof : array[1 .. 5] of XY;
  Roof2 : array[1 .. 4] of XY;
  Shadow : array[1 .. 9] of XY;
begin
  Gd := VGA;
  Gm := VGAHi; { 640×480 }
  InitGraph(Gd, Gm, ‘X:BP’);
 
  { Небо }
  SetFillStyle(SolidFill, LightCyan);
  Bar(0, 0, 639, 479);
 
  { Облака }
  Cloud( 89,  91); Cloud( 90,  82); Cloud( 11,  91); Cloud( 72,  98);
  Cloud( 52,  27); Cloud( 42,  77); Cloud( 98,  58); Cloud( 48,  12);
  Cloud( 67,  62); Cloud(167,  34); Cloud( 62,  73); Cloud(363,  54);
  Cloud(122,  46); Cloud( 40,  46); Cloud( 27,  26); Cloud( 49,  23);
 
  { Трава }
  SetFillStyle(SolidFill, LightGreen);
  FillEllipse(320, 380, 500, 200);
 
  { Кирпичные стены }
  SetLineStyle(SolidLn, 0, NormWidth);
  SetColor(Black);
  SetFillStyle(SolidFill, Brown);
 
 
  a.X := 200;
  a.Y := 150;
  b.X := 10;
  b.Y := 0;
  c.X := 0;
  c.Y := 10;
  DrawWall(a, b, c, 20, 20, False);
  MulXY(b, 20, d);
  AddXY(a, d, e);
  f.X := 5;
  f.Y := -5;
  DrawWall(e, f, c, 20, 20, True);
 
  { Крыша }
  MulXY(b, 4, g);
  SubXY(a, g, h);
  MulXY(f, 4, i);
  SubXY(h, i, Roof[1]);
  AddXY(e, g, j);
  SubXY(j, i, Roof[2]);
  CopyXY(Roof[2], Roof2[1]);
  MulXY(f, 20 + 4, k);
  AddXY(e, k, l);
  AddXY(l, g, Roof2[2]);
  MulXY(f, 10, m);
  AddXY(a, m, n);
  MulXY(c, 9, o);
  SubXY(n, o, p);
  MulXY(b, 10 — 4, q);
  AddXY(p, q, Roof[4]);
  MulXY(b, 10 + 4, r);
  AddXY(p, r, Roof[3]);
  CopyXY(Roof[3], Roof2[3]);
 
  CopyXY(Roof[1], Roof[5]);
  CopyXY(Roof2[1], Roof2[4]);
 
  SetFillStyle(SolidFill, LightGray);
  FillPoly(5, Roof);
  DrawPoly(5, Roof);
  SetFillStyle(SolidFill, DarkGray);
  FillPoly(4, Roof2);
  DrawPoly(4, Roof2);
 
  { Тень }
  s.X := 8;
  s.Y := 3;
  MulXY(c, 20, t);
  MulXY(s, 20, u);
  AddXY(t, u, v);
  AddXY(a, t, Shadow[1]);
  AddXY(a, v, w);
  AddXY(Roof[1], v, Shadow[3]);
  MulXY(f, 20 + 4 + 4, x);
  AddXY(Shadow[3], x, y);
  Intersect(Shadow[1], w, Shadow[3], y, Shadow[2]);
  AddXY(Roof[2], v, Shadow[4]);
  AddXY(Roof2[2], v, Shadow[5]);
  AddXY(e, t, Shadow[8]);
  MulXY(f, 20, z);
  AddXY(Shadow[8], z, Shadow[7]);
  SubXY(Shadow[7], u, a0);
  Intersect(Shadow[5], y, Shadow[7], a0, Shadow[6]);
  CopyXY(Shadow[1], Shadow[9]);
 
  SetFillStyle(SolidFill, Green);
  FillPoly(9, Shadow);
 
  { Дверь }
 
  SetFillStyle(SolidFill, Red);
  DrawRect(e, f, c, 7, 8, 13, 20, True, True);
 
  { Окно }
  SetColor(White);
  SetFillStyle(SolidFill, Blue);
  DrawRect(a, b, c, 6, 6, 14, 14, True, True);
  DrawRect(a, b, c, 10, 6, 14, 14, True, True);
  DrawRect(a, b, c, 10, 6, 14, 9, True, True);
 
  { Табличка }
  SetColor(Blue);
  SetFillStyle(SolidFill, White);
  DrawRect(a, b, c, 1, 2, 19, 5, True, True);
 
  SetTextStyle(5, HorizDir, 1);
  OutTextXY(a.X + b.X * 1 + c.X * 1 + 3, a.Y + b.Y * 2 + c.Y * 2,
    ‘Дом-2: Перестройка’);
 
  while not KeyPressed do
    Delay(200);
 
  CloseGraph;
end.