Program Crossword;
uses crt,dos,graph,mouse;
type
 SetArray =array[1..100,1..100] of byte;
 BoolArray= array [1..100,1..100] of boolean;
 
var driver,mode,i,j,n,z,i1,j1,q:integer;
    selected:BoolArray;
    len_x,len_y:integer;
    a,b:SetArray;
    flag, 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;

     {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,60,'New');
 outTextXY(500,105,'Make!');
 outTextXY(500,165,'EXIT');

 ResetMouse;

 OKtoExit := False;

 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;
         end;
      2: begin
           { readln; }
          end;
      3 :begin
           outtextXY(490,300,'Bolwoe spasibo!');
           OKtoExit := true;
         end;
   end;
 until OKtoExit;
 
 readln;
end.