type ty=array[1..30,1..79]of char
var i,j,k,x,y:integer
ch,c:char
a:ty
f:boolean
t:text
procedure go(var ch:chara:ty)
var a2,b,c,d,k,i,j:shortint
begin
ch:='+'
for i:=1 to 30 do
for j:=1 to 79 do
begin
a2:=0
b:=0
c:=0
d:=0
for k:=1 to 4 do
begin
if (a[i,j+k*2]=a[i,j])and (a[i,j] in ['B','W']) then inc(a2)
if (a[i+k,j]=a[i,j])and (a[i,j] in ['B','W']) then inc(b)
if (a[i+k,j+k*2]=a[i,j])and (a[i,j] in ['B','W']) then inc©
if (a[i+k,j-k*2]=a[i,j])and (a[i,j] in ['B','W']) then inc(d)
end
{if i*j=1 then begin
write(t,(a[i,j+k*2]=a[i,j])and (a[i,j] in ['o','*']))
write(t,a[i,j])
write(t,a2)
end}
if a2=4 then begin ch:=a[i,j]{write(t,' ',ch,' ')}exitend
if b=4 then begin ch:=a[i,j]{write(t,' ',ch,' ')}exitend
if c=4 then begin ch:=a[i,j]{write(t,' ',ch,' ')}exitend
if d=4 then begin ch:=a[i,j]{write(t,' ',ch,' ')}exitend
end
end
procedure b1{*,B}
begin
textcolor(black)
ch:=readkey
while not((ch='h')and(a[x,y]='+')) do
begin
if ch='q' then begin f:=falseexitend
if ch='l' then inc(y,2)
else if ch='k' then inc(x)
else if ch='j' then dec(y,2)
else if ch='i' then dec(x)
gotoxy(y,x)
ch:=readkey
end
write('*')
write(t,'B ',x,' ',y,' ')
a[x,y]:='B'
gotoxy(y,x)
end
procedure b2{o,W}
begin
textcolor(white)
ch:=readkey
while not((ch='0')and(a[x,y]='+')) do
begin
if ch='q' then begin f:=falseexitend
if ch='6' then inc(y,2)
else if ch='5' then inc(x)
else if ch='4' then dec(y,2)
else if ch='8' then dec(x)
gotoxy(y,x)
ch:=readkey
end
write('o')
writeln(t,'W ',x,' ',y,'')
a[x,y]:='W'
gotoxy(y,x)
end
procedure b3{o,W}
var a2,b,c,d:integer
label lab,lab2,lab3
begin
textcolor(white)
ch:='+'
for i:=1 to 30 do
for j:=1 to 79 do
begin
a2:=0
b:=0
c:=0
d:=0
for k:=1 to 3 do
begin
if (a[i,j+k*2]=a[i,j])and (a[i,j] in ['B','W']) then inc(a2)
if (a[i+k,j]=a[i,j])and (a[i,j] in ['B','W']) then inc(b)
if (a[i+k,j+k*2]=a[i,j])and (a[i,j] in ['B','W']) then inc©
if (a[i-k,j+k*2]=a[i,j])and (a[i,j] in ['B','W']) then inc(d)
end
{if i*j=1 then begin
write(t,(a[i,j+k*2]=a[i,j])and (a[i,j] in ['o','*']))
write(t,a[i,j])
write(t,a2)
end}
if a2 in [3] then begin ch:=a[i,j]{write(t,' {ok1 ')}goto labend
if b in [3] then begin ch:=a[i,j]{write(t,' {ok1 ')}goto labend
if c in [3] then begin ch:=a[i,j]{write(t,' {ok1 ')}goto labend
if d in [3] then begin ch:=a[i,j]{write(t,' {ok1 ')}goto labend
end
lab:
{write(t,'{ok1,1')}
if (a2=3)and(a[i,j-2]='+') then y:=j-2
else if (a2=3)and(a[i,j+8]='+') then y:=j+8
else if (b=3)and(a[i-1,j]='+') then x:=i-1
else if (b=3)and(a[i+4,j]='+') then x:=i+4
else if (c=3)and(a[i-1,j-2]='+') then begin x:=i-1y:=j-2end
else if (c=3)and(a[i+4,j+8]='+') then begin x:=i+4y:=j+8end
else if (d=3)and(a[i+1,j-2]='+') then begin x:=i+1y:=j-2end
else if (d=3)and(a[i-4,j+8]='+') then begin x:=i-4y:=j+8end
else
begin
for i:=1 to 30 do
for j:=1 to 79 do
begin
a2:=0
b:=0
c:=0
d:=0
for k:=1 to 3 do
begin
if (a[i,j+k*2]=a[i,j])and (a[i,j] in ['B','W']) then inc(a2)
if (a[i+k,j]=a[i,j])and (a[i,j] in ['B','W']) then inc(b)
if (a[i+k,j+k*2]=a[i,j])and (a[i,j] in ['B','W']) then inc©
if (a[i-k,j+k*2]=a[i,j])and (a[i,j] in ['B','W']) then inc(d)
end
{if i*j=1 then begin
write(t,(a[i,j+k*2]=a[i,j])and (a[i,j] in ['o','*']))
write(t,a[i,j])
write(t,a2)
end}
if a2 in [2] then for k:=1 to 3 do if a[i,j+k*2]='+' then begin y:=j+k*2goto lab2end
if b in [2] then for k:=1 to 3 do if a[i+k,j]='+' then begin x:=j+kgoto lab2end
if c in [2] then for k:=1 to 3 do if a[i+k,j+k*2]='+' then begin x:=i+ky:=j+k*2goto lab2end
if d in [2] then for k:=1 to 3 do if a[i-k,j+k*2]='+' then begin x:=i-ky:=j+k*1goto lab2end
end
lab2:
{write(t,'{ok1,1')}
if (a2<>2)and(b<>2)and(c<>2)and(d<>2)
then
begin
for i:=1 to 30 do
for j:=1 to 79 do
begin
a2:=0
b:=0
c:=0
d:=0
k:=1
begin
if (a[i,j+k*2]=a[i,j])and (a[i,j] in ['B','W']) then inc(a2)
if (a[i+k,j]=a[i,j])and (a[i,j] in ['B','W']) then inc(b)
if (a[i+k,j+k*2]=a[i,j])and (a[i,j] in ['B','W']) then inc©
if (a[i-k,j+k*2]=a[i,j])and (a[i,j] in ['B','W']) then inc(d)
end
{if i*j=1 then begin
write(t,(a[i,j+k*2]=a[i,j])and (a[i,j] in ['o','*']))
write(t,a[i,j])
write(t,a2)
end}
if a2 in [1] then begin ch:=a[i,j]{write(t,'{ok1 ')}goto lab3end
if b in [1] then begin ch:=a[i,j]{write(t,' {ok1 ')}goto lab3end
if c in [1] then begin ch:=a[i,j]{write(t,' {ok1 ')}goto lab3end
if d in [1] then begin ch:=a[i,j]{write(t,' {ok1 ')}goto lab3end
end
lab3:
{write(t,'{ok1,1')}
if (a2=1)and(a[i,j-2]='+') then y:=j-2
else if (a2=1)and(a[i,j+4]='+') then y:=j+4
else if (b=1)and(a[i-1,j]='+') then x:=i-1
else if (b=1)and(a[i+2,j]='+') then x:=i+2
else if (c=1)and(a[i-1,j-2]='+') then begin x:=i-1y:=j-2end
else if (c=1)and(a[i+2,j+4]='+') then begin x:=i+2y:=j+4end
else if (d=1)and(a[i+1,j-2]='+') then begin x:=i+1y:=j-2end
else if (d=1)and(a[i-2,j+4]='+') then begin x:=i-2y:=j+4end
end
end
if not(a[x,y]='+') then
repeat
inc(x,random(5)-random(5))
inc(y,random(5)-random(5))
until a[x,y]='+'
{write(t,'ok2')}
gotoxy(y,x)
write('o')
writeln(t,'W ',x,' ',y,'')
a[x,y]:='W'
gotoxy(y,x)
{ write(t,'{ok3:',x,y,'') }
end
begin
fillchar(a,sizeof(a),' ')
textbackground(lightgreen)
textcolor(lightred)
assign(t,'five.txt')
rewrite(t)
writeln('One or two player?')
repeat ch:=readkeyuntil ch in['1','2']
gotoxy(1,1)
for i:=1 to 30 do
begin
write('+')
for j:=1 to 39 do write('-+')
writeln
end
for i:=1 to 30 do
for j:=1 to 79 do
if odd(j) then a[i,j]:='+'
else a[i,j]:='-'
gotoxy(1,1)
x:=1
y:=1
f:=true
if ch='2' then
while f do
begin
b1
go(c,a)
{ write(t,' ',c,' ')}
if c='B' then
begin
writeln('Black win!!!')
ch:=readkey
writeln(t)
writeln(t,'Black win')
break
end
else if c='W' then
begin
writeln('White win!!!')
ch:=readkey
writeln(t)
writeln(t,'White win')
break
end
if not f then break
b2
go(c,a)
if c='B' then
begin
writeln('Black win!!!')
textcolor(black)
ch:=readkey
writeln(t,'Black win')
break
end
else if c='W' then
begin
writeln('White win!!!')
ch:=readkey
writeln(t,'White win')
break
end
end
else
while f do
begin
b1
go(c,a)
{ write(t,' ',c,' ')}
if c='B' then
begin
writeln('You won!!!')
ch:=readkey
writeln(t)
writeln(t,'Black win')
break
end
else if c='W' then
begin
writeln('You lose!!!')
ch:=readkey
writeln(t)
writeln(t,'Black win')
break
end
if not f then break
b3
go(c,a)
if c='B' then
begin
writeln('You won!!!')
ch:=readkey
writeln(t)
writeln(t,'Black win')
break
end
else if c='W' then
begin
writeln('You lose!!!')
ch:=readkey
writeln(t)
writeln(t,'Black win')
break
end
end
close(t)
close(output)
assign(output,'five.txt')
append(output)
writeln
writeln
for i:=1 to 30 do
begin
for j:=1 to 79 do
write(a[i,j],' ')
writeln
end
close(output)
end.
我有个简单的思路： 先定义一条线上棋子的各种布局，比如初步定义长度为五个子 ◎◎◎◎● ◎◎●◎× ◎●◎×× ◎×◎×◎ 等等。白圈是自己的子，黑圈是对方的子，叉子是未走的格子。 程序里有个布局表，再定义各个布局的分数，比如连五最99分，连三30分等等。 ...
