Program rieši problém umiestnenia 8 dám na šachovnicu tak, aby sa vzájomne neohrozovali

{ CHESS_QUEEN.PAS           Copyright (c) TrSek alias Zdeno Sekerak }
{ Program rieši problém umiestnenia 8 dám na šachovnicu tak aby sa  }
{ vzájomne neohrozovali.                                            }
{                                                                   }
{ Datum:13.07.2013                             http://www.trsek.com }
 
program program_damy;
uses crt, dos;
 
var pole:array[1..8,1..8] of byte;      { hracie pole }
    damy:array[1..2,1..8] of byte;  { souradnice dam }
    x,y: integer;
    por: integer;
    uspech: boolean;
 
function dajCislo(x,y:integer):integer;
var i:integer;
begin
  dajCislo:=0;
  for i:=1 to 8 do
    if(damy[1,i]=x) and (damy[2,i]=y)then
      dajCislo:=i;
end;
 
procedure vykresli_pole;
var x,y: integer;
begin
	for y:=1 to 8 do
	 for x:=1 to 8 do begin
	  gotoxy((x*4)+1, (y*2)+4);
	  if(pole[x,y]=1)then
		   write(dajCislo(x,y))
	  else write(' ');
	end;
 
    gotoxy(25,1);
    write(por);
end;
 
procedure zmaz_polia;
var x,y: integer;
begin
	gotoxy(1,1);
	writeln('  Aktualni stav reseni ( )');
	writeln('  ------------------------');
	writeln;
	writeln('    A   B   C   D   E   F   G   H  ');
	writeln('  +---+---+---+---+---+---+---+---+');
	writeln('8 |   |   |   |   |   |   |   |   |');
	writeln('  +---+---+---+---+---+---+---+---+');
	writeln('7 |   |   |   |   |   |   |   |   |');
	writeln('  +---+---+---+---+---+---+---+---+');
	writeln('6 |   |   |   |   |   |   |   |   |');
	writeln('  +---+---+---+---+---+---+---+---+');
	writeln('5 |   |   |   |   |   |   |   |   |');
	writeln('  +---+---+---+---+---+---+---+---+');
	writeln('4 |   |   |   |   |   |   |   |   |');
	writeln('  +---+---+---+---+---+---+---+---+');
	writeln('3 |   |   |   |   |   |   |   |   |');
	writeln('  +---+---+---+---+---+---+---+---+');
	writeln('2 |   |   |   |   |   |   |   |   |');
	writeln('  +---+---+---+---+---+---+---+---+');
	writeln('1 |   |   |   |   |   |   |   |   |');
	writeln('  +---+---+---+---+---+---+---+---+');
	gotoxy(1,23);
	writeln('Program pre predmet pocitacove algoritmy.');
 
	for y:=1 to 8 do
	 for x:=1 to 8 do
	  pole[x,y]:=0;
 
	 for x:=1 to 8 do begin
	  damy[1,x]:=0;
	  damy[2,x]:=0;
	 end;
end;
 
{ vrati true ak sa neake ohrozuju }
function zisti_ohrozenie:boolean;
var x,y,i: integer;
begin
	zisti_ohrozenie:=false;
 
	for y:=1 to 8 do
	 for x:=1 to 8 do
	  { tuto stoji dama }
	  if(pole[x,y]=1)then
	  begin
		for i:=1 to 8 do
		begin
		  { zistim ci nieje neaka ina vodorovne }
		  if(pole[i,y]=1) and (i<>x)then
		  begin
			zisti_ohrozenie:=true;
			exit;
		  end;
 
		  { zistim ci nieje neaka ina zvisle }
		  if(pole[x,i]=1) and (i<>y)then
		  begin
			zisti_ohrozenie:=true;
			exit;
		  end;
 
		  { zistim ci nieje neaka diagonalne }
		  if((((x-i)>=1) and ((y-i)>=1) and (pole[x-i,y-i]=1))
		  or (((x-i)>=1) and ((y+i)<=8) and (pole[x-i,y+i]=1))
		  or (((x+i)<=8) and ((y-i)>=1) and (pole[x+i,y-i]=1))
		  or (((x+i)<=8) and ((y+i)<=8) and (pole[x+i,y+i]=1))) then
		  begin
			zisti_ohrozenie:=true;
			exit;
		  end;
		end;  { for i:=1 to 8 do }
	 end;    { if(pole[x,y]==1)then }
end;
 
function dalsia_poloha(x,y,por:integer):boolean;
begin
  dalsia_poloha:=true;
  { najde volne pole }
  repeat
    x:=x+1;
    if(x>8) then begin x:=1; y:=y+1; end;
    if(y>8) then begin x:=1; y:=1; end;
 
    { tu uz raz bol }
    if((por>1)
	and(damy[1,por-1]=x)
	and(damy[2,por-1]=y))then
        dalsia_poloha:=false;
  { uz nasiel }
  until(pole[x,y]=0);
 
  damy[1,por]:=x;
  damy[2,por]:=y;
  pole[x,y]:=1;
end;
 
begin
	clrscr;
	zmaz_polia;
	por:=1;
    randomize;
	{ vymysli polohu prvej }
	dalsia_poloha(random(8)+1, random(8)+1, por);
 
	repeat
	  { nasiel ze sa ohrozuju }
	  if(zisti_ohrozenie)then begin
		 { poslednu zmaz z pola }
		 pole[ damy[1,por], damy[2,por]]:=0;
		 { najdi dalsiu polohu }
		 uspech:=dalsia_poloha(damy[1,por], damy[2,por], por);
	  end
	  else begin
		 { najdi dalsiu polohu }
		 por:=por+1;
		 uspech:=dalsia_poloha(damy[1,por-1], damy[2,por-1], por);
	  end;
 
	  { uz to presiel cele a nic }
	  if(not(uspech)) then begin
		 pole[ damy[1,por], damy[2,por]]:=0;
		 damy[1,por]:=0;
		 damy[2,por]:=0;
		 por:=por-1;
		 pole[ damy[1,por], damy[2,por]]:=0;
		 uspech:=dalsia_poloha(damy[1,por], damy[2,por], por);
	  end;
 
	  { ukazeme riesenie }
	  vykresli_pole;
 
	until ((por>=8) and (zisti_ohrozenie=false));
 
	{ pocka na enter }
	repeat until keypressed;
end.