Ход ферзя
Здравствуйте. Не могу разобраться с программой. Необходим поворот на 180 градусов, у меня на 90. как исправить?
Код программы:
program Project6;
{$APPTYPE CONSOLE}
uses
SysUtils,
Windows;
const n=8;
type pointer=^node;
node=record
info,pair:array [1..n] of integer;
next
ointer;
end;
var f:_COORD;
i,j:integer;
x:array [1..n] of integer;
a:array [1..n] of boolean;
b:array [2..n+n] of boolean;
c:array [1-n..n-1] of boolean;
s,q,h
ointer;
flag:boolean;
ConHandle: THandle;
function maseq(a,b:array of integer):boolean;
begin
maseq:=true;
j:=1;
for i:=n downto 1 do
if x<>q.info[j] then begin
maseq:=false;
Break;
end
else j:=j+1;
end;
procedure save(var s
ointer);
begin
if s=nil then begin
new(s);
for i:=1 to n do s.info:=x;
end
else begin
q:=s;
if q.next=nil then begin
new(h);
q.next:=h;
h.next:=nil;
for i:=1 to n do h.info:=x;
end
else
while q.next<>nil do begin
if maseq(q.info,x) then begin
for i:=1 to n do q.pair:=x;
flag:=false;
break;
end
else flag:=true;
q:=q.next;
end;
if maseq(q.info,x) then for i:=1 to n do q.pair:=x;
if flag=true then begin
new(h);
q.next:=h;
h.next:=nil;
for i:=1 to n do h.info:=x;
end;
end;
end;
procedure writecol(i,j:integer; s:string);
var TC:word;
begin
if odd(i+j) then tc:=0+7*16
else tc:=7+0*16;
SetConsoleTextAttribute(ConHandle,tc);
write(s,' ');
end;
procedure print(h
ointer);
var k,r:integer;
begin
r:=1;
While (h.next<>nil) do begin
for i:=1 to n do begin
j:=h.info;
for k:=1 to j-1 do writecol(i,k,' ');
k:=j;
writecol(i,k,'X ');
for k:=j+1 to n do writecol(i,k,' ');
SetConsoleTextAttribute(ConHandle,7+0*16);
if i=1 then write(' ','Para',r,' ')
else if r>9 then write(' ')
else write(' ');
j:=h.pair;
for k:=1 to j-1 do writecol(i,k,' ');
k:=j;
writecol(i,k,'X ');
for k:=j+1 to n do writecol(i,k,' ');
writeln;
end;
r:=r+1;
h:=h.next;
writeln(#10);
end;
end;
procedure ferz(i:integer);
var j:integer;
begin
for j:=1 to 8 do
if a[j] and b[i+j] and c[i-j] then begin
x:=j;
a[j]:=false;
b[i+j]:=false;
c[i-j]:=false;
if i<n then ferz(i+1)
else save(s);
a[j]:=true;
b[i+j]:=true;
c[i-j]:=true;
end;
end;
begin
ConHandle := GetStdHandle( STD_OUTPUT_HANDLE );
f.X:=1200;
f.Y:=1200;
SetConsoleScreenBufferSize(ConHandle,f);
for i:=1 to n do a:=true;
for i:=2 to n+n do b:=true;
for i:=1-n to n-1 do c:=true;
ferz(1);
q:=s;
print(q);
readln;
end.
Здравствуйте. Не могу разобраться с программой. Необходим поворот на 180 градусов, у меня на 90. как исправить?
Код программы:
program Project6;
{$APPTYPE CONSOLE}
uses
SysUtils,
Windows;
const n=8;
type pointer=^node;
node=record
info,pair:array [1..n] of integer;
next
end;
var f:_COORD;
i,j:integer;
x:array [1..n] of integer;
a:array [1..n] of boolean;
b:array [2..n+n] of boolean;
c:array [1-n..n-1] of boolean;
s,q,h
flag:boolean;
ConHandle: THandle;
function maseq(a,b:array of integer):boolean;
begin
maseq:=true;
j:=1;
for i:=n downto 1 do
if x<>q.info[j] then begin
maseq:=false;
Break;
end
else j:=j+1;
end;
procedure save(var s
begin
if s=nil then begin
new(s);
for i:=1 to n do s.info:=x;
end
else begin
q:=s;
if q.next=nil then begin
new(h);
q.next:=h;
h.next:=nil;
for i:=1 to n do h.info:=x;
end
else
while q.next<>nil do begin
if maseq(q.info,x) then begin
for i:=1 to n do q.pair:=x;
flag:=false;
break;
end
else flag:=true;
q:=q.next;
end;
if maseq(q.info,x) then for i:=1 to n do q.pair:=x;
if flag=true then begin
new(h);
q.next:=h;
h.next:=nil;
for i:=1 to n do h.info:=x;
end;
end;
end;
procedure writecol(i,j:integer; s:string);
var TC:word;
begin
if odd(i+j) then tc:=0+7*16
else tc:=7+0*16;
SetConsoleTextAttribute(ConHandle,tc);
write(s,' ');
end;
procedure print(h
var k,r:integer;
begin
r:=1;
While (h.next<>nil) do begin
for i:=1 to n do begin
j:=h.info;
for k:=1 to j-1 do writecol(i,k,' ');
k:=j;
writecol(i,k,'X ');
for k:=j+1 to n do writecol(i,k,' ');
SetConsoleTextAttribute(ConHandle,7+0*16);
if i=1 then write(' ','Para',r,' ')
else if r>9 then write(' ')
else write(' ');
j:=h.pair;
for k:=1 to j-1 do writecol(i,k,' ');
k:=j;
writecol(i,k,'X ');
for k:=j+1 to n do writecol(i,k,' ');
writeln;
end;
r:=r+1;
h:=h.next;
writeln(#10);
end;
end;
procedure ferz(i:integer);
var j:integer;
begin
for j:=1 to 8 do
if a[j] and b[i+j] and c[i-j] then begin
x:=j;
a[j]:=false;
b[i+j]:=false;
c[i-j]:=false;
if i<n then ferz(i+1)
else save(s);
a[j]:=true;
b[i+j]:=true;
c[i-j]:=true;
end;
end;
begin
ConHandle := GetStdHandle( STD_OUTPUT_HANDLE );
f.X:=1200;
f.Y:=1200;
SetConsoleScreenBufferSize(ConHandle,f);
for i:=1 to n do a:=true;
for i:=2 to n+n do b:=true;
for i:=1-n to n-1 do c:=true;
ferz(1);
q:=s;
print(q);
readln;
end.