File:Ледовая буква H.png

uses GraphABC;
const
  K = 0.45;

procedure RLine(x, y, x1, y1: real):=Line(Round(x), Round(y), Round(x1), Round(y1)); 

procedure Draw(x, y, r, angle: real);
begin
  var angle1 := DegToRad(angle);
  var angle2 := DegToRad(angle - 90);
  
  var x2 := x + r * Cos(angle1); 
  var y2 := y + r * Sin(angle1); 
  var mx := (x + x2) / 2; 
  var my := (y + y2) / 2;
  var r2 := r / 2;
  var r3 := r2 * K;
  var cx := mx + r3 * Cos(angle2);
  var cy := my + r3 * Sin(angle2);
  
  RLine(x, y, x2, y2); 
  RLine(mx, my, cx, cy);
  
  if r > 10 then
    SetPenColor(clBlue)
  else
    SetPenColor(clCyan);
  
  if r > 8 then 
  begin
    Draw(x, y, r2, angle); 
    Draw(mx, my, r2, angle); 
    Draw(mx, my, r3, angle - 90); 
    Draw(cx, cy, r3, angle + 90); 
  end; 
end;

function GetAngle(x, y, x2, y2: real): real;
begin
  var angle := Abs(RadToDeg(ArcTan((y2 - y) / (x2 - x))));
  if (x2 = x) and (y2 = y) then
    Result := 0
  else
    if x2 > x then
      if y2 > y then Result := angle else Result := 360 - angle
    else
      if y2 > y then Result := 180 - angle else Result := 180 + angle;
end;

procedure DrawIce(x, y, x1, y1: real);
begin
  var d := Sqrt(Sqr(x1 - x) + Sqr(y1 - y));
  Draw(x1, y1, d, GetAngle(x1, y1, x, y));
  Draw(x, y, d, GetAngle(x, y, x1, y1));
end;

procedure Draw(x, y, l: real);
begin
  var xp := x + l;
  var xm := x - l;
  var yp := y + l;
  var ym := y - l;
  
  DrawIce(x, y, xp, y);
  DrawIce(x, y, xm, y);
  DrawIce(xp, y, xp, ym);
  DrawIce(xp, y, xp, yp);
  DrawIce(xm, y, xm, ym);
  DrawIce(xm, y, xm, yp);
  
  if l > 50 then
  begin
    l := l / 2; 
    Draw(xp, ym, l); 
    Draw(xp, yp, l); 
    Draw(xm, ym, l); 
    Draw(xm, yp, l); 
  end; 
end;

begin
  SetWindowIsFixedSize(true);
  ClearWindow(clBlack);
  
  LockDrawing();
  Draw(Window.Width / 2, Window.Height / 2, 100);
  Redraw();
end.