ZXNet эхоконференция «code.zx»

Hемедленно нажми на RESET, All!

Кто-то на CC мне говоpил, что с сабжем есть тpудности...

Вот эта пpогpамма игpает не слишком плохо, но и не слишком хоpошо,
как сделать лучше не знаю.

Запускать можно на спектpуме попытаться в hi-soft pascal, если не
получится,
то в CP/M-ке есть боpланд-паскаль. В hi-soft можно конвеpтнуть в оболочке
zxword 2.5.

Я это на асме пытался пеpеписать, но забpосил... В следующем письме будет
асм.


> --------- begin of gomoku.pas -----------------------------------------

uses crt;
const edge = 0; us = 1; them = 2; none = 3;
gridsize = 15;
maxmoves = 200;
alphabet = 96;
null = ';
type squares = edge..none;
smallint = byte;{0..gridsize}
line = array[0..9] of squares;
var
grid : array [1..gridsize,1..gridsize] of squares;
name : array [squares] of char;
icol, irow : array [1..4] of -1..1;
play : array [1..maxmoves] of record
rowfield, colfield : smallint;
end;
v, vals : array [1..4] of integer;
i, j, r, c : byte; {x- and y- coord}
onboard : set of smallint;
move : word;
endgame : squares;
yourturn : boolean;
topvalue : integer;
response : char;

procedure tell;
var y : char;
begin
writeln('Welcome to Go-Moku!');
writeln;
end;

procedure init;
var m : real;
begin
name[none] := '·';
name[us] := 'O';
name[them] := '*';
name[edge] := '-';
irow[1] := 0; icol[1] := -1; {влево}
irow[2] := -1; icol[2] := -1; {вверх-влево}
irow[3] := -1; icol[3] := 0; {вверх}
irow[4] := -1; icol[4] := 1; {вверх-вправо}
onboard := [1..gridsize];
end;

procedure whofirst(var youfirst : boolean);
var no : char;
begin
writeln;
write('do you want to move first (n=no) ?');
readln(no);
youfirst := upcase(no) <> 'N';
end;

procedure slab(r,c,compass: smallint; var l : line);
{формирование линейки из 10 клеток с центром в R, C и направляющим
вектором COMPASS}
var i, j : integer;
k : smallint;
begin
i := r; j := c;
for k := 4 downto 0 do {левая верхяя часть линейки}
begin
inc(i, irow[compass]);
inc(j, icol[compass]);
if (i in onboard) and (j in onboard) then
l[k] := grid[i,j] {конец линейки в пределах доски}
else
l[k] := edge; {конец линейки за границей доски}
end;
i := r; j := c;
for k := 5 to 9 do {правая нижняя часть линейки}
begin
dec(i, irow[compass]);
dec(j, icol[compass]);
if (i in onboard) and (j in onboard) then l[k] := grid[i,j]
else l[k] := edge;
end;
end;

procedure remember(i, j : smallint);
begin
play[move].rowfield := i;
play[move].colfield := j;
end;

procedure dumpgame(m : word);
var n : word;
begin
for n := 1 to m do with play[n] do
begin
write(chr(colfield+alphabet),rowfield:2);
if odd(n) then write(' ')
else writeln;
end;
end;

function foursome (var span : line; self : squares) : integer;
{вычисление весовой ф-ции}
var best : integer;
near : boolean;
i, s, firstone, last, gaps : word;
friendly : set of squares;
begin
best := 0; friendly := [none, self];
for i := 1 to 5 do {пять потенциальных четверок}
begin
firstone := 0; last := 0; {конечные позиции}
gaps := 0; near := false;
s := i; {начаальная позиция}
while (gaps < 4) and (s < i+4) do
begin
if span[s] = none then inc(gaps) {подсчет раазрывов в линейке}
else if span[s] = self then
begin
last := s;
if firstone = 0 then firstone := s;
near := near or (s in [4,5]);
{соседняя фишка - своя}
end
else {линейка блокирована фишкой противника}
gaps := 4;
inc(s);
end;
{суммирование весов}
s := sqr(4-gaps); {диапазон значений от 0 до 16}
if (last - firstone) < (4 - gaps) then
inc(s); {плюс 1, если в линейке нет разрыва}
if near then inc(s); {плюс 1, если в соседней клетке стоит фишка}
if [span[i-1], span[i+4]] <= friendly then
inc(s); {плюс 1, если линейка не блокирована}
if s > best then best := s; {new max}
end;
foursome := best;
end;

function evaluate(r, c : smallint) : integer;
{вычисление суммарной оценки хода в позицию R, C}
var noughts, crosses, x : integer;
i, j, thisway : smallint;
span : line;
function max(a,b:integer):integer;
begin
if a > b then max := a
else max := b;
end;
begin
for thisway := 1 to 4 do {4-е возможных направления}
begin
slab(r,c,thisway,span);
noughts := foursome(span,us) + 2; {предпочтение ноликам}
crosses := foursome(span,them);
v[thisway] := max(noughts,crosses)-2;
end;
for i := 1 to 3 do {sorting >=}
for j := 1 to 4 - i do if v[j] < v[j+1] then
begin
x := v[j];
v[j] := v[j+1];
v[j+1] := x;
end;
{окончательная оценка}
evaluate := v[1]*64 + v[2]*16 + v[3]*4 + v[4];
end;

procedure makemove(var r,c : smallint);
{поиск лучшего хода}
var bestcol, bestrow : smallint;
q,w : smallint;
e : integer;
begin
q := r; w := c;
topvalue := 0;
bestcol := 0; bestrow := 0;
if move = 1 then {первый ход - в центральную клетку}
begin
bestrow := gridsize div 2 + 1;
bestcol := bestrow;
end
else
for q := 1 to gridsize do
for w := 1 to gridsize do
if grid[q,w] = none then
begin
e := evaluate(q,w);
if (e > topvalue) or (bestrow = 0) then
begin
topvalue := e;
bestcol := w;
bestrow := q;
vals := v;
end;
end;
c := bestcol;
r := bestrow;
end;

procedure getmove(var i,j : smallint);
var c : char;
ok : boolean;
cols : integer;
begin
writeln;
repeat
write('where do you move ?');
read(c);
readln(i);
cols := ord(c) - alphabet;
ok := (i in onboard) and (cols in onboard);
if not ok then writeln('no such position as