{ 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.