Procedure Push(cc: char);
Begin
  Inc(StackHead);
  Stack[StackHead] := cc;
End;

Function Pop: char;
Begin
  Pop := Stack[StackHead];
  Dec(StackHead);
End;

function GetMask(G : TGnezdo;CW_SIZE_X,CW_SIZE_y:integer) : TWord;
var Ch : Byte; Result : TWord;
begin
    Result := '';

    if (G.X + G.Len-1 > CW_SIZE_X) and (G.Y + G.Len-1 > CW_SIZE_Y) then
       begin
         Result := NOTEQ_SYMBOL;
         Exit;
       end;

    for Ch := 1 to G.Len do
      if G.flHoriz then
      Result := Result + CW[G.X, G.Y + Ch-1]
      else
      Result := Result + CW[G.X + Ch-1, G.Y];

    GetMask := Result;
  end;

function IsMaskOk(Msk, Wrd : TWord) : Boolean;
var Ch : Byte;
begin
    if Length(Msk) = Length(Wrd) then IsMaskOk := TRUE else begin IsMaskOk := FALSE; Exit; end;
    for Ch := 1 to Length(Wrd) do
      if (Msk[Ch] <> SPACE_SYMBOL) and (Msk[Ch] <> Wrd[Ch]) then
         begin
           IsMaskOk := FALSE; {Break;}
           Exit;
         end;
end;

Function Already(Wrd: TWord): boolean;
var i: word;
begin
  For i:=1 to UsedNum do
      If Wrd = Used[i] then
         begin
           Already := true;
           Exit;
         end;

  Already := false;
end;

procedure SetWord(G : TGnezdo;Wrd : TWord);
var Ch : Byte;
begin
  Inc(UsedNum);
  Used[UsedNum] := Wrd;

  for Ch := 1 to G.Len do
    if G.flHoriz then
      begin
         Push(CW[G.X, G.Y + Ch-1]);
         CW[G.X, G.Y + Ch-1] := Wrd[Ch];
      end
    else
      begin
         Push(CW[G.X + Ch-1, G.Y]);
         CW[G.X + Ch-1, G.Y] := Wrd[Ch];
      end;
end;

procedure UnSetWord(G : TGnezdo);
var Ch : Byte;
begin
  { Dec(UsedNum);}

  for Ch := 1 to G.Len do
    if G.flHoriz then
      begin
         CW[G.X, G.Y + Ch-1] := Pop;
      end
    else
      begin
         CW[G.X + Ch-1, G.Y] := Pop;
      end;
end;

procedure OpenWordBase(FName : string); 
begin 
  Assign(Fwbase, FName); 
  Reset(Fwbase); 
end;

procedure CloseWordBase; 
begin 
  Close(Fwbase); 
end;

function GetNextWord(l: byte) : TWord;
var F : Text; s : string;
begin
  While not EoF(Fwbase) do
    begin
      readln(Fwbase,s);

      If (not Already(s)) and (Length(s)=l) then
         begin
           GetNextWord := s;
           Exit;
         end;
    end;

  GetNextWord := '-1';
end;

Function Arbeit(GNum : Byte; n:integer; var cw1:TCW): boolean;
var Msk, Wrd : TWord;
    StartBasePosition, OldUsedNum : Word;
    flNoWord ,flag: Boolean;
begin
    If GNum > q Then
    begin
      Arbeit := true;
      Exit;
    end;

{    GoToXY(1,14);
     Writeln('GNUM: ',GNum:5);
}
    flag :=false;
    Msk := GetMask(Gnezdo[GNum],n,n);
    flNoWord := FALSE;

    OldUsedNum := UsedNum;

    repeat
      Reset(Fwbase);

      repeat
        Wrd := GetNextWord(Gnezdo[GNum].len);
        until IsMaskOk(Msk, Wrd) or (Wrd = '-1');

        if Wrd <> '-1' then
        begin
          SetWord(Gnezdo[GNum], Wrd);
          {PrintCW(CW,n);}

          If Arbeit(GNum+1,n,cw) Then
             begin
               Arbeit := true;
               Exit;
             end
          else UnSetWord(Gnezdo[GNum]);
        end
        else
        begin
          Arbeit := false;
          UsedNum := OldUsedNum;
          Exit;
        end;
     until false;
end;