Узор из квадратов

[iks2]

Узор из квадратов

Требуется написать программу, которая рисует узор, представленный на картинке. Собственно не требуется делать точную копию, но так, чтобы было похоже. Предлагаемая программа это делает.

DECLARE SUB f (x!, y!, r!, p!)
CLS

CONST k = 3.5
SCREEN 11
WINDOW (-320, 240)-(320, -240)
CALL f(0, 0, 100, 3)
END

SUB f (x, y, r, p)
   IF p > 0 THEN
      s = r - 1
      LINE (x - r, y + r)-(x + r, y - r), , B
      LINE (x - s, y + s)-(x + s, y - s), 0, BF
      FOR i = 1 TO 10000: NEXT
      CALL f(x, y, r / k, p - 1)
      CALL f(x + r, y, r / k, p - 1)
      CALL f(x + r, y + r, r / k, p - 1)
      CALL f(x, y + r, r / k, p - 1)
      CALL f(x - r, y + r, r / k, p - 1)
      CALL f(x - r, y, r / k, p - 1)
      CALL f(x - r, y - r, r / k, p - 1)
      CALL f(x, y - r, r / k, p - 1)
      CALL f(x + r, y - r, r / k, p - 1)
   END IF
END SUB

 

[Vladimir_S]

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

Да легко (Паскаль; GrfStart - самописный модуль инициализации графики):

Uses CRT, Graph, GrfStart;

Var
 i,j,k,m:Word;

Procedure RCT(Xc,Yc,A:Word);
begin
 Bar(Xc-A,Yc-A,Xc+A,Yc+A);
 Rectangle(Xc-A,Yc-A,Xc+A,Yc+A);
end;

Begin
 INITIALIZE;
 ClearDevice;
 SetFillStyle(SolidFill,GetBkColor);
 SetLineStyle(SolidLn,0,ThickWidth);
 RCT((GetMaxX div 2),(GetMaxY div 2), 140);
 for i:=0 to 2 do
  for j:=0 to 2 do
   begin
    RCT((GetMaxX div 2)-140+j*140,(GetMaxY div 2)-140+i*140, 40);
    for k:=0 to 2 do
     for m:=0 to 2 do
      RCT((GetMaxX div 2)-180+j*140+m*40,(GetMaxY div 2)-180+i*140+k*40, 10);
   end;
 ReadKey
End.