Показать сообщение отдельно
  #8  
Старый 23.10.2012, 00:28
js_m1m js_m1m вне форума
Прохожий
 
Регистрация: 22.10.2012
Сообщения: 5
Репутация: 10
Смущение

Код:
program Project2;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils;
 
const m = 17;
      k = 9;

var a: array[1..m, 1..m] of char;
 
procedure fill;
const b: array[0..2] of char = ('*', '$', '?');
var i, j: integer;
begin
  randomize;
  for i := 1 to m do
    for j := 1 to m do
      a[i, j] := b[random(3)];
end;
 
procedure cut;
  function f (const x1, x2: integer): integer;
  begin
    f := byte(x1 = 1) * x2 + 1;
  end;
var m1, m2, d1, d2, i1, i2, s2: integer;
begin
  m1 := m; m2 := m;
  repeat
    m2 := f(m2, m - 1);
    m1 := f(m1 xor m2 + 1, m - 1);
    d2 := f(m2, -2);
    d1 := f(m1, -2);
    i1 := m1 - d1 * k;
    s2 := m2;
    while i1 <> m1 do begin
      i1 := i1 + d1;
      s2 := s2 - d2;
      i2 := s2;
      while i2 <> m2 do begin
        i2 := i2 + d2;
        a[i1, i2] := ' ';
      end;
    end;
  until (m1 = m) and (m2 = m);
end;
 
procedure print;
var i, j: integer;
begin
  for i := 1 to m do begin
    for j := 1 to m do
      write(a[i, j]);
    writeln;
  end;
  readln;
end;
 
begin
  fill();
  cut();
  print();
  readln;
end.
Ответить с цитированием