ENG  RUSTimus Online Judge
Online Judge
Problems
Authors
Online contests
About Online Judge
Frequently asked questions
Site news
Webboard
Links
Problem set
Submit solution
Judge status
Guide
Register
Update your info
Authors ranklist
Current contest
Scheduled contests
Past contests
Rules
back to board

Discussion of Problem 1008. Image Encoding

What's wrong??
Posted by pr0grammer 23 Feb 2003 13:52
program An_Image_Encoding;
const

  maxN = 10;
  maxQ = 310;

type

  punkt = record
    x, y : integer;
  end;

  queue = record
    tail, head : integer;
    c : array [1..maxQ] of punkt;
  end;

var
  map, u : array [1..maxN, 1..maxN] of boolean;
  q : queue;

  procedure initial;
  begin
    fillchar(map, sizeOf(map), false);
  end;

  procedure enqueue(var q : queue; p : punkt);
  begin
    q.c[q.tail] := p;
    if q.tail = maxQ then q.tail :=1
    else inc(q.tail);
  end;

  function dequeue(var q : queue) : punkt;
  var
    x : punkt;
  begin
    x := q.c[q.head];
    if q.head = maxQ then q.head := 1
    else inc(q.head);
    dequeue := x;
  end;

  function check(x, y : integer) : boolean;
  var
    p : punkt;
  begin
    if (x >= 1) and (y >= 1) and (x <= 10) and (y <= 10) and
      (map[x, y] = true) and (u[x, y] = false) then
      begin
        u[x, y] := true;
        p.x := x;
        p.y := y;
        enqueue(q, p);
        check := true;
      end
      else
        check := false;
  end;

  procedure solve;
  var
    n, m, p, code, x, y, i, sx, sy : integer;
    s, nt, mt : string;
    st, z, r : punkt;
    c : char;
  begin
    readln(s);
    while (s[length(s)] = ' ') do delete(s, length(s), 1);
    while (s[1] = ' ') do delete(s, 1, 1);
    p := pos(' ', s);
    if p <> 0 then
    begin
      nt := copy(s, 1, p - 1);
      mt := copy(s, p + 1, length(s));
      val(nt, st.x, code);
      val(mt, st.y, code);
      q.head := 1;
      q.tail := 1;
      enqueue(q, st);
      while q.head <> q.tail do
      begin
        z := dequeue(q);
        readln(s);
        map[z.x, z.y] := true;
        for i := 1 to length(s) - 1 do
        begin
          c := s[i];
          case c of
            'R' :
            begin
              map[z.x + 1, z.y] := true;
              r.x := z.x + 1;
              r.y := z.y;
              enqueue(q, r);
            end;
            'T':
            begin
              map[z.x, z.y + 1] := true;
              r.x := z.x;
              r.y := z.y + 1;
              enqueue(q, r);
            end;
            'L':
            begin
              map[z.x - 1, z.y] := true;
              r.x := z.x - 1;
              r.y := z.y;
              enqueue(q, r);
            end;
            'B':
            begin
              map[z.x, z.y - 1] := true;
              r.x := z.x;
              r.y := z.y - 1;
              enqueue(q, r);
            end;
          end;
        end;
      end;
        for x := 1 to 10 do
          for y := 1 to 10 do
            if (map[x, y]) then
              writeln(x, ' ', y);
    end
    else
    begin
      val(s, n, code);
      if n = 0 then
      begin
        exit;
      end;
      for i := 1 to n do
      begin
        readln(x, y);
        map[x, y] := true;
        if i = 1 then
        begin
          st.x := x;
          st.y := y;
        end;
      end;
      writeln(st.x, ' ', st.y);
      q.head := 1;
      q.tail := 1;
      enqueue(q, st);
      fillchar(u, sizeOf(u), false);
      while q.tail <> q.head do
      begin
        z := dequeue(q);
        u[z.x, z.y] := true;
        if check(z.x + 1, z.y) then write('R');
        if check(z.x, z.y + 1) then write('T');
        if check(z.x - 1, z.y) then write('L');
        if check(z.x, z.y - 1) then write('B');
        if q.head = q.tail then
          writeln('.') else
        writeln(',');
      end;
    end;
  end;

begin
  initial;
  solve;
end.