[PAS] Rosnacy kwadrat

program kwadrat;

uses
    crt, DOS;

const
     x=9;
     y=3;

var
     i, j, k, centralX, centralY, maxEdge, edge, direction: Integer;
     positions: Array[1..x,1..y] of Boolean;

procedure reset();
     begin
          for j:=1 to y do
          begin
               for i:=1 to x do
               begin
               positions[i,j] := false;
               end;
          end;
     end;

procedure draw();
     begin
          for j:=1 to y do    {rysowanie}
          begin
               for i:=1 to x do
               begin
                    if positions[i,j] = true then
                    begin
                         write('X ');
                    end
                    else write('O ');
               end;
               writeLn();
          end;
     end;

begin
     reset;

     if x<=y then
     begin
          maxEdge := x;
     end else maxEdge := y;
     maxEdge := maxEdge div 2;
     edge := maxEdge;

     centralX := (x div 2) + 1;
     centralY := (y div 2) + 1;
     positions[centralX,centralY] := true;

     while(true) do
     begin

     draw;

     if edge = maxEdge then
     begin
          direction := 1;
     end
     else if edge = 0 then
     begin
          direction := 0;
     end;

     if direction = 1 then
     begin
          for k := 2 to centralX do
          begin
               if positions[k, centralY] = true then
               begin
                    reset;
                    for j := k-1 to 2*centralX-k+1 do
                    begin
                         positions[j, centralY - centralX + k - 1] := true;
                         positions[j, centralY + centralX - k + 1] := true;
                    end;
                    for j:= centralY - centralX + k to centralY + centralX - k do
                    begin
                         positions[k-1 ,j] := true;
                         positions[2*centralX-k+1 ,j] := true;
                    end;

                    break;
               end;
          end;

          edge := edge - 1;
     end else
     begin
          for k := 1 to centralX-1 do
          begin
               if positions[k, centralY] = true then
               begin
                    reset;
                    for j := k+1 to 2*centralX-k-1 do
                    begin
                         positions[j, centralY - centralX + k + 1] := true;
                         positions[j, centralY + centralX - k - 1] := true;
                    end;
                    for j:= centralY - centralX + k + 2 to centralY + centralX - k - 2 do
                    begin
                         positions[k+1 ,j] := true;
                         positions[2*centralX-k-1 ,j] := true;
                    end;

                    break;
               end;
          end;
          edge := edge + 1;
     end;
     delay(300);
     clrScr;
     end;

end.