Program Crossword;
uses crt,dos,graph,mouse;
type
 SetArray =array[1..100,1..100] of byte;
 BoolArray= array [1..100,1..100] of boolean;
  Tgnezdo=record
     x,y:integer;
     len:byte;
     horizontal:boolean;
     end;

     FSTR=file of string;

kol_bukv=record
 first:longint;
 last:longint;
 end;
 bukvi=array [1..50,1..50] of char;
Tarr_kol_bukv=array[1..29] of kol_bukv;
TgnezdoArr=array [1..100] of Tgnezdo;

var s:string;
okgor,ok,key:boolean;
   NG:longint;
    selected:BoolArray;
    len_x,len_y,q,len,w:integer;
    a:setarray;
    flag:boolean;
    gnezdo:TgnezdoArr;


    ip : word;
    b:Tarr_kol_bukv ;
    bukv,clone_bukv: bukvi;
    f:FSTr;
    str:string;
 
    driver,mode,i,j,n,z,i1,j1:integer;



    old_mouse, cur_mouse:boolean;
    size_x,size_y:integer;
    c:byte;
    OKtoExit: boolean;

procedure ResetMouse;
begin
  old_mouse := false;
  cur_mouse := false;
  if initmouse then;
  showmouse;
end;

function GetMouseEvent: byte;
begin
  cur_mouse := (buttonpressed = 1);

  if cur_mouse <> old_mouse then
     begin
       if cur_mouse
          then GetMouseEvent := 1 { mouse pressed once }
          else GetMouseEvent := 2; { mouse released }
     end
  else GetMouseEvent := 0; { Nothing changed }

  old_mouse := cur_mouse;
end;

Procedure Zabivaem_sLovo (var bukv:bukvi;Gnezdo:Tgnezdo;str:string);
begin
 if gnezdo.horizontal then      {esli slovo podhodit}
                                 {zabivaem ego v setku}
   for i:=0 to gnezdo.len-1 do
    bukv[gnezdo.x+i,gnezdo.y]:=str[i]
    else
    for i:=0 to gnezdo.len-1 do
     bukv[gnezdo.x,gnezdo.y+i]:=str[i];
     end;





  function  Maska_slova(gnezdo:Tgnezdo;text:bukvi):string;
  var  str:string;
begin                          {procedura vozvrawaywaya masku slova}
with gnezdo do            {vozvrawaet 4to-to tipa ' _ _ A _ Y'}
 begin                     {iz tekstovogo massiva}
  i:=0;
  if horizontal then
  begin
    while i<len do
   begin
    inc(i);
    str:=str +text[x,y];
    inc(y);
   end;
   end
   else
   while i<len do
   begin
    inc(i);
    str:=str+text[x,y];
    inc(x);
   end;
   end;
   Maska_slova:=str;
end;

function  If_Maska_Podhodit(str:string;maska:string):boolean;
var result:boolean;    {podhodit li slovo iz slovarya k maske}
begin
for i:=1 to length(str) do
 if maska[i]=' 'then continue
  else
   if maska[i]<>str[i] then result:=false
    else continue;
 If_Maska_POdhodit:=result;
end;



Procedure Get_gnezda(a:setarray;var gnezdo:TgnezdoArr;n:integer; var q:integer);
 var len:byte;        {massive gnezd}
     k:integer;
 begin
  q:=0;
  for i:=1 to n do
   for j:=1 to n do
    begin

    if (a[i,j]=1)  and (a[i-1,j]<>1 )and (a[i+1,j]=1 )then
      begin
      len:=0;
      inc(q);
       gnezdo[q].x:=i;
       gnezdo[q].y:=j;
       gnezdo[q].horizontal:= false;
       k:=i;
       while a[k,j]<>0 do
        begin
         inc(k);
         inc(len);
        end;
       gnezdo[q].len:=len;
      end;

    if (a[i,j]=1) and (a[i,j-1]<>1) and (a[i,j+1]=1)
    then
     begin
     len:=0;
     inc(q);
       gnezdo[q].x:=i;
       gnezdo[q].y:=j;
       gnezdo[q].horizontal:= true;
       k:=j;
       while a[i,k]<>0 do
        begin
         inc(k);
         inc(len);
        end;
       gnezdo[q].len:=len;
      end;
    end;
   end;
 {rekursiya}

 function GEt_word_from_sl(N:longint; var f:FSTR; var key:boolean):string;
 begin
 assign(f,'data.txt');
 reset(f);
  seek(f,n);             {slovo iz slovarya}
  {$i-}
  read(f,s);
   {$i+}
   if ioresult<>0 then key:=false else key:=true;

 end;


Function ARBEIT(bukv:bukvi;Ng:longint):boolean;
   var Nsl:integer;
       f:fstr;
       i,j:integer;        {osnovnaya rekyrsivnaya procedura}
       maska:string;
       retValue:byte;
       k:longint;



   begin
   ok:=true;
     flag:=false;
     Nsl:=0;
     retValue:=0;
     maska:=Maska_slova(gnezdo[Ng],bukv);
     str:= GEt_word_from_sl(Ng, f,key);
 While ok and (retvalue<1) do
 begin
  while not flag and key and (retvalue<1) do
    begin
     if If_Maska_Podhodit(str,maska)  then flag:=true
      else
      begin
      k:=Ng;
      inc(k);
      str:=GEt_word_from_sl(k, f,key);
     end;

  if (Ng = q) and (retvalue<1){max iz gnezd} then
  begin
  Zabivaem_sLovo ( bukv,Gnezdo[ng],str);
  retValue:=2;
  end
   else
   begin
   Clone_bukv:=bukv;
   Zabivaem_sLovo(clone_bukv,Gnezdo[ng],str);
  if    ARBEIT(clone_bukv,Ng+1) and (retvalue<1)  then
   begin
   retValue:=2;
   bukv:=clone_bukv;
   ok:=false;
   end
      else inc(Nsl); end;






   end;
   if retvalue<>2 then
   ARBEIT:=false else  ARBEIT:=true ;
   end;
   end;

     {risuem setku,zapolnyaem 2 massiva : logi4eskii i edini4nii}
procedure setka ( n:integer;var selected:BoolArray; var a:SetArray);
begin
 size_x:=n;
 size_y:=n;
 len_x:=479 div size_x;
 len_y:=479 div size_y;
 setcolor(red);

 for i:=1 to size_y  do
   for j:=1 to size_x   do       {risuem setku iz pryamoygolnikov}
     begin
       rectangle((j-1)*len_x,(i-1)*len_y,j*len_x,i*len_y );
       selected[i,j]:=false;
     end;

 for i:=1 to 10 do
 for j:=1 to 10 do
     a[i,j]:=0;
end;

  {v zavisimosti ot istinnosti zapolnyaem massiv nulyamii i edinicami}
Procedure Zapolnyaem( selected:Boolarray;n:integer; var a:setarray);
var k:boolean;
    cc: char;
begin
for i:=1 to n do
for j:=1 to n do
    begin
      selected[i,j]:=false;
    end;
    
repeat      {na4inaem proveryat bil li wel4ok miw'u}
 showmouse;
 z:=GetMouseEvent; {buttonpressed;}
 
 for i:=1 to size_y  do
 for j:=1 to size_x do
     begin
       if (mousein((j-1)*len_x,(i-1)*len_y,j*len_x,i*len_y )) and (z=1)  then
          begin
            hidemouse;
            selected[i,j]:=not selected[i,j];
            
            if selected[i,j]  then
               begin
                 setfillstyle(solidfill,lightgray);
               end
            else
               setfillstyle(solidfill,getbkcolor);
               
            bar ((j-1)*len_x,(i-1)*len_y,j*len_x,i*len_y );
            setcolor(red);
            rectangle((j-1)*len_x,(i-1)*len_y,j*len_x,i*len_y );
          end;
     end;
     
 k:=keypressed;
until k;

While keypressed do cc:=readkey;

for i:=1 to 10 do
  begin
    for j:=1 to 10 do
      begin
        if not selected[i,j] then
           begin
             a[i,j]:=0;
           end
        else
           begin
             a[i,j]:=1;
           end;
      end;
  end;
end;

procedure increm(i_start, j_start: integer;
          n: integer; value: integer; var a: setarray);
begin
 a[i_start, j_start] := value;
  
 if (i_start > 1) and (a[i_start - 1, j_start] > value)
    then increm(i_start - 1, j_start, n, value + 1, a);
     
 if (i_start < n) and (a[i_start + 1, j_start] > value)
    then increm(i_start + 1, j_start, n, value + 1, a);
     
 if (j_start > 1) and (a[i_start, j_start - 1] > value)
    then increm(i_start, j_start - 1, n, value + 1, a);
    
 if (j_start < n) and (a[i_start, j_start + 1] > value)
    then increm(i_start, j_start + 1, n, value + 1, a);
end;

function Proverka(b:setarray;n:integer):boolean;
var i,j:integer;
      q:integer;
begin
 q:=0;
 
 for i := 1 to n do
 for j := 1 to n do
     if b[i, j] = 1 then inc(b[i, j], n*n);

 for i := 1 to n do
 for j := 1 to n do
     if b[i, j] = n*n + 1 then Increm(i, j, n, 2, b);

 for i := 1 to n do
 for j := 1 to n do
     if b[i, j] <> 0 then dec(b[i, j]);

 for i := 1 to n do
 for j := 1 to n do
     if b[i,j]=1 then inc(q);
     
 {if q>1 then proverka:=false else proverka:=true;}
 Proverka := (q <= 1);
end;

function  Prov_po_4(a:setarray;n:integer)  :boolean;
begin
 for i:=1 to n do
 for j:=1 to n do
     begin
       if a[i,j]=1 then
          if (a[i+1,j]=1) and (a[i,j+1]=1) and (a[i+1,j+1]=1)
             then inc(q);
      end;
      
 {if q>0 then Prov_po_4:=false else Prov_po_4:=true;}
 Prov_po_4 := (q <= 0);
end;

{   ‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚‚}
{ Osnovnaya programma }

begin
 Window(25,25,100,100);
 writeln('Input the size of the crossvord:')  ;
 readln(n);
 driver:=detect;
 initgraph(driver,mode,'');
 setcolor(white);
 settextstyle(4,0,4) ;

 rectangle(490, 55,600, 90);
 rectangle(490,100,600,150);
 rectangle(490,160,600,210);

 outTextXY(500,55,'New');
 outTextXY(500,105,'Make!');
 outTextXY(500,165,'EXIT');

 ResetMouse;

 OKtoExit := False;
 assign(f,'datarema.txt');
 reset(f);

 Repeat
   c := 0;

   repeat
    If GetMouseEvent = 1 then
       begin
         if mousein (490, 55,600, 90) then c:=1;
         if mousein (490,100,600,150) then c:=2;
         if mousein (490,160,600,210) then c:=3;
       end;
   until c>0;
   
   case c of
      1: begin
           setviewport(1,1,479,479,clipoff);
           clearviewport;
           setka(n,selected,a);
           zapolnyaem(selected,n,a);

           if proverka(a,n) then
              begin
                settextstyle(2,0,2) ;
                outtextXY(490,180,'VSE V NORME!');
              end;
         for i:=1 to n do
          for j:=1 to n do
            if a[i,j]=1 then bukv[i,j]:=' ' else bukv[i,j]:='0';
            Get_gnezda(a, gnezdo,n, q);
           if   ARBEIT( bukv,Ng) then ok:=true ;
         end;
      2: begin
           { readln; }
          end;
      3 :begin
           outtextXY(490,300,'Bolwoe spasibo!');
           OKtoExit := true;
         end;
   end;
 until OKtoExit;
 close(f);
 readln;
end.