Írjunk programot, amely nyolc vezért helyez el a sakktáblán ütésmentesen.

Program Vezer;

Uses NewDelay, Crt, CrtPlus;

Var H: Array[1..8] Of Byte;

I, J, K: Byte;

Re, Je: Boolean;

Procedure VKepre(S, O: Byte);

Begin

WriteXY(20+4*O,20-2*S,'V');

End;

Procedure VKeprol(S, O: Byte);

Begin

WriteXY(20+4*O,20-2*S,' ');

End;

Procedure Kep;

Begin

TextMode(CO80);

Szinek(1,14);

ClrScr;

WriteXY(26,1,'Nyolc vezér a sakktáblán:');

Racs(22,3,3,1,8,8);

For I:= 1 To 8 Do For J:= 1 To 8 Do

If Odd(I+J) Then WriteXY(19+4*I,20-2*J,'.');

Tunj;

End;

Function Rossz(B, C: Byte): Boolean;

Begin

J:= 1;

While (J<B) And (C<>H[J]) And (Abs(C-H[J])<>Abs(B-J)) Do

Inc(J);

Re:= Not(J<B);

Rossz:= Re;

End;

Function Jo(A: Byte): Boolean;

Label 1;

Begin

Repeat

Inc(H[I]);

If H[I]>8 Then GoTo 1;

Until (H[I]<=8) And Rossz(A,H[I]);

1: Je:= H[I]<=8;

Jo:= Je;

End;

Procedure Felrak;

Begin

I:= 1;

While I In [1..8] Do

If Jo(I) Then

Begin

VKepre(H[I],I);

Tunj;

Delay(400);

Inc(I);

H[I]:= 0;

End

Else

Begin

Dec(i);

VKeprol(H[I],I);

End;

End;

Begin

For K:= 0 To 7 Do

Begin

Kep;

If K=0 Then

Begin

WriteXY(37,21,'Start');

Tunj;

Varj;

WriteXY(37,21,' ');

End;

For I:= 1 To 8 Do H[I]:= K;

Felrak;

WriteXY(37,21,'Kész');

Tunj;

Varj;

End;

WriteXY(37,21,'Vége');

Tunj;

Varj;

End.