Uses CRT;

Const
  N=20;
  M=20;
  DIVISOR = 1.7;

  EMPTY_CELL = 0;
  WRONG_WAY  = 1;
  WAY        = 2;

  Colors:Array[EMPTY_CELL..WAY] Of Byte = (Green,Yellow,Red);

Var
  Maze:Array[0..N-1,0..M-1] Of Byte;

Procedure GenerateMaze;
Var
  i,j:Integer;
  x,y:Integer;
Begin
  For i:=0 To N-1 Do
    For j:=0 To M-1 Do
      Maze[i,j]:=EMPTY_CELL;
  x:=0;
  y:=0;
  While (x < N-1) Or (y < M-1) Do
  Begin
    Maze[x,y]:=WRONG_WAY;
    If (Random>0.5) Then
      If x < N-1 Then
        Inc(x)
      Else
        Inc(y)
    Else
      If y < M-1 Then
        Inc(y)
      Else
        Inc(x)
  End;
  Maze[x,y]:=WRONG_WAY;
  For i:=1 To Round(N*M/DIVISOR) Do
  Begin
    x:=Random(N);
    y:=Random(M);
    If (Maze[x,y]=EMPTY_CELL) Then
      Maze[x,y]:=WRONG_WAY
  End
End;

Procedure SolveMaze;
Var
  b:Array[0..N-1,0..M-1] of longint;

Procedure Rec(i,j:longint);
Begin
  If (i+1<N) And (Maze[i+1,j]=WRONG_WAY) Then
    If b[i][j]+1<b[i+1][j] Then
    Begin
      b[i+1][j]:=b[i][j]+1;
      Rec(i+1,j)
    End;
  If (j+1<M) And (Maze[i,j+1]=WRONG_WAY) Then
    If b[i][j]+1<b[i][j+1] Then
    Begin
      b[i][j+1]:=b[i][j]+1;
      Rec(i,j+1)
    End;
End;

Var
  i,j:longint;
Begin
  For i:=0 To N-1 Do
    For j:=0 To M-1 Do
      b[i][j]:=MaxLongint;
  b[0][0]:=0;
  Rec(0,0);
  i:=n-1;
  j:=m-1;
  While (i>0) Or (j>0) Do
  Begin
    Maze[i][j]:=WAY;
    If (i>0) Then
    If b[i-1,j]=b[i][j]-1 Then
    Begin
      i:=i-1;
      Continue;
    End;
    If (j>0) Then
      If b[i,j-1]=b[i][j]-1 Then
      Begin
        j:=j-1;
        Continue
      End;
  End;
  Maze[0][0]:=WAY
End;

Procedure DrawMaze;
Var
  i,j:Integer;
Begin
  ClrScr;
  For i:=0 To N-1 Do
  Begin
    For j:=0 To M-1 Do
    Begin
      TextBackground(Colors[Maze[i,j]]);
      Write(' ')
    End;
    WriteLn
  End
End;

Begin
  Randomize;
  GenerateMaze;
  SolveMaze;
  DrawMaze;
  ReadKey
End.